From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Date: Fri, 21 Mar 2003 20:16:20 +0300 From: Alexey Tourbin To: devel@altlinux.ru Message-ID: <20030321171620.GB21030@solemn.turbinal.org> Mail-Followup-To: devel@altlinux.ru References: <20030321120157.3236892d.ssv@altlinux.ru> <20030321100246.GA8864@solemn.turbinal.org> <20030321163508.GE28673@osdn.org.ua> Mime-Version: 1.0 Content-Type: multipart/signed; micalg=pgp-sha1; protocol="application/pgp-signature"; boundary="yVhtmJPUSI46BTXb" Content-Disposition: inline In-Reply-To: <20030321163508.GE28673@osdn.org.ua> Subject: [devel] Re: RPM requires -- perl 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: --yVhtmJPUSI46BTXb Content-Type: multipart/mixed; boundary="aVD9QWMuhilNxW9f" Content-Disposition: inline Content-Transfer-Encoding: 8bit --aVD9QWMuhilNxW9f Content-Type: text/plain; charset=koi8-r Content-Disposition: inline Content-Transfer-Encoding: 8bit On Fri, Mar 21, 2003 at 06:35:08PM +0200, Michael Shigorin wrote: > > Нет. У вас определяется внутренняя зависимость внутри пакета > > (Rrequires), но не определяется Provides. См. ответ inger'а. > > Вообще меня тоже удивило -- жалко, что сломалось то, что просто > работало... впрочем, майнтейнеру виднее. Что именно раньше "просто работало" и что сломалось? Тут просто такая специфика что Prefix1::Prefix2::Module преобразуется в $PATH/Prefix1/Prefix2/Module.pm, а $PATH может иметь нестандарнтые значения (подцепляется через perl -I$PATH или use lib $PATH). Кста, у меня есть наброски /usr/lib/rpm/perl.{req,prov}, которые используют B::Deparse и B::Xref (inspired by mhz). Но они пока не работают как надо. И у меня есть некоторые сомнения. Впрочем, perl.req уже можно показать. --aVD9QWMuhilNxW9f Content-Type: text/plain; charset=us-ascii 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.8.0; use Getopt::Long; use Fcntl; use strict; GetOptions("debug" => \my $debug, "method=s" => \my $method); sub debug ($) { my $msg = shift; warn "$msg\n" if $debug; 1; } if ($debug) { require IO::Handle; STDOUT->autoflush(1); STDERR->autoflush(1); debug "debug mode enabled"; } $method ||= $ENV{RPM_PERL_REQ_METHOD}; $method eq "strict" || $method eq "normal" || $method eq "relaxed" || die "$0: strict, 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(^Win32\b), qr(^VMS\b), qr(^OS2\b), qr(^Mac\b), qr(^ExtUtils/XSSymSet\b), qr(^Convert/EBCDIC\b), # old names qr(^Digest/Perl/MD5\b), qr(^Pod/PlainText\b), # wrong names qr(/\.), qr(\$), # so commonly used... just a database junk (guaranteed to be in perl-base) qr(^strict\.pm$), qr(^vars\.pm$), ); # begin process_file($_) foreach @ARGV ? @ARGV : <>; sub process_file { my $fname = shift; chomp $fname; return unless $fname; if ($method ne "strict") { foreach my $re (@ignore_files) { if ($fname =~ $re) { debug "file: $fname matches: $re; skip"; return; } } } debug "processing $fname"; # skip "syntax OK" messages # fcntl(STDERR, F_SETFD, 1) unless $debug; open(PIPE, "-|", $^X, "-MO=Deparse", $fname) || die; process_line($_) while ; } my %req; sub process_line { my $line = shift; my $re_mod = qr/\b(?!\d)\w+(?:::(?!\d)\w+)*/; my $re_fna = qr//; my $re_ver = qr/\bv?[0-9]+(?:\.[0-9]+(?:_[0-9]+)?)*\b/; again: if ($line =~ /^\s*(?:use|require) ($re_ver)/) { $req{"perl-base"}{package_version($1, '%.5f')}++; } elsif ($line =~ /^\s*use ($re_mod) ($re_ver)/) { $req{package_filename($1)}{package_version($2)}++; } elsif ($line =~ /^\s*use ($re_mod)/) { $req{package_filename($1)} ||= undef; } elsif ($line =~ /^(\s*)require ($re_mod)( if\b| unless\b)?/) { if ($3 && $method ne "strict") { debug "skip: $line (conditional)"; } elsif ($1 && $method ne "strict") { debug "skip: $line (indent)"; } else { $req{package_filename($2)} ||= undef; } } } sub package_filename { my $package = shift; $package =~ s/::/\//g; return $package . '.pm'; } sub package_version { my ($version, $fmt) = (@_, '%s'); $version =~ s/_//g; if ($version =~ s/^v// || $version =~ /\.\d+\./) { return "1:$version"; } else { $version = sprintf($fmt, $version); return "0:$version"; } } # end while (my ($k, $v) = each %req) { foreach my $ver (ref $v ? keys %$v : undef) { print $k eq "perl-base" ? $k : "perl($k)"; print " >= $ver" if defined $ver; print "\n"; } } __END__ } elsif ($line =~ /^(\s*)(use|require|do) ([^\s;,]+)(.*)/) { my ($ind, $sta, $tok, $rst) = ($1, $2, $3, $4); my ($condit) = $rst =~ /($re_cnd)/; my ($module) = $tok =~ /($re_mod)/; my ($filena) = $tok =~ /($re_fna)/; if ($condit && $method ne "strict" && $sta ne "use") { debug "skip: $line (conditional)"; } elsif ($sta eq "use" && $module) { print "use perl($module)\n"; } elsif ($sta eq "require" && $module && $ind && $method ne "strict") { debug "skip: $line (indent)"; } elsif ($sta eq "require" && $module) { print "require perl($module)\n"; } else { print "???: $line\n"; } } } 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 --aVD9QWMuhilNxW9f-- --yVhtmJPUSI46BTXb Content-Type: application/pgp-signature Content-Disposition: inline -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.1 (GNU/Linux) iD8DBQE+e0jkfBKgtDjnu0YRAovQAJ9qxt0TBf9tycSQY+uCVt6pGb2iggCgxHlT 18ziST8bez1q1m1zOKZ5wuA= =xi93 -----END PGP SIGNATURE----- --yVhtmJPUSI46BTXb--