- stupid cut&paste typo

[packages/rpm.git] / perl.prov

diff --git a/perl.prov b/perl.prov
index eb4f5846671fd32652c8bdabbfcde2b3b40da844..b41f2481434a65b7db82e84c55c62b966de6751b 100644 (file)
--- a/perl.prov
+++ b/perl.prov
@@ -21,7 +21,7 @@ my $safe = new Safe;
 foreach ( @ARGV ? @ARGV : <> ) {
        chomp;
        next if !-f || -l;                # skip non-files and symlinks
-       next if m#^/usr/(?:doc|src)/#;    # lot of false alarms
+       next if m#/usr/(?:doc|src)/#;     # lot of false alarms; warning: we ignore ^ here
        next if !m#\.p[ml]$#;             # we only care about *.pm and *.pl files
        process_file($_) if -f;
 }
@@ -29,9 +29,9 @@ foreach ( @ARGV ? @ARGV : <> ) {
 # print out what we found
 for ( sort keys %provide ) {
        print "perl($_)" . ( length $provide{$_} ? " = $provide{$_}" : '' ) . "\n";
+#      warn  "perl($_)" . ( length $provide{$_} ? " = $provide{$_}" : '' ) . "\n";
 }
 
-
 ############################################################
 #####   functions                                      #####
 ############################################################
@@ -43,7 +43,7 @@ sub process_file {
        # if the file lives under @INC, we can
        # obtain the package name from it's path
        for (@inc) {
-               if ( $file =~ m#^\Q$_\E/?(.+)$# ) {
+               if ( $file =~ m#\Q$_\E/?(.+)$# ) { # warning: we ignore ^ here
                        $package = $1;
 
                        if ( $package !~ s/\.pm$// ) {    # it's a *.pl
@@ -66,8 +66,8 @@ sub process_file {
 
                # skip the documentation
                next
-                 if m/^=(?:head1|head2|pod|item|begin|for|over)/
-                 ...  m/^=(?:cut|end)/;
+                 if m/^=(?:head1|head2|pod|item|begin|for|over)\b/
+                    ... ( m/^=(?:cut|end)\b/ || $. == 1 );
 
                # skip the data section
                last if m/^__(?:DATA|END)__$/;
@@ -75,8 +75,7 @@ sub process_file {
                # search for the package name
                if (
                        !defined $package
-                       && ( my ($pack) =
-                               m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?):*\s*;/ )
+                       && ( my ($pack) = m/^\s*(?:\{\s*)?package\s+([_:a-zA-Z0-9]+?):*\s*;/ )
                        && $1 ne 'main'
                        && match_the_path( $file, $1 )
                  )
@@ -90,27 +89,27 @@ sub process_file {
                                && length $version
                                && $version =~ /[^\d\._abcdefgh]/ )
                        {
-                               warn "perl.prov: weird version number in $file: [$version]\n";
+                               warn "$0: weird version number in $file: [$version]\n";
                                $version = '';
                        }
                }
        }
 
        unless ( defined $package ) {
-               warn "$0: weird, I can't determine the package name for `$file'\n";
+               warn "$0: weird, cannot determine the package name for `$file'\n";
                return 0;
        }
 
        $provide{$package} = $version;
 
-       close FILE or die "perl.prov: cannot close file `$file': $!";
+       close FILE or die "$0: cannot close file `$file': $!";
 
        1;
 }
 
 
-# Returns true if the package name matches the patch,
-# so you can use() it.  False otherwise.
+# Returns C<true> if the package name matches the path,
+# so you can use() it.  C<false> otherwise.
 sub match_the_path {
        my ( $file, $pack ) = @_;
        $pack =~ s#::#/#g;