[devel] perl-5.8.0 deps -- perl.req + perl.prov.patch
=?iso-8859-1?q?at_=CE=C1_turbinal=2Eorg?=
=?iso-8859-1?q?at_=CE=C1_turbinal=2Eorg?=
Пт Ноя 1 03:28:13 MSK 2002
Итак, написать регулярное выражение, которе идеально отлавливало бы все
перловые зависимости, оказалось не так просто, как я сначала
предполагал. Здесь одним и даже несколькими регулярными выражениями не
отделаться, все пути ведут к последовательности регулярных выражений с
конечным числом состояний. В определенный момент я даже подумал, что
правильнее было бы что-нибудь слабать на бизоне. К счастью, у меня нет
опыта лабания на бизоне. :)
Всех заинтересованных лиц прошу запустить:
$ 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" должен быть
> приемлем для большинства пакетов.
----------- следующая часть -----------
#!/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 <ewt на redhat.com>.
# 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 <mookid на mu.ru>
# modified by Alexey Tourbin <at на turbinal.org>
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 (<FILE>) {
# 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 <require>s: $module (whitespace); skip";
next;
}
if ($indent =~ /\S/ && $method ne "strict") {
debug "file: $file <require>s: $module (inside); skip";
next;
}
}
if ($statement eq "do") {
if ($indent =~ /^\s+$/ && $method eq "relaxed") {
debug "file: $file <do>es: $module (whitespace); skip";
next;
}
if ($indent =~ /\S/ && $method ne "strict") {
debug "file: $file <do>es: $module (inside); skip";
next;
}
}
if ($statement eq "use") {
if ($indent =~ /\S/ && $method ne "strict") {
debug "file: $file <use>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);
}
}
----------- следующая часть -----------
--- 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 <mookid на mu.ru>
+# modified by Alexey Tourbin <at на turbinal.org>
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 (<FILE>) {
# 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;
}
Подробная информация о списке рассылки Devel