From: Michael Tremer Date: Wed, 21 Dec 2011 21:40:38 +0000 (+0100) Subject: Update perl dependency tracker from Fedora. X-Git-Tag: 0.9.20~33^2~11 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a09bac734fea54e1d0c6ede8b55f22ea3e0df1f8;p=pakfire.git Update perl dependency tracker from Fedora. --- diff --git a/tools/perl.prov b/tools/perl.prov index 73bec513b..9886dd93f 100644 --- a/tools/perl.prov +++ b/tools/perl.prov @@ -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 () { - + # 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; } diff --git a/tools/perl.req b/tools/perl.req index d0a1cd729..c676c7373 100644 --- a/tools/perl.req +++ b/tools/perl.req @@ -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 . # 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. @@ -39,21 +39,28 @@ # 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 () { - + # 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 () { 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 () { @@ -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 ; } - if ( (m/^=(over)/) .. (m/^=(back)/) ) { - next; + if (/^=over/) { + /^=back/ && next while ; } - + # 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; }