# 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
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 (<FILE>) {
-
- # 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 (<FILE>) {
- chomp;
- ( $_ eq $tag ) && last;
- }
- $_ = <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*(package)\s/ ) {
- $tag = $1;
- $tag =~ tr/{\(\[\#|!\//})]#|!\//;
- $tag = quotemeta($tag);
- while (<FILE>) {
- ( $_ =~ 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 <FILE>;
- }
-
- if (/^=over/) {
- /^=back/ && next while <FILE>;
- }
-
- # 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 (<FILE>) {
+ # 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 (<FILE>) {
+ chomp;
+ ( $_ eq $tag ) && last;
+ }
+
+ $_ = <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*(package)\s/) {
+ $tag = $1;
+ $tag =~ tr/{\(\[\#|!\//})]#|!\//;
+ $tag = quotemeta($tag);
+
+ while (<FILE>) {
+ ( $_ =~ 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 <FILE>;
+ }
+
+ if (/^=over/) {
+ /^=back/ && next while <FILE>;
+ }
+
+ # 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;
}
# 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
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 (<>) {
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 (<FILE>) {
+ # 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 (<FILE>) {
+ chomp;
+ ( $_ eq $tag ) && last;
+ }
+
+ $_ = <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/ ) {
+ $tag = $1;
+ $tag =~ tr/{\(\[\#|!\//})]#|!\//;
+ $tag = quotemeta($tag);
+
+ while (<FILE>) {
+ ( $_ =~ 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 <FILE>;
+ }
+
+ if (/^=over/) {
+ /^=back/ && next while <FILE>;
+ }
+
+ # 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 (<FILE>) {
+ m/^([^\\$quote]|(\\.))*$quote/ && last;
+ }
+
+ $_ = <FILE>;
+ }
+
+
+ # 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 (<FILE>) {
+ 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 (<FILE>) {
-
- # 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 (<FILE>) {
- chomp;
- ( $_ eq $tag ) && last;
- }
- $_ = <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/ ) {
- $tag = $1;
- $tag =~ tr/{\(\[\#|!\//})]#|!\//;
- $tag = quotemeta($tag);
- while (<FILE>) {
- ( $_ =~ 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 <FILE>;
- }
-
- if (/^=over/) {
- /^=back/ && next while <FILE>;
- }
-
- # 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 (<FILE>) {
- m/^([^\\$quote]|(\\.))*$quote/ && last;
- }
- $_ = <FILE>;
- }
-
- 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 (<FILE>) {
- 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 (<FILE>)
- } # while (<FILE>)
+ close(FILE) || die("$0: Could not close file: '$file' : $!\n");
- close(FILE) ||
- die("$0: Could not close file: '$file' : $!\n");
-
- return;
+ return;
}
projects / pakfire.git / commitdiff
