uawdijnntqw1x1x1
IP : 18.191.240.182
Hostname : ns1.eurodns.top
Kernel : Linux ns1.eurodns.top 4.18.0-553.5.1.lve.1.el7h.x86_64 #1 SMP Fri Jun 14 14:24:52 UTC 2024 x86_64
Disable Function : mail,sendmail,exec,passthru,shell_exec,system,popen,curl_multi_exec,show_source,eval,open_base
OS : Linux
PATH:
/
home
/
sudancam
/
..
/
..
/
.
/
lib
/
python2.7
/
..
/
rpm
/
perl.req
/
/
#!/usr/bin/perl # 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. # Alternatively, all of the source code in the lib subdirectory of the # RPM source code distribution as well as any code derived from that # code may instead be distributed under the GNU Library General Public # License (LGPL), at the choice of the distributor. The complete text # of the LGPL appears at the bottom of this file. # This alternatively is allowed to enable applications to be linked # against the RPM library (commonly called librpm) without forcing # such applications to be distributed under the GPL. # Any questions regarding the licensing of RPM should be addressed to # Erik Troan <ewt@redhat.com>. # a simple makedepend like script for perl. # 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. # It would be much better if perl could tell us the dependencies of a # given script. # The filenames to scan are either passed on the command line or if # that is empty they are passed via stdin. # If there are strings in the file which match the pattern # m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i # then these are treated as additional names which are required by the # file and are printed as well. # I plan to rewrite this in C so that perl is not required by RPM at # build time. # by Ken Estes Mail.com kestes@staff.mail.com $HAVE_VERSION = 0; eval { require version; $HAVE_VERSION = 1; }; use File::Basename; my $dir = dirname($0); $HAVE_PROV = 0; if ( -e "$dir/perl.prov" ) { $HAVE_PROV = 1; $prov_script = "$dir/perl.prov"; } if ("@ARGV") { foreach my $file (@ARGV) { process_file($file); process_file_provides($file); compute_global_requires(); } } else { # notice we are passed a list of filenames NOT as common in unix the # contents of the file. foreach my $file (<>) { process_file($file); process_file_provides($file); compute_global_requires(); } } foreach $perlver (sort keys %perlreq) { print "perl >= $perlver\n"; } foreach my $module (sort keys %global_require) { if (length($global_require{$module}) == 0) { print "perl($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($module) >= $global_require{$module}\n"; } } exit 0; sub compute_global_requires { # restrict require_removable to all non provided by the file foreach my $moduler (sort keys %require_removable) { if (exists $provide{$moduler} && length($require_removable{$moduler}) == 0) { $require_removable = delete $require_removable{$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; } } # store requires_removable to global_requires foreach my $module (sort keys %require_removable) { my $oldver = $global_require{$module}; my $newver = $require_removable{$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 %require_removable; undef %provide; } 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 add_require_removable { my ($module, $newver) = @_; my $oldver = $require_removable{$module}; if ($oldver) { $require_removable{$module} = $newver if ($HAVE_VERSION && $newver && version->new($oldver) < $newver); } else { $require_removable{$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 "= <<" block if (m/^\s*(?:my\s*)?\$(?:.*)\s*=\s*<<\s*(["'`])(.+?)\1/ || m/^\s*(?:my\s*)?\$(.*)\s*=\s*<<(\w+)\s*;/) { $tag = $2; 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]+/; # # The (require|use) match further down in this subroutine will match lines # within a multi-line print or return statements. So, let's skip over such # statements whose content should not be loading modules anyway. -BEF- # if (m/print(?:\s+|\s+\S+\s+)\<\<\s*(["'`])(.+?)\1/ || m/print(\s+|\s+\S+\s+)\<\<(\w+)/ || m/return(\s+)\<\<(\w+)/ ) { my $tag = $2; while (<FILE>) { chomp; ( $_ eq $tag ) && last; } $_ = <FILE>; } # 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>; } # 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 (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); # 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; # 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(^/)) { 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. $module =~ s/\.pm$//; # some perl programmers write 'require URI/URL;' when # they mean 'require URI::URL;' $module =~ s/\//::/; # trim off trailing parentheses if any. Sometimes people pass # the module an empty list. $module =~ s/\(\s*\)$//; if ( $module =~ m/^v?([0-9._]+)$/ ) { # 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; if ($ver =~ /5.00/) { $perlreq{"0:$ver"} = 1; next; } else { $perlreq{"1:$ver"} = 1; next; } }; # 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 if ($statement eq "use" && ($module eq "base" || $module eq "parent")) { add_require($module, undef); if ($version =~ /^qw\s*[(\/'"]\s*([^)\/"']+?)\s*[)\/"']/) { add_require($_, undef) for split(' ', $1); } elsif ($version =~ /(["'])([^"']+)\1/) { # requires like "use base name" can be removed if they are # provided in the same file if (($whitespace eq "") && ($statement eq "use") && ($module eq "base")) { add_require_removable($2, undef); } else { add_require($2, undef); } } next; } $version = undef unless $version =~ /^$modver_re$/o; add_require($module, $version); } } close(FILE) || die("$0: Could not close file: '$file' : $!\n"); return; } sub process_file_provides { my ($file) = @_; chomp $file; return if (! $HAVE_PROV); my @result = readpipe( "$prov_script $file" ); foreach my $prov (@result) { $provide{$1} = undef if $prov =~ /perl\(([_:a-zA-Z0-9]+)\)/; } }
/home/sudancam/../.././lib/python2.7/../rpm/perl.req