From a405ce08101552b0fed8c6b4414919f4751fa7a8 Mon Sep 17 00:00:00 2001 From: Michael Tremer Date: Wed, 7 Dec 2022 18:48:30 +0000 Subject: [PATCH] perl: Re-indent scripts No functional changes. Signed-off-by: Michael Tremer --- src/scripts/perl.prov | 300 ++++++++++---------- src/scripts/perl.req | 647 +++++++++++++++++++++--------------------- 2 files changed, 475 insertions(+), 472 deletions(-) diff --git a/src/scripts/perl.prov b/src/scripts/perl.prov index 955bde486..8d5cc3e14 100644 --- a/src/scripts/perl.prov +++ b/src/scripts/perl.prov @@ -26,8 +26,6 @@ # then these are treated as additional names which are provided by the # file and are printed as well. -my $perl_ns = "perl"; - my $BUILDROOT = shift; # Check if BUILDROOT is set @@ -40,162 +38,156 @@ foreach (<>) { process_file("${BUILDROOT}/$_"); } +foreach my $module (sort keys %require) { + if (length($require{$module}) == 0) { + print "perl($module)\n"; -foreach $module (sort keys %require) { - if (length($require{$module}) == 0) { - print "$perl_ns($module)\n"; - } else { - - # I am not using rpm3.0 so I do not want spaces around my - # operators. Also I will need to change the processing of the - # $RPM_* variable when I upgrade. - - print "$perl_ns($module) = $require{$module}\n"; - } + # I am not using rpm3.0 so I do not want spaces around my + # operators. Also I will need to change the processing of the + # $RPM_* variable when I upgrade. + } else { + print "perl($module) = $require{$module}\n"; + } } exit 0; - - sub process_file { - - my ($file) = @_; - chomp $file; - - if (!open(FILE, $file)) { - warn("$0: Warning: Could not open file '$file' for reading: $!\n"); - return; - } - - my ($package, $version, $incomment, $inover) = (); - - while () { - - # skip the here-docs "<<" blocks - # assume that <<12 means bitwise operation - if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ && - ($1 !~ m/^\d+$/)) || - m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/ - ) && - ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/ - ) { - $tag = $1; - $tag =~ s/['"`]//g; - while () { - chomp; - ( $_ eq $tag ) && last; - } - $_ = ; - } - - # 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*(package)\s/ ) { - $tag = $1; - $tag =~ tr/{\(\[\#|!\//})]#|!\//; - $tag = quotemeta($tag); - while () { - ( $_ =~ m/$tag/ ) && last; - } - } - - # 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 (/^=(head[1-4]|pod|for|item)/) { - /^=cut/ && next while ; - } - - if (/^=over/) { - /^=back/ && next while ; - } - - # skip the data section - if (m/^__(DATA|END)__$/) { - last; - } - - # not everyone puts the package name of the file as the first - # package name so we report all namespaces except some common - # false positives as if they were provided packages (really ugly). - - if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*v?([0-9._]+)?\s*(;|{)/) { - $package = $1; - $version = defined($2) ? $2 : undef; - if ($package eq 'main') { - undef $package; - undef $version; - } else { - # If $package already exists in the $require hash, it means - # 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} = $version unless (exists $require{$package}); - } - } - - # after we found the package name take the first assignment to - # $VERSION as the version number. Exporter requires that the - # variable be called VERSION so we are safe. - - # here are examples of VERSION lines from the perl distribution - - #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); - #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.9 $, 10; - #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*use\s+version\s*;)?\s*(?:[^#=]*=[^=~>]|)?\s*(?:our\s+)?\$(?:\Q$package\E::)?VERSION\s*=([^=~>]\s*[^;]*)/) { - my $version_str = $1; - - # first see if the version string contains the string - # '$Revision' this often causes bizarre strings and is the most - # common method of non static numbering. - - if ($version_str =~ m/\$Revision: (\d+[.0-9]+)/) { - $version = $1; - } elsif ($version_str =~ m/\b['"]?v?(\d+(?:\.[.0-9]+)?)(_\d*|[a-zA-Z]*)?['"]?\b/) { - - # look for a static number hard coded in the script - - $version = $1; - } - $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). - # - # 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) { - foreach $_ (split(/\s+/, $2)) { - print "$_\n"; - } - } - - } - - close(FILE) || - die("$0: Could not close file: '$file' : $!\n"); - - return; + my ($file) = @_; + chomp $file; + + if (!open(FILE, $file)) { + warn("$0: Warning: Could not open file '$file' for reading: $!\n"); + return; + } + + my ($package, $version, $incomment, $inover) = (); + + while () { + # skip the here-docs "<<" blocks + # assume that <<12 means bitwise operation + if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ + && ($1 !~ m/^\d+$/)) || + m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/) + && ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/) { + $tag = $1; + $tag =~ s/['"`]//g; + + while () { + chomp; + ( $_ eq $tag ) && last; + } + + $_ = ; + } + + # 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*(package)\s/) { + $tag = $1; + $tag =~ tr/{\(\[\#|!\//})]#|!\//; + $tag = quotemeta($tag); + + while () { + ( $_ =~ m/$tag/ ) && last; + } + } + + # 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 (/^=(head[1-4]|pod|for|item)/) { + /^=cut/ && next while ; + } + + if (/^=over/) { + /^=back/ && next while ; + } + + # skip the data section + if (m/^__(DATA|END)__$/) { + last; + } + + # not everyone puts the package name of the file as the first + # package name so we report all namespaces except some common + # false positives as if they were provided packages (really ugly). + + if (m/^\s*package\s+([_:a-zA-Z0-9]+)\s*v?([0-9._]+)?\s*(;|{)/) { + $package = $1; + $version = defined($2) ? $2 : undef; + + if ($package eq 'main') { + undef $package; + undef $version; + } else { + # If $package already exists in the $require hash, it means + # 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} = $version unless (exists $require{$package}); + } + } + + # after we found the package name take the first assignment to + # $VERSION as the version number. Exporter requires that the + # variable be called VERSION so we are safe. + + # here are examples of VERSION lines from the perl distribution + + #FindBin.pm:$VERSION = $VERSION = sprintf("%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/); + #ExtUtils/Install.pm:$VERSION = substr q$Revision: 1.9 $, 10; + #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*use\s+version\s*;)?\s*(?:[^#=]*=[^=~>]|)?\s*(?:our\s+)?\$(?:\Q$package\E::)?VERSION\s*=([^=~>]\s*[^;]*)/) { + my $version_str = $1; + + # first see if the version string contains the string + # '$Revision' this often causes bizarre strings and is the most + # common method of non static numbering. + + if ($version_str =~ m/\$Revision: (\d+[.0-9]+)/) { + $version = $1; + + # look for a static number hard coded in the script + } elsif ($version_str =~ m/\b['"]?v?(\d+(?:\.[.0-9]+)?)(_\d*|[a-zA-Z]*)?['"]?\b/) { + $version = $1; + } + + $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). + # + # 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) { + foreach $_ (split(/\s+/, $2)) { + print "$_\n"; + } + } + } + + close(FILE) || die("$0: Could not close file: '$file' : $!\n"); + + return; } diff --git a/src/scripts/perl.req b/src/scripts/perl.req index 907f3defe..29bde1f2a 100644 --- a/src/scripts/perl.req +++ b/src/scripts/perl.req @@ -20,8 +20,6 @@ # then these are treated as additional names which are required by the # file and are printed as well. -my $perl_ns = "perl"; - my $BUILDROOT = shift; # Check if BUILDROOT is set @@ -29,8 +27,12 @@ unless ($BUILDROOT) { die "BUILDROOT is not set"; } +# Try to import "version" $HAVE_VERSION = 0; -eval { require version; $HAVE_VERSION = 1; }; +eval { + require version; + $HAVE_VERSION = 1; +}; # Process the passed filelist foreach (<>) { @@ -38,342 +40,351 @@ foreach (<>) { compute_global_requires(); } -foreach $perlver (sort keys %perlreq) { - print "$perl_ns(:VERSION) >= $perlver\n"; +foreach my $perlver (sort keys %perlreq) { + print "perl(:VERSION) >= $perlver\n"; } foreach my $module (sort keys %global_require) { - if (length($global_require{$module}) == 0) { - print "$perl_ns($module)\n"; - } else { + if (length($global_require{$module}) == 0) { + print "perl($module)\n"; - # I am not using rpm3.0 so I do not want spaces around my - # operators. Also I will need to change the processing of the - # $RPM_* variable when I upgrade. + } else { + # I am not using rpm3.0 so I do not want spaces around my + # operators. Also I will need to change the processing of the + # $RPM_* variable when I upgrade. - print "$perl_ns($module) >= $global_require{$module}\n"; - } + print "perl($module) >= $global_require{$module}\n"; + } } exit 0; sub compute_global_requires { - -# restrict require to all non provided by the file - foreach my $moduler (sort keys %require) { - if (exists $provide{$moduler} && length($require{$moduler}) == 0) { - $require = delete $require{$moduler}; - } - } -# store requires to global_requires - foreach my $module (sort keys %require) { - my $oldver = $global_require{$module}; - my $newver = $require{$module}; - if ($oldver) { - $global_require{$module} = $newver - if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); - } else { - $global_require{$module} = $newver; - } - } -# remove all local requires and provides - undef %require; - undef %provide; + # restrict require to all non provided by the file + foreach my $moduler (sort keys %require) { + if (exists $provide{$moduler} && length($require{$moduler}) == 0) { + $require = delete $require{$moduler}; + } + } + + # store requires to global_requires + foreach my $module (sort keys %require) { + my $oldver = $global_require{$module}; + my $newver = $require{$module}; + + if ($oldver) { + $global_require{$module} = $newver + if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); + } else { + $global_require{$module} = $newver; + } + } + + # remove all local requires and provides + undef %require; + undef %provide; } sub add_perlreq { - my ($newver) = @_; - - if (%perlreq) { - my ($oldver) = keys %perlreq; - if (eval "v$oldver" lt eval "v$newver") { - delete $perlreq{$oldver}; - $perlreq{$newver} = 1; - } - } else { - $perlreq{$newver} = 1; - } + my ($newver) = @_; + + if (%perlreq) { + my ($oldver) = keys %perlreq; + + if (eval "v$oldver" lt eval "v$newver") { + delete $perlreq{$oldver}; + $perlreq{$newver} = 1; + } + } else { + $perlreq{$newver} = 1; + } } sub add_require { - my ($module, $newver) = @_; - - # __EXAMPLE__ is not valid requirement - return if ($module =~ m/^__[A-Z]+__$/o); - - # To prevent that module does not end with '::' - # Example: use base Object::Event::; - $module =~ s/::$//; - - my $oldver = $require{$module}; - if ($oldver) { - $require{$module} = $newver - if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); - } - else { - $require{$module} = $newver; - } + my ($module, $newver) = @_; + + # __EXAMPLE__ is not valid requirement + return if ($module =~ m/^__[A-Z]+__$/o); + + # To prevent that module does not end with '::' + # Example: use base Object::Event::; + $module =~ s/::$//; + + 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; + + if (!open(FILE, $file)) { + warn("$0: Warning: Could not open file '$file' for reading: $!\n"); + return; + } + + while () { + # skip the here-docs "<<" blocks + # assume that <<12 means bitwise operation + if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ && + ($1 !~ m/^\d+$/)) || + m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/ + ) && ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/ + ) { + $tag = $1; + $tag =~ s/['"`]//g; + + if ($_ =~ m/^\s*use\s(constant)\s/) { + add_require($1, undef); + } + + while () { + chomp; + ( $_ eq $tag ) && last; + } + + $_ = ; + } + + # 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/ ) { + $tag = $1; + $tag =~ tr/{\(\[\#|!\//})]#|!\//; + $tag = quotemeta($tag); + + while () { + ( $_ =~ m/$tag/ ) && last; + } + } + + # 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 (/^=(head[1-4]|pod|for|item)/) { + /^=cut/ && next while ; + } + + if (/^=over/) { + /^=back/ && next while ; + } + + # skip the data section + if (m/^__(DATA|END)__$/) { + last; + } + + # Each keyword can appear multiple times. Don't + # 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) { + foreach $_ (split(/\s+/, $2)) { + print "$_\n"; + } + } + + my $modver_re = qr/[.0-9]+/; + my $begin_re = qr#qw\s*[(\/'"!|{\[]\s*|qq?\s*[(\/'"!|{\[]\s*|['"]#; + my $end_re = qr#[)\/"'!|}\]]#; + + # Skip multiline print and assign statements + if ( m/\$\S+\s*=\s*(")([^"\\]|(\\.))*$/ || + m/\$\S+\s*=\s*(')([^'\\]|(\\.))*$/ || + m/print\s+(")([^"\\]|(\\.))*$/ || + m/print\s+(')([^'\\]|(\\.))*$/ ) { + my $quote = $1; + + while () { + m/^([^\\$quote]|(\\.))*$quote/ && last; + } + + $_ = ; + } + + + # ouch could be in a eval, perhaps we do not want these since we catch + # an exception they must not be required + + # eval { require Term::ReadLine } or die $@; + # eval "require Term::Rendezvous;" or die $@; + # eval { require Carp } if defined $^S; # If error/warning during compilation, + if ( + (m/^(\s*) # we hope the inclusion starts the line + (?:BEGIN\s*\{\s*)? # but we accept an optional BEGIN { as used in Module::Loaded + (require|use)\s+(?!\{) # do not want 'do {' loops + # quotes around name are always legal + (?:$begin_re?\s*([\w:\/\.]+?)\s*$end_re?| + ([\w:\.]+?))[^\w]*? + [\t; \n] + # the syntax for 'use' allows version requirements + \s*($modver_re)?\s* + # catch parameter like '-norequire,' + (-[\w,]+)?\s* + # the latter part is for "use base qw(Foo)" and friends special case + (?:$begin_re\s* + ([^)\/"'\$!|}]*?) + \s*$end_re| + (?:qw<|qq?<)([^>]*?)>|([\w\:]+)|)\s*(.*) + /x) + ) { + my ($whitespace, $statement, $module, $version, $params, $list, $rest) = ($1, $2, $3, $5, $6, $7 || $8 || $9, $10); + $version = undef if ($version eq ''); + + # Ignore line which contains direct method calls + # use base __PACKAGE__->subroutine(...); + $list = "" if ($list =~ /^[^;#]*?->/ || $rest =~ /^[^;#]*?->/); + + # + # Executed in case that multiline q{} quoted sections is used for + # list of modules + if (defined($list) && $list =~ /^q[qxwr]?$/) { + $list = ""; + if ($rest =~ m/^\s*([{([#|!\/])\s*([^})\]#|!\/]*)$/) { + $tag = $1; + $list = $2; + chomp($list); + $tag =~ tr/{\(\[\#|!\//})]#|!\//; + $tag = quotemeta($tag); + + while () { + my $line = $_; + chomp($line); + + if ($line =~ m/^\s*(.*?)$tag/) { + $list .= ' ' . $1 if ($1 ne ''); + last; + } else { + $list .= ' ' . $line; + } + } + } + } + + # 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 + + ($whitespace ne "" && $statement eq "require") && next; + + # if there is some interpolation of variables just skip this + # dependency, we do not want + # do "$ENV{LOGDIR}/$rcfile"; + + ($module =~ m/\$/) && next; + + # ignore variables + ($module =~ m/^\s*[\$%@\*]/) && 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 probably caught some + # documentation of the form 'check stuff,\n do stuff, clean + # stuff.' there are several of these in the perl distribution + + ($module =~ m/[,>]$/) && next; + + # if the module name starts in a dot it is not a module name. + # Is this necessary? Please give me an example if you turn this + # back on. + + # ($module =~ m/^\./) && next; + + # if the module starts with /, it is an absolute path to a file + if ($module =~ m(^/)) { + print "$module\n"; + next; + } + + # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. + # we can strip qw.*$, as well as (.*$: + $module =~ s/qw.*$//; + $module =~ s/\(.*$//; + + # if the module ends with .pm, strip it to leave only basename. + # .pm files are not accepted by 'use' + ($module =~ s/\.pm$// && $statement eq 'use' ) && next; + + # some perl programmers write 'require URI/URL;' when + # they mean 'require URI::URL;' + + ($module =~ s/\//::/ && $statement eq 'use' ) && next; + + # trim off trailing parentheses if any. Sometimes people pass + # the module an empty list. + + $module =~ s/\(\s*\)$//; + + # 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. + + # there is no easy way to find out if a file named systeminfo.ph + # will be included with the name sys/systeminfo.ph so only use the + # basename of *.ph files + + ($module =~ m/\.ph$/) && next; + + # use base|parent qw(Foo) dependencies + # use aliased qw(Foo::Bar) dependencies + if ($statement eq "use" && ($module eq "base" || $module eq "aliased")) { + add_require($module, $version); + + if (defined($list) && $list ne "") { + add_require($_, undef) for split(' ', $list); + } + next; + } + + # use parent -norequire, 'No::Version'; # $params == "-norequire," + # use parent qw/-norequire XML::XPath::Node/; # $list == "-norequire XML::XPath::Node" + if ($statement eq "use" && $module eq "parent") { + add_require($module, $version); + + if (defined($list) && $list ne "" && $list !~ /-norequire/ && $params !~ /-norequire/) { + add_require($_, undef) for split(' ', $list); + } + next; + } + + # use Any::Moose dependencies + # Mouse or Mouse::Role will be added + if ($statement eq "use" && $module eq "Any::Moose") { + add_require($module, $version); - my ($file) = @_; - chomp $file; - - if (!open(FILE, $file)) { - warn("$0: Warning: Could not open file '$file' for reading: $!\n"); - return; - } - - while () { - - # skip the here-docs "<<" blocks - # assume that <<12 means bitwise operation - if (((m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<[\\]?(\w+)\s*/ && - ($1 !~ m/^\d+$/)) || - m/^\s*(?:'[^']*?'|"[^"]*?"|[^"'#]*?)*?[^"'#<@]<<\s*('[^']*?'|"[^"]*?"|`[^`]*?`)\s*/ - ) && - ! m/q[qxwr]?\s*[{([#|!\/][^})\]#|!\/]*?<<[^<]/ - ) { - $tag = $1; - $tag =~ s/['"`]//g; - if ($_ =~ m/^\s*use\s(constant)\s/) { add_require($1, undef) } - while () { - chomp; - ( $_ eq $tag ) && last; - } - $_ = ; - } - - # 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/ ) { - $tag = $1; - $tag =~ tr/{\(\[\#|!\//})]#|!\//; - $tag = quotemeta($tag); - while () { - ( $_ =~ m/$tag/ ) && last; - } - } - - # 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 (/^=(head[1-4]|pod|for|item)/) { - /^=cut/ && next while ; - } - - if (/^=over/) { - /^=back/ && next while ; - } - - # skip the data section - if (m/^__(DATA|END)__$/) { - last; - } - - # Each keyword can appear multiple times. Don't - # 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) { - foreach $_ (split(/\s+/, $2)) { - print "$_\n"; - } - } - - my $modver_re = qr/[.0-9]+/; - my $begin_re = qr#qw\s*[(\/'"!|{\[]\s*|qq?\s*[(\/'"!|{\[]\s*|['"]#; - my $end_re = qr#[)\/"'!|}\]]#; - - # Skip multiline print and assign statements - if ( m/\$\S+\s*=\s*(")([^"\\]|(\\.))*$/ || - m/\$\S+\s*=\s*(')([^'\\]|(\\.))*$/ || - m/print\s+(")([^"\\]|(\\.))*$/ || - m/print\s+(')([^'\\]|(\\.))*$/ ) { - - my $quote = $1; - while () { - m/^([^\\$quote]|(\\.))*$quote/ && last; - } - $_ = ; - } - - if ( - -# ouch could be in a eval, perhaps we do not want these since we catch -# an exception they must not be required - -# eval { require Term::ReadLine } or die $@; -# eval "require Term::Rendezvous;" or die $@; -# eval { require Carp } if defined $^S; # If error/warning during compilation, - - - (m/^(\s*) # we hope the inclusion starts the line - (?:BEGIN\s*\{\s*)? # but we accept an optional BEGIN { as used in Module::Loaded - (require|use)\s+(?!\{) # do not want 'do {' loops - # quotes around name are always legal - (?:$begin_re?\s*([\w:\/\.]+?)\s*$end_re?| - ([\w:\.]+?))[^\w]*? - [\t; \n] - # the syntax for 'use' allows version requirements - \s*($modver_re)?\s* - # catch parameter like '-norequire,' - (-[\w,]+)?\s* - # the latter part is for "use base qw(Foo)" and friends special case - (?:$begin_re\s* - ([^)\/"'\$!|}]*?) - \s*$end_re| - (?:qw<|qq?<)([^>]*?)>|([\w\:]+)|)\s*(.*) - /x) - ) { - my ($whitespace, $statement, $module, $version, $params, $list, $rest) = ($1, $2, $3, $5, $6, $7 || $8 || $9, $10); - $version = undef if ($version eq ''); - - # Ignore line which contains direct method calls - # use base __PACKAGE__->subroutine(...); - $list = "" if ($list =~ /^[^;#]*?->/ || $rest =~ /^[^;#]*?->/); - - # - # Executed in case that multiline q{} quoted sections is used for - # list of modules - if (defined($list) && $list =~ /^q[qxwr]?$/) { - $list = ""; - if ($rest =~ m/^\s*([{([#|!\/])\s*([^})\]#|!\/]*)$/) { - $tag = $1; - $list = $2; - chomp($list); - $tag =~ tr/{\(\[\#|!\//})]#|!\//; - $tag = quotemeta($tag); - while () { - my $line = $_; - chomp($line); - if ($line =~ m/^\s*(.*?)$tag/) { - $list .= ' ' . $1 if ($1 ne ''); - last; - } else { $list .= ' ' . $line; } - } - } - } - - # 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 - - ($whitespace ne "" && $statement eq "require") && next; - - # if there is some interpolation of variables just skip this - # dependency, we do not want - # do "$ENV{LOGDIR}/$rcfile"; - - ($module =~ m/\$/) && next; - - # ignore variables - ($module =~ m/^\s*[\$%@\*]/) && 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 probably caught some - # documentation of the form 'check stuff,\n do stuff, clean - # stuff.' there are several of these in the perl distribution - - ($module =~ m/[,>]$/) && next; - - # if the module name starts in a dot it is not a module name. - # Is this necessary? Please give me an example if you turn this - # back on. - - # ($module =~ m/^\./) && next; - - # if the module starts with /, it is an absolute path to a file - if ($module =~ m(^/)) { - print "$module\n"; - next; - } - - # sometimes people do use POSIX qw(foo), or use POSIX(qw(foo)) etc. - # we can strip qw.*$, as well as (.*$: - $module =~ s/qw.*$//; - $module =~ s/\(.*$//; - - # if the module ends with .pm, strip it to leave only basename. - # .pm files are not accepted by 'use' - ($module =~ s/\.pm$// && $statement eq 'use' ) && next; - - # some perl programmers write 'require URI/URL;' when - # they mean 'require URI::URL;' - - ($module =~ s/\//::/ && $statement eq 'use' ) && next; - - # trim off trailing parentheses if any. Sometimes people pass - # the module an empty list. - - $module =~ s/\(\s*\)$//; - - # 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. - - - # there is no easy way to find out if a file named systeminfo.ph - # will be included with the name sys/systeminfo.ph so only use the - # basename of *.ph files - - ($module =~ m/\.ph$/) && next; - - # use base|parent qw(Foo) dependencies - # use aliased qw(Foo::Bar) dependencies - if ($statement eq "use" && ($module eq "base" || $module eq "aliased")) { - add_require($module, $version); - if (defined($list) && $list ne "") { - add_require($_, undef) for split(' ', $list); - } - next; - } - # use parent -norequire, 'No::Version'; # $params == "-norequire," - # use parent qw/-norequire XML::XPath::Node/; # $list == "-norequire XML::XPath::Node" - if ($statement eq "use" && $module eq "parent") { - add_require($module, $version); - if (defined($list) && $list ne "" && $list !~ /-norequire/ && $params !~ /-norequire/) { - add_require($_, undef) for split(' ', $list); - } - next; - } - - # use Any::Moose dependencies - # Mouse or Mouse::Role will be added - if ($statement eq "use" && $module eq "Any::Moose") { - add_require($module, $version); - if (defined($list) && $list ne "") { - if (grep { !/^Role$/ } split(' ', $list)) { - add_require('Mouse::Role', undef); - } else { - add_require('Mouse', undef); - } - } else { - add_require('Mouse', undef); - } - next; - } + if (defined($list) && $list ne "") { + if (grep { !/^Role$/ } split(' ', $list)) { + add_require('Mouse::Role', undef); + } else { + add_require('Mouse', undef); + } + } else { + add_require('Mouse', undef); + } + next; + } - add_require($module, $version); - } # use|require regex + add_require($module, $version); + } # use|require regex + } # while () - } # while () + close(FILE) || die("$0: Could not close file: '$file' : $!\n"); - close(FILE) || - die("$0: Could not close file: '$file' : $!\n"); - - return; + return; } -- 2.39.5