4 # perl.prov - find information about perl modules for RPM
7 # It's questionable if we should provide perl(Foo::Bar) for modules
8 # from outside @INC (possibly shipped with some applications).
9 # I think we should not, and provide them only for the perl.req script,
10 # while it scans files in that particular application.
13 # check if we are called directly
14 if ($0 =~ m#(?:^|/)perl.prov$#) {
15 my $prov = new RPM::PerlReq;
16 # process @ARGV or STDIN
17 foreach ( @ARGV ? @ARGV : <> ) {
19 next if -l || !-f _; # skip non-files and symlinks
20 next if m#/usr/(?:share/doc|src)/#; # lot of false alarms; warning: we omit ^ here
21 next if !m#\.p[ml]$#; # we only care about *.pm and *.pl files
22 $prov->process_file($_);
35 sort { length $b cmp length $a } grep m#^/#,
36 map { y#/#/#s; s#/$##; $_ } @INC
45 # print out what we found
48 for (sort keys %{ $self->{provide} }) {
50 . (length $self->{provide}->{$_} ? " = $self->{provide}->{$_}" : '')
58 my ( $package, $version );
60 # if the file lives under @INC, we can
61 # obtain the package name from it's path
62 for (@{ $self->{inc} }) {
63 if ($file =~ m#\Q$_\E/(.+)$#) { # we can't use ^ here
66 if ($package !~ s/\.pm$//) { # it's a *.pl
67 # $package =~ m#([^/]+)$#;
77 # it can be a *.pl oustide @INC
81 open FILE, $file or die "$0: cannot open file `$file': $!";
85 # skip the documentation
87 if m/^=(?:head1|head2|pod|item|begin|for|over)\b/
88 ... ( m/^=(?:cut|end)\b/ || $. == 1 );
90 # skip the data section
91 last if m/^__(?:DATA|END)__$/;
93 # search for the package name
95 (!defined $package || !defined $version)
96 && ( my ($pack, $ver) = m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?)\s*(?:v?([0-9_.]+)\s*)?[;{]/)
98 && match_the_path( $file, $1 )
105 if ( !defined $version && /([\$*])(([\w\:\']*)\bVERSION)\b.*\=/ ) {
106 ( $version = $self->{safe}->reval($_) ) =~ s/^\s+|alpha|beta|\s+$//g;
107 if ( defined $version
109 && ($version =~ /[^\d\._abcdefgh]/
110 || $version =~ /^[^\d]*$/ ))
112 warn "$0: weird version number in $file: [$version]\n";
118 unless ( defined $package ) {
119 warn "$0: weird, cannot determine the package name for `$file'\n";
123 $self->{provide}->{$package} = $version;
125 close FILE or die "$0: cannot close file `$file': $!";
131 # Returns C<true> if the package name matches the path,
132 # so you can use() it. C<false> otherwise.
134 my ( $file, $pack ) = @_;
136 $file =~ /\Q$pack\E(?:\.pm)?$/;
142 # vim: ts=4 sw=4 noet noai nosi cin