From mboxrd@z Thu Jan 1 00:00:00 1970 To: devel@linux.iplabs.ru Message-ID: <20001125000746.A21245@localhost.localdomain> Mail-Followup-To: mookid@sigent.ru, devel@linux.iplabs.ru Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="OXfL5xGRrasGEqWY" Content-Disposition: inline Content-Transfer-Encoding: 8bit User-Agent: Mutt/1.2i From: mookid@sigent.ru (Mikhail Zabaluev) Subject: [devel] autodeps Sender: devel-admin@linux.iplabs.ru Errors-To: devel-admin@linux.iplabs.ru X-BeenThere: devel@linux.iplabs.ru X-Mailman-Version: 2.0beta6 Precedence: bulk Reply-To: devel@linux.iplabs.ru List-Help: List-Post: List-Subscribe: , List-Id: IPLabs Linux Team Developers mailing list List-Unsubscribe: , List-Archive: http://www.logic.ru/pipermail/devel/ X-Original-Date: Sat, 25 Nov 2000 00:07:46 +0300 Date: Sat, 25 Nov 2000 00:07:46 +0300 Archived-At: List-Archive: List-Post: --OXfL5xGRrasGEqWY Content-Type: text/plain; charset=koi8-r Content-Disposition: inline Content-Transfer-Encoding: 8bit Привет. Обнаружил, в чем проблема с 'AutoReqProv: perl' в rpm. Скрипт find-provides слишком полагается на суждение программы file о том, что есть perl script. Та, на самом деле, почти никогда не скажет такого о модуле, который не начинается со строки типа '#!/usr/bin/perl'. file-3.33-1mdk вообще считает многие модули какими-то файлами для palmtop'а Newton, даже не текстовыми! Пришлось отучать. Прилагаю патч для find-{provides,requires} и снова perl.prov - там нужно было добавить содержимое RPM_BUILD_ROOT ко всем путям поиска. Следует заметить, что скриптам perl.prov и perl.req лучше давать весь список файлов зараз - так _намного_ быстрее. Еще есть предложения: - добавить еще один псевдоним для значения по умолчанию Auto{Req,Prov} - 'default', чтобы можно было писать 'AutoReqProv: default, perl' или 'AutoReqProv: default, noshell'; - реализовать подстановку переменной окружения RPM_PERL_LIB_PATH для perl.prov из макроса. -- Stay tuned, MhZ mailto:mookid@sigent.ru ----------- Mr. Cole's Axiom: The sum of the intelligence on the planet is a constant; the population is growing. --OXfL5xGRrasGEqWY Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="reqprov.patch" --- find-provides.orig Fri Nov 24 18:51:28 2000 +++ find-provides Fri Nov 24 22:28:31 2000 @@ -91,7 +91,7 @@ { local f="$1" local t="$2" - if [ -z "${t/$f: perl script text*/}" ]; then + if [ -z "${t/$f: perl script text*/}" -o -z "${f/*.p[lmh]/}" ]; then if [ -n "$FIND_PERL" ]; then /usr/lib/rpm/perl.prov "$f" fi @@ -129,7 +129,7 @@ while IFS= read -r f; do if t="$(file -L "$f")"; then - if [ -z "${t/$f: * script text*/}" ]; then + if [ -z "${t/$f: * text*/}" ]; then FOUND_PROVS="$FOUND_PROVS $(FindScriptProvs "$f" "$t")" elif [ -z "${t/$f: * shared object*/}" ]; then --- find-requires.orig Fri Nov 24 18:51:39 2000 +++ find-requires Fri Nov 24 22:28:21 2000 @@ -115,7 +115,7 @@ if [ -n "$FIND_SHELL" ]; then /usr/lib/rpm/shell.req "$f" fi - elif [ -z "${t/$f: perl script text*/}" ]; then + elif [ -z "${t/$f: perl script text*/}" -o -z "${f/*.p[lmh]/}" ]; then if [ -n "$FIND_PERL" ]; then /usr/lib/rpm/perl.req "$f" fi @@ -164,7 +164,7 @@ while IFS= read -r f; do t="$(file "$f")" - if [ -z "${t/$f: * script text*/}" ]; then + if [ -z "${t/$f: * text*/}" ]; then FOUND_REQS="$FOUND_REQS $(FindScriptReqs "$f" "$t")" elif [ -z "${t/$f: * executable*/}" ]; then --OXfL5xGRrasGEqWY Content-Type: text/plain; charset=us-ascii Content-Disposition: attachment; filename="perl.prov" #!/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 alternative 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 script to print the proper name for perl libraries. # 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 proper name 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 lines in the file which match the pattern # (m/^\s*\$VERSION\s*=\s+/) # then these are taken to be the version numbers of the modules. # If there are strings in the file which match the pattern # m/^\s*\$RPM_Provides\s*=\s*["'](.*)['"]/i # then these are treated as additional names which are provided by the # file and are printed as well. # The RPM_PERL_LIB_PATH environment variable, if set, must contain the list of # absolute paths, separated by colons, spaces or commas. These paths are # considered as library paths used to determine relative names of provided # perl files. If RPM_PERL_LIB_PATH is not set, paths from @INC Perl variable # are used instead. # by Ken Estes Mail.com kestes@staff.mail.com # modified by Mikhail Zabaluev require v5.6.0; use Safe; use strict; use vars qw(%provide @perl_inc); # obtain the list of library directories. If not provided, use @INC if (exists $ENV{RPM_PERL_LIB_PATH}) { @perl_inc = split(/[:,\s]+/, $ENV{RPM_PERL_LIB_PATH}); } else { @perl_inc = grep { m|^/| } @INC; } # Sort @perl_inc descending by length to search for longest prefix rapidly. @perl_inc = sort { length($b) <=> length($a) } @perl_inc; # Prepend $RPM_BUILD_ROOT to paths. my $buildroot = $ENV{RPM_BUILD_ROOT}; @perl_inc = map { "${buildroot}$_" } @perl_inc; # process files 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($_); } } # print out sorted results foreach my $module (sort keys %provide) { my $version = $provide{$module}; if (length($version) == 0) { print "perl($module)\n"; } else { print "perl($module) = $version\n"; if ($version =~ /^1:(.*)/) { # provide an additional epoch 0 version converted using Perl's rules my $fpver = 0; my $ratio = 1; my @series = split(/\./, $1); for (@series) { $fpver += $_ * $ratio; $ratio *= 0.001; } my $fdigits = $#series * 3; printf("perl($module) = 0:%.${fdigits}f\n", $fpver); } } } exit 0; sub process_file { my ($file) = @_; chomp $file; # find the longest matching prefix among Perl library search directories my $prefix = ''; foreach (@perl_inc) { if (substr($file, 0, length($_)) eq $_) { $prefix = $_; last; } } return if $prefix eq ''; # get path to the module file without prefix my $module_file = substr($file, length($prefix)); $module_file =~ s{^/}{}; $provide{$module_file} = undef; return if $module_file !~ /\.pm$/; # try to extract version number for this package open(FILE, "<$file")|| die("$0: Could not open file: '$file' : $!\n"); my $inpackage = 0; 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; } # 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 browse through all namespaces if (m/^\s*package\s+([\w:']+)\s*;/) { $inpackage = (module_filename($1) eq $module_file)? 1 : 0; 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 && s/^([\s(]*)(our\s*)?\$VERSION\s*=/$1\$VERSION =/) { $provide{$module_file} = 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($_); } next; } # 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_Provides\s*=\s*["'](.*)['"]/i) { foreach (split(/\s+/, $1)) { print "$_\n"; } } } 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'; } # extract_version - # this subroutine tries to evaluate line containing assignment to $VERSION # in order to achieve version number sub extract_version { my $line = shift; # Try to evaluate the assignment to get the value of $VERSION. # It is usually computed without using data external to the expression, # so we would have no problems. local $SIG{__WARN__} = sub { }; my $safe = new Safe; $safe->permit_only(qw(:base_core :base_mem :base_loop :base_orig entereval)); my $version = $safe->reval("$line; \$VERSION;"); return undef if $@ || length($version) == 0; if ($version =~ s/^\s*(\d[\d_]*(\.[\d_]*)?|\.[\d_]+)/$1/) { # plain old numeric version return '0:' . $version; } else { # Supposedly, a new style version evaluated as a string constant. # Return an epoch 1 version return sprintf('1:%vd', $version); } return undef; } --OXfL5xGRrasGEqWY-- _______________________________________________ Devel mailing list Devel@linux.iplabs.ru http://www.logic.ru/mailman/listinfo/devel