5 # perl.prov - find information about perl modules for RPM
8 # It's questionable if we should provide perl(Foo::Bar) for modules
9 # from outside @INC (possibly shipped with some applications).
10 # I think we should not, and provide them only for the perl.req script,
11 # while it scans files in that particular application.
13 # This shoud be provided as a library -- the same functionality is
14 # needed by the perl.req script.
17 my @inc = sort { length $b cmp length $a } grep m#^/.+#, @INC;
20 # process @ARGV or STDIN
21 foreach ( @ARGV ? @ARGV : <> ) {
23 next if !-f || -l; # skip non-files and symlinks
24 next if m#^/usr/(?:doc|src)/#; # lot of false alarms
25 next if !m#\.p[ml]$#; # we only care about *.pm and *.pl files
26 process_file($_) if -f;
29 # print out what we found
30 for ( sort keys %provide ) {
31 print "perl($_)" . ( length $provide{$_} ? " = $provide{$_}" : '' ) . "\n";
35 ############################################################
37 ############################################################
41 my ( $package, $version );
43 # if the file lives under @INC, we can
44 # obtain the package name from it's path
46 if ( $file =~ m#^\Q$_\E/?(.+)$# ) {
49 if ( $package !~ s/\.pm$// ) { # it's a *.pl
50 # $package =~ m#([^/]+)$#;
60 # it can be a *.pl oustide @INC
63 open FILE, $file or die "$0: cannot open file `$file': $!";
67 # skip the documentation
69 if m/^=(?:head1|head2|pod|item|begin|for|over)\b/
70 ... ( m/^=(?:cut|end)\b/ || $. == 1 );
72 # skip the data section
73 last if m/^__(?:DATA|END)__$/;
75 # search for the package name
79 m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?):*\s*;/ )
81 && match_the_path( $file, $1 )
87 if ( !defined $version && /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
88 ( $version = $safe->reval($_) ) =~ s/^\s+|alpha|beta|\s+$//g;
91 && $version =~ /[^\d\._abcdefgh]/ )
93 warn "perl.prov: weird version number in $file: [$version]\n";
99 unless ( defined $package ) {
100 warn "$0: weird, I can't determine the package name for `$file'\n";
104 $provide{$package} = $version;
106 close FILE or die "perl.prov: cannot close file `$file': $!";
112 # Returns true if the package name matches the patch,
113 # so you can use() it. False otherwise.
115 my ( $file, $pack ) = @_;
117 $file =~ /\Q$pack\E(?:\.pm)?$/;
120 # vim: ts=4 sw=4 noet noai nosi cin