[devel] buildreq2
Alexey Tourbin
=?iso-8859-1?q?at_=CE=C1_altlinux=2Eru?=
Вт Апр 12 06:13:21 MSD 2005
Здравствуйте.
Предварительная версия buildreq2 готова и испытана в боевых условиях.
Из текущих недостатков:
1) стадию -bi пока указать нельзя; но мне очень не нравится, что в
find-requires в безусловном порядке запускается python на все *.so файлы.
2) substitute.d типа s/libdb4.3-devel/libdb4-devel/ пока не работает.
Остальное всё работает.
Собрал сегодня с ним несколько пакетов:
$ grep -A1 buildreq2 *.spec(.m-1)
perl-bignum.spec:# Automatically added by buildreq2 on Tue Apr 12 2005
perl-bignum.spec-BuildRequires: perl-Math-BigRat perl-YAML perl-devel
--
perl-Math-BigInt.spec:# Automatically added by buildreq2 on Tue Apr 12 2005
perl-Math-BigInt.spec-BuildRequires: perl-YAML perl-devel
--
perl-Math-BigRat.spec:# Automatically added by buildreq2 on Tue Apr 12 2005
perl-Math-BigRat.spec-BuildRequires: perl-Math-BigInt perl-YAML perl-devel
--
perl-Unicode-Normalize.spec:# Automatically added by buildreq2 on Tue Apr 12 2005
perl-Unicode-Normalize.spec-BuildRequires: perl-devel perl-unicore
$
Пробуйте. :)
----------- следующая часть -----------
#!/usr/bin/perl
# vim: ts=4 sw=4
use 5.006;
use strict;
use sort 'stable';
use File::Basename qw(basename);
my $progname = basename $0;
################################################################
sub strace (@) {
pipe my ($r, $w) or die "$progname: pipe: $!\n";
my $pid = fork;
defined $pid or die "$progname: fork: $!\n";
if ($pid) {
close $w;
return ($pid, $r);
} else {
close $r;
use Fcntl qw(F_SETFD);
fcntl $w, F_SETFD, 0;
my $out = "/dev/fd/" . fileno($w);
my @strace = (qw(strace -kqfF -e trace=file -o) => $out => "--");
exec @strace, @_;
die "$progname: exec strace: $!\n";
}
}
################################################################
package SPP;
sub TIEHANDLE {
my ($class, $fh) = @_;
return bless { fh => $fh, trace => {} } => $class;
}
sub READLINE {
my $self = shift;
my $fh = $$self{fh};
my $trace = $$self{trace};
while (1) {
local $_ = <$fh> or return;
if (s/^(\d+)(\s+)(.*)\s+<unfinished\s+\.\.\.>$/$1$2$3/) {
die "$progname: pid $1 unfinished twice\n"
if defined $$trace{$1};
$$trace{$1} = $_;
next;
} elsif (s/^(\d+)\s+<\.\.\.\s+\w+\s+resumed>//) {
die "$progname: pid $1 resumed without being unfinished\n"
if not defined $$trace{$1};
$_ = delete($$trace{$1}) . $_;
}
return $_;
}
}
package main;
################################################################
sub filereq (@) {
my ($pid, $fd) = &strace;
tie local *FH, SPP => $fd;
my %files; local $_;
while (<FH>) {
$files{$1}++ if m#^\d+\s+\w+[(]"(/.+?)"#;
}
untie *FH;
close $fd;
waitpid($pid, 0) == $pid or die "$progname: waitpid: $!\n";
$? == 0 or die "$progname: strace exit status $?\n";
return sort grep { -f } keys %files;
}
################################################################
use RPM::Database;
my $rpmdb = RPM::Database->new
or die "$progname: rpmdb: $RPM::err\n";
my %qR;
sub qR ($) {
my $name = shift;
my $deps = $qR{$name} ||= $$rpmdb{$name} && $$rpmdb{$name}{REQUIRENAME};
return wantarray ? @$deps : scalar @$deps;
}
my %qP;
sub qP ($) {
my $name = shift;
my $deps = $qP{$name} ||= $$rpmdb{$name} && $$rpmdb{$name}{PROVIDES};
return wantarray ? @$deps : scalar @$deps;
}
my %qwP;
sub qwP ($) {
my $name = shift;
my $deps = $qwP{$name} ||= [ map { $$_{NAME} } $rpmdb->find_what_provides($name) ];
return wantarray ? @$deps : scalar @$deps;
}
################################################################
sub packagereq (@) {
my $bad = qr{^/etc/rpm/macros[.]d/|^/usr/share/aclocal/}; # hardcoded
my @files = grep { not /$bad/ } &filereq;
my %packages;
foreach my $file (@files) {
my $hdr = $rpmdb->find_by_file($file);
next unless $hdr;
my $package = $$hdr{NAME};
next unless $package;
push @{$packages{$package}}, $file;
}
return \%packages;
}
sub buildreq ($) {
my $spec = shift;
my @rpmargs = ("--nodeps", "--define", "__buildreqs 1", "--define", "__nprocs 1");
return packagereq("rpm", "-bc", @rpmargs, "--", $spec);
}
################################################################
sub expand (@) {
my %packages = my %expanded = map { $_ => 1 } @_;
do {
%packages = %expanded;
my @packages = sort keys %packages;
foreach my $pkg (@packages) {
my @req = qR($pkg) or next;
foreach my $req (@req) {
next if $expanded{$req};
if (exists $$rpmdb{$req}) {
print "$pkg -> $req\n";
$expanded{$req} = 1;
next;
} else {
my @prov = qwP($req);
next unless @prov;
next if grep { $expanded{$_} } @prov;
@prov = reverse sort @prov;
print "warning: $req provided by @prov\n" if @prov > 1;
next if @prov > 1;
print "$pkg -> $req -> $prov[0]\n";
$expanded{$prov[0]} = 1;
}
}
}
} while keys(%expanded) > keys(%packages);
return sort keys %expanded;
}
sub intersect ($$) {
my ($aref1, $aref2) = @_;
my @sect;
foreach my $e1 (@$aref1) {
foreach my $e2 (@$aref2) {
push @sect, $e1 if $e1 eq $e2;
}
}
return unless @sect;
@sect = sort { length($a) <=> length($b) } sort @sect;
return wantarray ? @sect : $sect[0];
}
sub squeeze (@) {
my @packages = sort { qR($a) <=> qR($b) } sort @_;
my %packages = map { $_ => 1 } @packages;
PREY:
foreach my $p0 (@packages) {
my @req0 = qR($p0); my @prov0 = qP($p0);
RAPTOR:
foreach my $pN (@packages) {
next PREY unless $packages{$p0};
next RAPTOR if $p0 eq $pN;
my @reqN = qR($pN); my @provN = qP($pN);
my $do = intersect [ $p0 ] => \@reqN;
my $dox = intersect \@prov0 => \@reqN;
my $undo = intersect [ $pN ] => \@req0;
my $undox = intersect \@provN => \@req0;
if ($do and (not ($undo or $undox) or $packages{$pN})) {
print "$p0 < $pN\n";
$packages{$p0} = 0;
next PREY;
}
if ($dox and (not ($undo or $undox) or $packages{$pN})) {
print "$p0 < $dox < $pN\n";
$packages{$p0} = 0;
next PREY;
}
}
}
return sort grep { $packages{$_} } keys %packages;
}
################################################################
sub optimize (@) {
my @packages = @_;
print "\tExpanding...\n";
@packages = expand(@packages);
print "BuildRequires: @packages\n";
print "\tSqueezing...\n";
@packages = squeeze(@packages);
print "BuildRequires: @packages\n";
my $bad = qr{^glibc-core-|^rpm-build$|^ccache$|^hostinfo$}; # hardcoded
my @new;
foreach my $pkg (@packages) {
if ($pkg =~ $bad) {
print "Removing $pkg...\n";
} else {
push @new, $pkg;
}
}
print "BuildRequires: @new\n" if @new < @packages;
return @new;
}
sub explain ($) {
use Data::Dumper qw(Dumper);
local $Data::Dumper::Terse = 1;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Indent = 1;
print Dumper(@_);
return shift;
}
################################################################
sub alter_spec ($@) {
my $spec = shift;
my @packages = sort @_;
use POSIX qw(strftime);
my $date = strftime "%a %b %d %Y", localtime;
my $fmt = <<EOF;
# Automatically added by $progname on %s
BuildRequires: %s
EOF
my $tag = sprintf $fmt, $date, "@packages";
my $catch = quotemeta $fmt;
$catch =~ s/\\%s\b/.*/g;
local ($^I, @ARGV) = ("~", $spec); # perlfaq5
local $/ = undef;
local $_ = <>;
s/^$catch/$tag/mo
or
s/^(%package|%description)\b/$tag\n$1/m
or die "$progname: $spec: bad specfile\n";
print;
}
################################################################
sub usage ($) {
use Pod::Usage qw(pod2usage);
my $rv = shift;
pod2usage
-message => "$progname: calculate build dependencies",
-output => $rv ? \*STDERR : \*STDOUT,
-exitval => $rv,
-verbose => 1;
}
use Getopt::Long qw(GetOptions);
GetOptions help => \my $opt_help,
filereq => \my $opt_filereq,
packagereq => \my $opt_packagereq,
squeeze => \my $opt_squeeze
or usage(1);
my $opt_buildreq = not ($opt_filereq or $opt_packagereq or $opt_squeeze);
die "$progname: options --filereq, --packagereq and --squeeze are mutually exclusive\n"
unless $opt_filereq xor $opt_packagereq xor $opt_squeeze xor $opt_buildreq;
usage(0) if $opt_help;
usage(1) if not @ARGV;
################################################################
if ($opt_filereq) {
local $, = local $\ = "\n";
print filereq(@ARGV);
} elsif ($opt_squeeze) {
optimize(@ARGV);
} elsif ($opt_packagereq) {
my $packages = explain(packagereq(@ARGV));
optimize(keys %$packages);
} else {
foreach my $spec (@ARGV) {
my $packages = explain(buildreq($spec));
my @packages = optimize(keys %$packages);
alter_spec($spec, @packages) if @packages;
}
}
__END__
=head1 NAME
buildreq2 - calculate build dependencies
=head1 SYNOPSIS
buildreq2 specfile...
buildreq2 --filereq cmd [args...]
buildreq2 --packagereq cmd [args...]
buildreq2 --squeeze pkg...
=head1 AUTHOR
Written by Alexey Tourbin <at на altlinux.org>,
based upon earlier work by Dmitry V. Levin <ldv на altlinux.org>.
=head1 COPYING
Copyright (c) 2004, 2005 Alexey Tourbin, ALT Linux Team.
This is free software; you can redistribute it and/or modify it under
the terms of the GNU Library General Public License as published by the
Free Software Foundation; either version 2 of the License, or (at your
option) any later version.
=cut
----------- следующая часть -----------
Было удалено вложение не в текстовом формате...
Имя : =?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/20050412/8a02aa88/attachment-0001.bin>
Подробная информация о списке рассылки Devel