[devel] perl packages

[Alexey Tourbin]

Господа,

наверное все уже почувствовали, что настало время повысить качество
сборки пакетов.  Для этого мы изобретаем хитроумные механизмы и проч.
Короче, предлагаю новые правила сборки перловых пакетов:

- пакет должен пересобираться в hasher'е (или в sandman'е)
- пакет должен иметь адекватные зависимости BuildRequires, полученные
  с помощью buildreq (как минимум perl-devel); замечание: пока иногда
  придется делать buildreq --args=-bi *.spec
- пакет должен собираться с помощью макросов %perl_vendor_build и
  %perl_vendor_install (кстати, они умеют брать параметры)
- пакет должен проходить все тесты; исключения:
  + требуется запуск X
  + требуется запуск системных сервисов
  + подразумевается специальная сетевая активность
  + подразумеваются специальные требования к среде сборки (будет уточнено)
  В случае исключения maintainer должен под честное слово и gpg подпись
  проверить в полноценной сборочной среде, что все тесты проходят.
  Напоминаю, что тесты можно отключать избирательно (в случае исключений).
- все перловые файлы в пакете должны проходить 'perl -c' syntax check на
  стадии find-requires; это связано в том числе и с тем, что новый
  скрипт perl.req, который может появиться уже в ближайшей сборке
  rpm-build, предъявляет по сути эквивалентное требование

Думаю, что со временем аналогичные по духу требования будут предъявлены
ко всем пакетам.

Мелочи:

- не надо писать Summary: %module module for Perl
- рекомендуется писать Url: http://serch.cpan.org/dist/%module/

Теперь статистика.  По состоянию на вчера в SRPMS.classic имеется 154
perl* пакетов.  60 из них не отвечает новым требованиями, т.е., попросту
говоря, не пересобираются.  Многие из них не пересобираются "вообще" (на
стадии %build).  Список пакетов, которые не пересобираются:

perl-5.8.1-alt1.RC4.src.rpm
perl-Apache-Session-1.54-alt1.src.rpm
perl-Archive-Tar-1.04-alt1.src.rpm
perl-Authen-SASL-2.03-alt1.src.rpm
perl-Authen-Smb-0.91-alt1.src.rpm
perl-BerkeleyDB-0.23-alt1.src.rpm
perl-BSD-Resource-1.22-alt1.src.rpm
perl-CDB_File-0.92-alt1.src.rpm
perl-CGI-3.00-alt1.src.rpm
perl-CGI-SpeedyCGI-2.21-alt1.src.rpm
perl-DBD-InterBase-0.41-alt1.src.rpm
perl-DBI-1.37-alt1.src.rpm
perl-Digest-HMAC-1.01-alt3.src.rpm
perl-Event-0.87-alt1.src.rpm
perl-Expect-1.15-alt2.src.rpm
perl-File-Tail-0.98-alt2.src.rpm
perl-Finance-Quote-1.07-alt2.src.rpm
perl-Finance-QuoteHist-0.31-alt1.src.rpm
perl-GD1-1.41-alt3.src.rpm
perl-GD2-2.041-alt2.src.rpm
perl-gettext-1.01-alt2.src.rpm
perl-Glade-0.61-alt0.1.src.rpm
perl-GTK-0.7008-alt10.src.rpm
perl-HTML-Format-2.03-alt1.src.rpm
perl-HTML-Tree-3.17-alt1.src.rpm
perl-IO-Tty-1.02-alt2.src.rpm
perl-IPC-SharedCache-1.3-alt2.src.rpm
perl-IPC-ShareLite-0.09-alt1.src.rpm
perl-ldap-0.27.01-alt1.src.rpm
perl-libxml-perl-0.07-alt3.src.rpm
perl-MailTools-1.58-alt1.src.rpm
perl-MDK-Common-1.0.3-alt1.src.rpm
perl-MLDBM-2.01-alt1.src.rpm
perl-Mon-0.11-alt1.src.rpm
perl-Net-Daemon-0.37-alt1.src.rpm
perl-Net_SSLeay-1.22-alt1.src.rpm
perl-Net-Telnet-3.03-alt1.src.rpm
perl-PDL-2.340-alt3.src.rpm
perl-PlRPC-0.2017-alt1.src.rpm
perl-RPM-0.40.0-alt2.src.rpm
perl-SGMLSpm-1.03ii-alt4.src.rpm
perl-sh-0.009-alt5.src.rpm
perl-Storable-2.07-alt1.src.rpm
perl-Template-2.09-alt1.1.src.rpm
perl-Term-ReadKey-2.21-alt1.src.rpm
perl-Tk-800.024-alt2.src.rpm
perl-Tk-JPEG-2.014-alt2.src.rpm
perl-Video-DVDRip-0.50.13-alt0.5.src.rpm
perl-XML-DOM-1.43-alt2.src.rpm
perl-XML-Dumper-0.4-alt2.src.rpm
perl-XML-Grove-0.46-alt1.alpha.src.rpm
perl-XML-LibXML-1.54-alt1.src.rpm
perl-XML-LibXML-Common-0.13-alt1.src.rpm
perl-XML-Parser-2.31-alt2.src.rpm
perl-XML-Sablotron-0.98-alt1.src.rpm
perl-XML-SAX-0.12-alt1.src.rpm
perl-XML-Simple-2.08-alt2.src.rpm
perl-XML-Twig-3.09-alt1.src.rpm
perl-XML-Writer-0.4-alt2.src.rpm
perl-XML-XPath-1.13-alt1.src.rpm

Предлагается привести пакеты в соответствие с новыми требованиями.
В сущности, несколько maintainer'ов получили это предложение ещё вчера.
Отказ от предложения может привести к перемещению пакета в orphaned. :)

PS: спрашивайте, если что.
PPS: новые скрипты приаттачены, comments are welcome.
----------- следующая часть -----------
#!/usr/bin/perl

=head1	NAME

perl.req - calculate the requirements for Perl sources

=head1	SYNOPSIS

B<perl.req> --method=normal /path/to/Module.pm

echo /path/to/Module.pm | RPM_PERL_REQ_METHOD=normal B<perl.req>

=head1	DESCRIPTION

This Perl script is intended for automatic detection of modules the given Perl
code depends on.  It looks for common C<use>, C<require> and C<do> statements
and extracts module and version requirements for RPM C<Requires:> clause.

Unlike earlier versions, this script uses B::Deparse (Perl compiler backend,
see C<perldoc B::Deparse>) to re-format Perl code.  This makes dependency
extraction more accurate and simple, but this also has some tremendous
implication: all Perl code should pass C<perl -c> syntax check, since the
compile stage (see C<perldoc perlcompile>) happens for all the code that gets
deparsed.  This is a very strong requirement, but as we talk about packaging
quality, this is considered good.

=head2	Invocation

=head2	Dependencies

For old-style perl libraries and C<*.ph> files, depndencies look like this:

	perl(library.pl)
	perl(header.ph)

And for Perl5 modules like this:

	perl(Some/Module.pm)

The latter differs from the original RedHat RPM style, in which module
dependencies look like C<perl(Some::Module)>.  The style was changed long ago,
and I don't know the exact reason why. :)

=head2	Versioning

For old-style floating point versioning, versions look like this:

	0:5.005003

And for new v-string style versioning:

	1:5.8.1

Please note that RPM does not understand "decimal dot" in versions, so
sometimes you may need to adjust the percision to fit the version in
C<Provides:> clause.

=head2	Methods

The following three modes or "methods" are supported by this script:

=over

=item	strict

In this mode, C<perl.req> goes straight and tries to extract all the
dependencies that happen to be in the given perl code, including
platform-specific dependencies, conditional ones, etc.  This mode is useful for
debugging, but in some cases it can produce too strong/overkill requirements of
your package.

=item	normal

This mode is recommended for default use.  It tries to skip the dependencies
that are too strong by the following criteria:

=over

=item	file list

There's a simple file list in this script by which certain files are
ignored.  E.g., it will not look in files that match */demos/* or
*/examples/* shell path.

=item	package list

There's a list of modules to ignore in "normal" mode.  They are mostly
OS-specific modules like C<Win32::*> or C<VMS::*>.  Modules that are used very
often (like C<strict.pm>) are also ignored in order not to bloat RPM database.

=item	$^O

Here we also ignore conditional blocks with C<$^O> variable involved (see
C<perldoc perlvar>).  This kind of code always does some OS-specific trickery
(well, most of the times).

B<Not implemented yet.>

=item	eval

Statements in C<eval> blocks are also ignored, since this is known to be a
common technique to check the module availability safely.

=back

=item	relaxed

This mode makes C<perl.req> fail-tolerant and even more relaxed:

=over

=item	conditional dependencies

In "relaxed" mode, conditional dependencies (i.e. C<require> and C<do>
statements enclosed in conditional block and this having indentation) are
ignored -- B::Deparse makes it easy!  

=item	fail tolerance

When C<perl.req> cannot deparse the given perl code, it should usually fail.
In turn, RPM should abort the package build process.  Unfortunatelly it does
not, which may result in packages with boroken dependencies.  Only the latest
releases (as of July 2003) of ALT RPM aborts the build process in such cases.

In "relaxed" mode, C<perl.req> will not fail if the deparse fails.  But please
note that some dependencies will be probably missed.

=back

=back

Since there's no default method, you have to specify the one with C<--method>
command line argument.  Alternatively, RPM_PERL_REQ_METHOD environement
variable can be used to set the method.  ALT RPM sets this variable to "normal"
by default.

=head1	AUTHOR

Alexey Tourbin <at на altlinux.org>,
based on an earlier version by Ken Estes <kestes на staff.mail.com>,
with contributions from Mikhail Zabaluev <mhz на altlinux.org>.

=head1	COPYING

This program is intended to be an optional/alternative part of RPM package
manager.  You can redistribute it and/or modify it under the same terms as RPM
itself.  As of version 4.x, RPM code base is covered with GPL and
(alternatively) LGPL licenses.  Any questions regarding the licensing of RPM
should be addressed to Erik Troan <ewt на redhat.com>.

=cut

use 5.8.0;
use Getopt::Long;
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?/),
	qr(\bVMS\b),
);
my @ignore_reqs = (
	qr(^Makefile\b),
# OS-specific
	qr(^machine/ansi\b),
	qr(^sys/systeminfo\b),
	qr(^vmsish\b),
	qr(^MacPerl\b),
	qr(^Win32),
	qr(\bVMS\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$),
	qr(^Exporter\.pm$),
	qr(^DynaLoader\.pm$),
	qr(^AutoLoader\.pm$),
	qr(^Carp\.pm$),
);

# list of requires
my %req;

if ($ENV{RPM_BUILD_ROOT} && open REQ, "$ENV{RPM_BUILD_ROOT}/.perl.req") {
	while (<REQ>) {
		while (s/perl\(([\w:]+)\)>=([\dv._]+)//) {
			$2
			and $req{package_filename($1)}{package_version($2)}++
			or  $req{package_filename($1)} ||= undef;
		}
	}
	close REQ;
	unlink "$ENV{RPM_BUILD_ROOT}/.perl.req";
}

# 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
#	use Fcntl;
#	fcntl(STDERR, F_SETFD, 1) if !$debug && $method eq 'relaxed';

# fake paths should take precedence
	local $_ = $ENV{RPM_PERL_LIB_PATH};
	my @inc = $ENV{RPM_BUILD_ROOT}
		? map { "-I$ENV{RPM_BUILD_ROOT}$_" } split, @INC
		: map { "-I$_" } split;
# deparse
	open(PIPE, "-|", $^X, "-MO=Deparse", @inc, $fname) || die;
	while (<PIPE>) {
		last if /^__(DATA|END)__/;
		process_line($_);
	}
	close(PIPE) or $method ne 'relaxed' and die "$fname: deparse failed.\n";
}

# whether we are in BEGIN block
my ($begin, $begin_indent);
# whether we are in eval block
my ($eval, $eval_indent);

sub process_line {
	my $line = shift;
	chomp $line;
	my $re_mod = qr/\b(?!\d)\w+(?:::(?!\d)\w+)*/;
	my $re_fna = qr/\w+(?:\/\w+)*\.p[lmh]/;
	my $re_ver = qr/\bv?[0-9]+(?:\.[0-9]+(?:_[0-9]+)?)*\b/;

	if ($begin && $line =~ /^\Q$begin_indent}/) {
		debug "exit begin:$.: $line";
		$begin = 0;
	} elsif ($eval && $line =~ /^\Q$eval_indent}/) {
		debug "exit eval:$.: $line";
		$eval = 0;
	}
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|do) '($re_fna)'/) {
		if ($eval && $method ne "strict") {
			debug "skip: $line (eval)";
		} else {
			$req{$1} ||= undef;
		}
	} elsif ($line =~ /^(\s*)require ($re_mod)( if\b| unless\b)?/) {
		if ($eval && $method ne "strict") {
			debug "skip: $line (eval)";
		} elsif ($begin) {
			$req{package_filename($2)} ||= undef;
		} elsif ($3 && $method eq "relaxed") {
			debug "skip: $line (conditional)";
		} elsif ($1 && $method eq "relaxed") {
			debug "skip: $line (indent)";
		} else {
			$req{package_filename($2)} ||= undef;
		}
	} elsif ($line =~ /'?($re_mod)'?->VERSION\(($re_ver)\)/) {
		exists $req{package_filename($1)} and
                $req{package_filename($1)}{package_version($2)}++;
	}
	if ($line =~ /^(\s*)sub [\w:]+\b(BEGIN|CHECK|INIT) {$/) {
		debug "enter begin:$.: $line";
		$begin = 1; $begin_indent = $1;
	} elsif ($line =~ /^(\s*)(.*)\beval {$/) {
		debug "enter eval:$.: $line";
		$eval = 1; $eval_indent = $1;
	}
}

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(?=\d)// || $version =~ /\.\d+\./) {
		return "1:$version";
	} else {
		$version =  sprintf($fmt, $version);
		return "0:$version";
	}
}

# end
req:
foreach my $k (keys %req) {
	if ($method ne "strict") {
		foreach my $re (@ignore_reqs) {
			if ($k =~ $re) {
				debug "req: $k; matches: $re; skip";
				delete $req{$k};
				next req;
			}
		}
	}
	foreach my $v (ref $req{$k} ? keys %{$req{$k}} : undef) {
		if ($k eq "perl-base") {
# too old perl?
			if ($method ne "strict"
			&& ($v =~ /^0:/ && $' lt "5.006" 
			|| $v =~ /^1:/ && $' lt "5.6.0")) {
				delete $req{$k}{$v};
				%{$req{$k}} && next;
				delete $req{$k};
				next req;
			} else {
				print "perl-base";
			}
		} else {
			print "perl($k)";
		}
		print " >= $v" if $v;
		print "\n";
	}
}
# nothing special?
print "perl-base\n" unless %req;
----------- следующая часть -----------
#!/usr/bin/perl

use Safe;
use strict;

# list of provides
my %prov;

# fake paths should take precedence
local $_ = $ENV{RPM_PERL_LIB_PATH};
my @inc = map { "$ENV{RPM_BUILD_ROOT}$_" } split, @INC;

# begin
process_file($_) foreach @ARGV ? @ARGV : <>;

sub process_file {
	my $fname = shift;
	chomp $fname;
	return unless $fname;

# check if we match any prefix
# and take the longest...
	my ($prefix) =	sort { length($b) <=> length($a) }
			grep { index($fname, $_) == 0 } @inc;
	return unless $prefix;
	my $basename = substr $fname, length $prefix;
	$basename =~ s/^\///;
	return unless $basename;

# provide *.p[lh]
	if ($fname =~ /\.p[lh]$/) {
		$prov{$basename} = undef;
		return;
# only *.pm left
	} elsif ($basename =~ /\.pm$/) {
		$prov{$basename} = undef;
	} else {
		return;
	}
# process *.pm
	my $in_package;
	my $re_mod = qr/\b(?!\d)\w+(?:::(?!\d)\w+)*/;
	my $re_ver = qr/\bv?[0-9]+(?:\.[0-9]+(?:_[0-9]+)?)*\b/;
	open(FILE, '<', $fname) || die;
	while (<FILE>) {
		/^=\w/ .. /^=cut/ and next;
	    	/^__(DATA|END)__$/ and last;
# look for 'package' declaration that matches filename
		if (/^\s*package\s+($re_mod)\s*;/) {
			if ($basename eq package_filename($1)) {
				$in_package = $1;
			} else {
				undef $in_package;
			}
# look for $VERSION
		} elsif ($in_package && m/\$(?:$in_package\::)?VERSION\s*=.*\d/) {
			$prov{$basename} = extract_version($_);
			last;
		}
	}
	close FILE;
}

# end
while (my ($k, $v) = each %prov) {
	if ($v) {
		print "perl($k) = $v\n";
# provide an additional epoch 0 version converted using Perl's rules
    		print "perl($k) = 0:" . old_version($1) . "\n"
			if $v =~ /^1:(.+)/;
	} else {
		print "perl($k)\n";
	}
}

sub old_version {
	local $_ = shift;
	my $fpver = 0;
	my $ratio = 1;
	my @series = split(/\./, $1);
	for (@series) {
		$fpver += $_ * $ratio;
		$ratio *= 0.001;
	}
	my $fdigits = $#series * 3;
	return sprintf "%.${fdigits}f", $fpver;
}

# XXX Mhz code?
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_orig entereval
			grepstart grepwhile mapstart mapwhile));
	my $version = $safe->reval("$line");
	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;
	}
}

# copy-pasted from perl.req
sub package_filename {
	my $package = shift;
	$package =~ s/::/\//g;
	return $package . '.pm';
}
----------- следующая часть -----------
Было удалено вложение не в текстовом формате...
Имя     : =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Тип     : application/pgp-signature
Размер  : 189 байтов
Описание: =?iso-8859-1?q?=CF=D4=D3=D5=D4=D3=D4=D7=D5=C5=D4?=
Url     : <http://lists.altlinux.org/pipermail/devel/attachments/20030904/a99b89d9/attachment-0001.bin>