]> git.ipfire.org Git - pakfire.git/commitdiff
Update perl dependency tracker from Fedora.
authorMichael Tremer <michael.tremer@ipfire.org>
Wed, 21 Dec 2011 21:40:38 +0000 (22:40 +0100)
committerMichael Tremer <michael.tremer@ipfire.org>
Wed, 21 Dec 2011 21:40:38 +0000 (22:40 +0100)
tools/perl.prov
tools/perl.req

index 73bec513b12fe5021c5815aeb6bc117f3c506398..9886dd93fef5fed6479f8c8b5c285331f90fbc96 100644 (file)
@@ -69,7 +69,7 @@ foreach $module (sort keys %require) {
     # operators. Also I will need to change the processing of the
     # $RPM_* variable when I upgrade.
 
-    print "perl($module)=$require{$module}\n";
+    print "perl($module) = $require{$module}\n";
   }
 }
 
@@ -81,20 +81,23 @@ sub process_file {
 
   my ($file) = @_;
   chomp $file;
-  
-  open(FILE, "<$file") || return;
+
+  if (!open(FILE, $file)) {
+    warn("$0: Warning: Could not open file '$file' for reading: $!\n");
+    return;
+  }
 
   my ($package, $version, $incomment, $inover) = ();
 
   while (<FILE>) {
-    
+
     # skip the documentation
 
     # we should not need to have item in this if statement (it
     # properly belongs in the over/back section) but people do not
     # read the perldoc.
 
-    if (m/^=(head[1-4]|pod|item)/) {
+    if (m/^=(head[1-4]|pod|for|item)/) {
       $incomment = 1;
     }
 
@@ -102,7 +105,7 @@ sub process_file {
       $incomment = 0;
       $inover = 0;
     }
-    
+
     if (m/^=(over)/) {
       $inover = 1;
     }
@@ -114,7 +117,7 @@ sub process_file {
     if ($incomment || $inover) {
        next;
     }
-    
+
     # skip the data section
     if (m/^__(DATA|END)__$/) {
       last;
@@ -125,7 +128,7 @@ sub process_file {
     # false positives as if they were provided packages (really ugly).
 
     if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*;/) {
-      $package=$1;
+      $package = $1;
       undef $version;
       if ($package eq 'main') {
         undef $package;
@@ -134,7 +137,7 @@ sub process_file {
         # the package definition is broken up over multiple blocks.
         # In that case, don't stomp a previous $VERSION we might have
         # found.  (See BZ#214496.)
-        $require{$package}=undef unless (exists $require{$package});
+        $require{$package} = undef unless (exists $require{$package});
       }
     }
 
@@ -149,44 +152,44 @@ sub process_file {
     #CGI/Apache.pm:$VERSION = (qw$Revision: 1.9 $)[1];
     #DynaLoader.pm:$VERSION = $VERSION = "1.03";     # avoid typo warning
     #General.pm:$Config::General::VERSION = 2.33;
-    # 
+    #
     # or with the new "our" pragma you could (read will) see:
     #
     #    our $VERSION = '1.00'
-    if (($package) && (m/^\s*(our\s+)?\$(\Q$package\E::)?VERSION\s*=\s+/)) {
+    if ($package && m/^\s*(our\s+)?\$(\Q$package\E::)?VERSION\s*=\s+/) {
 
       # first see if the version string contains the string
       # '$Revision' this often causes bizzare strings and is the most
       # common method of non static numbering.
 
       if (m/(\$Revision: (\d+[.0-9]+))/) {
-       $version= $2; 
-      } elsif (m/[\'\"]?(\d+[.0-9]+)[\'\"]?/) {
-       
-       # look for a static number hard coded in the script
-       
-       $version= $1; 
+        $version = $2;
+      } elsif (m/['"]?(\d+[.0-9]+)['"]?/) {
+
+        # look for a static number hard coded in the script
+
+        $version = $1;
       }
-      $require{$package}=$version;
+      $require{$package} = $version;
     }
-  
+
     # Allow someone to have a variable that defines virtual packages
-    # The variable is called $RPM_Provides.  It must be scoped with 
-    # "our", but not "local" or "my" (just would not make sense). 
-    # 
+    # The variable is called $RPM_Provides.  It must be scoped with
+    # "our", but not "local" or "my" (just would not make sense).
+    #
     # For instance:
-    #  
+    #
     #     $RPM_Provides = "blah bleah"
-    # 
+    #
     # Will generate provides for "blah" and "bleah".
     #
     # Each keyword can appear multiple times.  Don't
     #  bother with datastructures to store these strings,
     #  if we need to print it print it now.
-       
-    if ( m/^\s*(our\s+)?\$RPM_Provides\s*=\s*["'](.*)['"]/i) {
+
+    if (m/^\s*(our\s+)?\$RPM_Provides\s*=\s*["'](.*)['"]/i) {
       foreach $_ (split(/\s+/, $2)) {
-       print "$_\n";
+        print "$_\n";
       }
     }
 
@@ -195,5 +198,5 @@ sub process_file {
   close(FILE) ||
     die("$0: Could not close file: '$file' : $!\n");
 
-  return ;
+  return;
 }
index d0a1cd72910bc081a6f0d7e6b3e1b49c91c24d75..c676c737376af2baa6498976a0a609f678647da6 100644 (file)
@@ -1,6 +1,6 @@
 #!/usr/bin/perl
 
-# RPM (and its source code) is covered under two separate licenses. 
+# RPM (and its source code) is covered under two separate licenses.
 
 # The entire code base may be distributed under the terms of the GNU
 # General Public License (GPL), which appears immediately below.
@@ -18,8 +18,8 @@
 # Erik Troan <ewt@redhat.com>.
 
 # a simple makedepend like script for perl.
-# To save development time I do not parse the perl grammmar but
+
+# To save development time I do not parse the perl grammar but
 # instead just lex it looking for what I want.  I take special care to
 # ignore comments and pod's.
 
 
 # by Ken Estes Mail.com kestes@staff.mail.com
 
+$HAVE_VERSION = 0;
+eval { require version; $HAVE_VERSION = 1; };
+
+
 if ("@ARGV") {
   foreach (@ARGV) {
     process_file($_);
   }
 } else {
-  
+
   # notice we are passed a list of filenames NOT as common in unix the
   # contents of the file.
-  
+
   foreach (<>) {
     process_file($_);
   }
 }
 
 
+foreach $perlver (sort keys %perlreq) {
+  print "perl >= $perlver\n";
+}
 foreach $module (sort keys %require) {
   if (length($require{$module}) == 0) {
     print "perl($module)\n";
@@ -63,7 +70,7 @@ foreach $module (sort keys %require) {
     # operators. Also I will need to change the processing of the
     # $RPM_* variable when I upgrade.
 
-    print "perl($module)>=$require{$module}\n";
+    print "perl($module) >= $require{$module}\n";
   }
 }
 
@@ -71,19 +78,34 @@ exit 0;
 
 
 
+sub add_require {
+  my ($module, $newver) = @_;
+  my $oldver = $require{$module};
+  if ($oldver) {
+    $require{$module} = $newver
+      if ($HAVE_VERSION && $newver && version->new($oldver) < $newver);
+  }
+  else {
+    $require{$module} = $newver;
+  }
+}
+
 sub process_file {
-  
+
   my ($file) = @_;
   chomp $file;
-  
-  open(FILE, "<$file") || return;
-  
+
+  if (!open(FILE, $file)) {
+    warn("$0: Warning: Could not open file '$file' for reading: $!\n");
+    return;
+  }
+
   while (<FILE>) {
-    
+
     # skip the "= <<" block
 
-    if ( ( m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.*)\1/) ||
-         ( m/^\s*\$(.*)\s*=\s*<<(\w*)\s*;/) ) {
+    if (m/^\s*\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ ||
+        m/^\s*\$(.*)\s*=\s*<<(\w+)\s*;/) {
       $tag = $2;
       while (<FILE>) {
         chomp;
@@ -95,7 +117,7 @@ sub process_file {
     # skip q{} quoted sections - just hope we don't have curly brackets
     # within the quote, nor an escaped hash mark that isn't a comment
     # marker, such as occurs right here. Draw the line somewhere.
-    if ( m/^.*\Wq[qxwr]?\s*([\{\(\[#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) {
+    if ( m/^.*\Wq[qxwr]?\s*([{([#|\/])[^})\]#|\/]*$/ && ! m/^\s*(require|use)\s/ ) {
       $tag = $1;
       $tag =~ tr/{\(\[\#|\//})]#|\//;
       while (<FILE>) {
@@ -109,14 +131,14 @@ sub process_file {
     # properly belongs in the over/back section) but people do not
     # read the perldoc.
 
-    if ( (m/^=(head[1-4]|pod|item)/) .. (m/^=(cut)/) ) {
-      next;
+    if (/^=(head[1-4]|pod|for|item)/) {
+      /^=cut/ && next while <FILE>;
     }
 
-    if ( (m/^=(over)/) .. (m/^=(back)/) ) {
-      next;
+    if (/^=over/) {
+      /^=back/ && next while <FILE>;
     }
-    
+
     # skip the data section
     if (m/^__(DATA|END)__$/) {
       last;
@@ -126,14 +148,16 @@ sub process_file {
     #  bother with datastructures to store these strings,
     #  if we need to print it print it now.
     #
-       # Again allow for "our".
-    if ( m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
+        # Again allow for "our".
+    if (m/^\s*(our\s+)?\$RPM_Requires\s*=\s*["'](.*)['"]/i) {
       foreach $_ (split(/\s+/, $2)) {
-       print "$_\n";
+        print "$_\n";
       }
     }
 
-    if ( 
+    my $modver_re = qr/[.0-9]+/;
+
+    if (
 
 # ouch could be in a eval, perhaps we do not want these since we catch
 # an exception they must not be required
@@ -143,17 +167,18 @@ sub process_file {
 #   eval { require Carp } if defined $^S; # If error/warning during compilation,
 
 
-       (m/^(\s*)         # we hope the inclusion starts the line
-        (require|use)\s+(?!\{)     # do not want 'do {' loops
-        # quotes around name are always legal
-        [\'\"]?([^\;\ \'\"\t]*)[\'\"]?[\t\;\ ]
-        # the syntax for 'use' allows version requirements
-        \s*([.0-9]*)
-        /x)
+        (m/^(\s*)         # we hope the inclusion starts the line
+         (require|use)\s+(?!\{)     # do not want 'do {' loops
+         # quotes around name are always legal
+         ['"]?([^; '"\t#]+)['"]?[\t; ]
+         # the syntax for 'use' allows version requirements
+         # the latter part is for "use base qw(Foo)" and friends special case
+         \s*($modver_re|(qw\s*[(\/'"]\s*|['"])[^)\/"'\$]*?\s*[)\/"'])?
+         /x)
        ) {
-      my ($whitespace, $statement, $module, $version) = ($1, $2, $3,$4);
+      my ($whitespace, $statement, $module, $version) = ($1, $2, $3, $4);
 
-      # we only consider require statements that are flush against
+      # we only consider require statements that are flushed against
       # the left edge. any other require statements give too many
       # false positives, as they are usually inside of an if statement
       # as a fallback module or a rarely used option
@@ -163,13 +188,13 @@ sub process_file {
       # if there is some interpolation of variables just skip this
       # dependency, we do not want
       #        do "$ENV{LOGDIR}/$rcfile";
-   
+
       ($module =~ m/\$/) && next;
 
       # skip if the phrase was "use of" -- shows up in gimp-perl, et al.
       next if $module eq 'of';
 
-      # if the module ends in a comma we probaly caught some
+      # if the module ends in a comma we probably caught some
       # documentation of the form 'check stuff,\n do stuff, clean
       # stuff.' there are several of these in the perl distribution
 
@@ -181,8 +206,7 @@ sub process_file {
 
       #      ($module =~ m/^\./) && next;
 
-      # if the module ends with .pm strip it to leave only basename.
-      # starts with /, which means its an absolute path to a file
+      # if the module starts with /, it is an absolute path to a file
       if ($module =~ m(^/)) {
         print "$module\n";
         next;
@@ -193,9 +217,10 @@ sub process_file {
       $module =~ s/qw.*$//;
       $module =~ s/\(.*$//;
 
+      # if the module ends with .pm, strip it to leave only basename.
       $module =~ s/\.pm$//;
 
-      # some perl programmers write 'require URI/URL;' when 
+      # some perl programmers write 'require URI/URL;' when
       # they mean 'require URI::URL;'
 
       $module =~ s/\//::/;
@@ -209,13 +234,13 @@ sub process_file {
       # if module is a number then both require and use interpret that
       # to mean that a particular version of perl is specified
 
-      my $ver=$1;
+      my $ver = $1;
       if ($ver =~ /5.00/) {
-        print "perl>=0:$ver\n";
+        $perlreq{"0:$ver"} = 1;
         next;
       }
       else {
-        print "perl>=1:$ver\n";
+        $perlreq{"1:$ver"} = 1;
         next;
       }
 
@@ -223,10 +248,10 @@ sub process_file {
 
       # ph files do not use the package name inside the file.
       # perlmodlib documentation says:
-      
+
       #       the .ph files made by h2ph will probably end up as
       #       extension modules made by h2xs.
-      
+
       # so do not expend much effort on these.
 
 
@@ -234,16 +259,28 @@ sub process_file {
       # will be included with the name sys/systeminfo.ph so only use the
       # basename of *.ph files
 
-      ($module  =~ m/\.ph$/) && next;
+      ($module =~ m/\.ph$/) && next;
+
+      # use base qw(Foo) dependencies
+      if ($statement eq "use" && $module eq "base") {
+        add_require($module, undef);
+        if ($version =~ /^qw\s*[(\/'"]\s*([^)\/"']+?)\s*[)\/"']/) {
+          add_require($_, undef) for split(' ', $1);
+        }
+        elsif ($version =~ /(["'])([^"']+)\1/) {
+          add_require($2, undef);
+        }
+        next;
+      }
+      $version = undef unless $version =~ /^$modver_re$/o;
 
-      $require{$module}=$version;
-      $line{$module}=$_;
+      add_require($module, $version);
     }
-    
+
   }
 
   close(FILE) ||
     die("$0: Could not close file: '$file' : $!\n");
-  
-  return ; 
+
+  return;
 }