From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: From: at@turbinal.org Date: Fri, 1 Nov 2002 03:28:13 +0300 To: devel@altlinux.ru Subject: Re: [devel] perl-5.8.0 deps -- perl.req + perl.prov.patch Message-ID: <20021101002813.GA14682@homestead.turbinal.org> Mail-Followup-To: devel@altlinux.ru References: <20021031142642.GB16140@basalt.office.altlinux.ru> <20021031213433.GB9163@homestead.turbinal.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="SLDf9lqlvOQaIe6s" Content-Disposition: inline Content-Transfer-Encoding: 8bit In-Reply-To: <20021031213433.GB9163@homestead.turbinal.org> Sender: devel-admin@altlinux.ru Errors-To: devel-admin@altlinux.ru X-BeenThere: devel@altlinux.ru X-Mailman-Version: 2.0.9 Precedence: bulk Reply-To: devel@altlinux.ru List-Unsubscribe: , List-Id: List-Post: List-Help: List-Subscribe: , List-Archive: Archived-At: List-Archive: List-Post: --SLDf9lqlvOQaIe6s Content-Type: text/plain; charset=koi8-r Content-Disposition: inline Content-Transfer-Encoding: 8bit Итак, написать регулярное выражение, которе идеально отлавливало бы все перловые зависимости, оказалось не так просто, как я сначала предполагал. Здесь одним и даже несколькими регулярными выражениями не отделаться, все пути ведут к последовательности регулярных выражений с конечным числом состояний. В определенный момент я даже подумал, что правильнее было бы что-нибудь слабать на бизоне. К счастью, у меня нет опыта лабания на бизоне. :) Всех заинтересованных лиц прошу запустить: $ perl.req --debug --method=strict /usr/lib/perl5/**/*.pm 2>&1 | less $ perl.req --debug --method=normal /usr/lib/perl5/**/*.pm 2>&1 | less $ perl.req --debug --method=relaxed /usr/lib/perl5/**/*.pm 2>&1 | less (zsh globbing) и подумать, все ли их устраивает. 2ldv: rpm пишет: /var/tmp/rpm-tmp.30255: export RPM_PERL_REQ_METHOD=" relaxed" Почему пробел, я не понял. On Fri, Nov 01, 2002 at 12:34:33AM +0300, at@turbinal.org wrote: > - normal -- то же, что и strict, плюс следующие ограничения: > + ^\s*use > + ^\s*require > + ^\s*do > + !(if|unless|eval) if,unless,eval я решил перенести в relaxed, т.к. по смыслу relaxed как раз предназначен для отсеивания условных зависимостей. > + фильтрация по списку файлов и списку зависимостей > > - relaxed -- то же самое, что и normal, плюс следующие ограничения: > + ^require > + ^do > > - none -- не поддерживается, нужно явно указать: AutoReq: yes, noperl > > > В целом же, нужно понимать, что абсолютно точно perl.req работать не > может, статус его близок к /usr/bin/buildreq. Метод "normal" должен быть > приемлем для большинства пакетов. --SLDf9lqlvOQaIe6s Content-Type: text/plain; charset=koi8-r Content-Disposition: attachment; filename="perl.req" #!/usr/bin/perl # RPM (and it's 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 . # a simple makedepends like script for perl. # To save development time I do not parse the perl grammmar 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 # modified by Mikhail Zabaluev # modified by Alexey Tourbin use 5.005; # qr use Getopt::Long; use File::Spec; GetOptions("debug" => \my $debug, "method=s" => \my $method); sub debug ($) { my $msg = shift; warn "$msg\n" if $debug; } if ($debug) { require IO::Handle; STDOUT->autoflush(1); STDERR->autoflush(1); debug "debug mode enabled"; } $method ||= $ENV{RPM_PERL_REQ_METHOD}; $method =~ s/\s+//g; $method eq "strict" || $method eq "normal" || $method eq "relaxed" || die "$0: strcit, normal, relaxed methods supported\n"; debug "method = $method"; my @ignore_files = ( qr(/usr/share/doc/), qr(/[Dd]emos?/), qr(/examples?/), ); my @ignore_reqs = ( qr(^Makefile\b), # OS-specific qr(^machine/ansi\b), qr(^sys/systeminfo\b), qr(^vmsish\b), qr(^MacPerl\b), qr(^VMS/), qr(^OS2/), qr(^Mac/), qr(^ExtUtils/XSSymSet\b), qr(^Convert/EBCDIC\b), # old names qr(^Digest/Perl/MD5\b), qr(^Pod/PlainText\b), # wrong names qr(/\.), qr(\$), # MDK: skip if the phrase was "use of" -- shows up in gimp-perl, et al qr(^of$), ); 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($_); } } MODULE: foreach $module (sort keys %require) { unless ($method eq "strict") { for my $re (@ignore_reqs) { if ($module =~ $re) { debug "module $module matches $re; skip"; next MODULE; } } } if (length($require{$module}) == 0) { print "perl($module)\n"; } else { print "perl($module) >= $require{$module}\n"; } } exit 0; sub process_file { my ($file) = @_; chomp($file); return if $file eq ''; unless ($method eq "strict") { foreach my $re (@ignore_files) { if ($file =~ $re) { debug "file: $file matches: $re; skip"; return; } } } open(FILE, "<$file")|| die("$0: Could not open file: '$file' : $!\n"); 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[12]|pod|over|item|for|begin)/) .. (m/^=(cut)/)) { next; } if ( (m/^=(over)/) .. (m/^=(back)/) ) { next; } # skip the data section # AT: but what about AutoLoader and SelfLoader? (TODO) 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. if ( m/^\s*\$RPM_Requires\s*=\s*["'](.*)['"]/i) { foreach (split(/\s+/, $1)) { print "$_\n"; } next; } chomp; s/#.*//; next unless /\b(use|require|do)\b/; # do not want 'do {' loops next if /\bdo\s*{/; # do not want 'do {' loops next if /^\s*["']/; # print "just use it"; if (/^\s*(?:(?!use|require|do|eval|if|unless)[\w:$->]+\s*)+\(/) { debug "skip: $_"; next; } if (/^\s*(?:(?!use|require|do|eval|if|unless)[\w:]+\s*)+\(?(['"]).*\1/) { debug "skip: $_"; next; } next unless /^(.*?)\b(use|do|require)\s+(['"]?)([.:\w\/]+)\3\s*(.*)/; my ($indent, $statement, $quote, $module, $rest) = ($1, $2, $3, $4, $5); debug "line: $_"; next if $module =~ m/\$/; next if $module !~ m/\w/; # conditional statements if (/\b(if|unless|eval)\b/ && $method eq "relaxed") { debug "file: $file requires: $module (conditional); skip"; next; } # indent is somewhat unclear if ($indent =~ /[^\w\s{}();:]/ && $method ne "strict") { debug "file: $file requires: $module (indent unclear); skip"; next; } # statement requires a particular version of Perl if ($module =~ m/^v?[0-9._]+$/ && $rest =~ /^;|\s*$/) { print "perl-base >= " . package_version($module, '%.5f') . "\n"; next; } if ($statement eq "require") { if ($indent =~ /^\s+$/ && $method eq "relaxed") { debug "file: $file s: $module (whitespace); skip"; next; } if ($indent =~ /\S/ && $method ne "strict") { debug "file: $file s: $module (inside); skip"; next; } } if ($statement eq "do") { if ($indent =~ /^\s+$/ && $method eq "relaxed") { debug "file: $file es: $module (whitespace); skip"; next; } if ($indent =~ /\S/ && $method ne "strict") { debug "file: $file es: $module (inside); skip"; next; } } if ($statement eq "use") { if ($indent =~ /\S/ && $method ne "strict") { debug "file: $file s: $module (inside); skip"; next; } } # filename if ($quote && $module =~ /^\w+(\/\w+)*\.p[lmh]$/ && $rest =~ /^$|;/ && ($statement eq "do" || $statement eq "require")) { $require{$module} = undef; debug "\$require{$module} = yes"; next; } # modules, variables, lists my $m = qr/[:\w]+/; my $v = qr/[\$\%\@]$m/; my $s = qr/(?:[\s\t,]|=>)/; my $ml = qr/^\s*(?:qw)?[\/('"]?\s*($m(?:$s$m)*)/; my $fl = qr/^\s*(?:qw)?[\/('"]?\s*($m(?:$s$m)*)/; my $vl = qr/^\s*(?:qw)?[\/('"]?\s*($v(?:$s$v)*)/; # special pragma (vars, subs) if (($module eq "vars" || $module eq "subs") && $rest =~ $vl) { my $mod = module_filename($module); $require{$mod} = undef; debug "$module: \$requires{$mod} = yes"; next; } # special pragma (constant) if ($module eq "constant" && $rest =~ $ml) { my $mod = module_filename($module); $require{$mod} = undef; debug "$module: \$requires{$mod} = yes"; next; } # special pragma (base, autouse) if (($module eq "base" || $module eq "autouse") && $rest =~ $vl) { my $modules = $1; my @modules = split $s, $modules; foreach my $mod (@modules, $module) { if ($mod =~ /^\w+(::\w+)*$/) { $mod = module_filename($mod); $require{$mod} = undef; debug "$module: \$requires{$mod} = yes"; } } next; } # special pragma (overload) if ($statement eq "use" && $module eq "overload" && $rest =~ /'|"|=>|,/) { my $mod = module_filename($module); $require{$mod} = undef; debug "\$requires{$mod} = yes"; next; } # perl module if ($module && $module =~ /^\w+(::\w+)*$/ && ($rest =~ /^$|^[;}"']|\b(if|unless|eval)\b|\(|^v?\d|qw|$fl/ && $indent =~ /^\s*$|[^\w\s]\s*$/) && ($statement eq "use" || $statement eq "require")) { $module = module_filename($module); my ($version) = $rest =~ /^(v?[0-9._]+)\b/; if ($version) { $version = package_version($version); debug "\$require{$module} >= $version"; $require{$module} = $version unless $require{$module} && $require{$module} >= $version; } else { $require{$module} = undef; debug "\$require{$module} = yes"; } next; } debug "untrapped: $_"; } close(FILE)|| die("$0: Could not close file: '$file' : $!\n"); return ; } # module_filename($name) - # converts module name to relative file path sub module_filename { my $name = shift; $name =~ s{::|'}{/}g; return $name . '.pm'; #' } # package_version($version[, $oldformat]) - # converts Perl version constant to RPM package version. # New style 'vN.N.N' numbers are converted to epoch 1 versions, # whereas old-style floating point versions are given epoch 0 and # optionally formatted by sprintf() using supplied format. # Parameters: # $version - version number in 'vN.N.N' or 'N.NNN_NN' format # $oldformat - format specifier for sprintf() used to format old-style # floating-point version number sub package_version { my $version = shift; if ($version =~ s/^v// || $version =~ /\.[\d_]+\./) { return "1:$version"; } else { my $format = shift; $format = '%s' unless defined $format; return '0:' . sprintf($format, $version); } } --SLDf9lqlvOQaIe6s Content-Type: text/plain; charset=koi8-r Content-Disposition: attachment; filename="perl.prov.patch" --- perl.prov.orig 2002-03-26 00:53:08 +0300 +++ perl.prov 2002-11-01 01:52:25 +0300 @@ -46,6 +46,7 @@ # by Ken Estes Mail.com kestes@staff.mail.com # modified by Mikhail Zabaluev +# modified by Alexey Tourbin require v5.6.0; @@ -154,6 +155,10 @@ my $inpackage = 0; + my ($package_name, $package_filename); + my $module_path = $module_file; + $module_path =~ s/(.+?)\/(.+)/$1\//; + while () { # skip the documentation @@ -166,6 +171,10 @@ next; } + if ( (m/^=(over)/) .. (m/^=(back)/) ) { + next; + } + # skip the data section if (m/^__(DATA|END)__$/) { last; @@ -175,25 +184,43 @@ # package name so we browse through all namespaces if (m/^\s*package\s+([\w:']+)\s*;/) { - $inpackage = (module_filename($1) eq $module_file)? 1 : 0; - next; + +# AT: +# $ grep '^[ \t]*package' /usr/lib/perl5/i386-linux/B/CC.pm +# /usr/lib/perl5/i386-linux/B/CC.pm:package B::CC; +# /usr/lib/perl5/i386-linux/B/CC.pm: package B::Pseudoreg; +# /usr/lib/perl5/i386-linux/B/CC.pm: package B::Shadow; + + $package_name = $1; + $package_filename = module_filename($package_name); + next if $package_filename eq $module_file; + if ($module_path && index($package_filename, $module_path) == 0) { + $provide{$package_filename} = undef; + } else { + undef $package_name; + undef $package_filename; + } + next; } # 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. - if ($inpackage && + if ($package_filename && s/^([\s(]*)(our\s*)?\$VERSION\s*=/$1\$VERSION =/) { - $provide{$module_file} = extract_version($_); + $provide{$package_filename} = extract_version($_); next; } # also consider version initializations with explicit package specification if (s/^([\s(]*)(our\s*)?\$([\w:']+)::VERSION\s*=/$1\$VERSION =/) { - if (module_filename($3) eq $module_file) { - $provide{$module_file} = extract_version($_); + my $filename = module_filename($3); + if ($filename eq $module_file || + $module_path && index($filename, $module_path) == 0) + { + $provide{$filename} = extract_version($_); } next; } --SLDf9lqlvOQaIe6s--