[devel] Re: buildreq и избыточные зависимости
Alexey Tourbin
=?iso-8859-1?q?at_=CE=C1_altlinux=2Eru?=
Чт Июл 14 03:09:41 MSD 2005
On Tue, Jul 12, 2005 at 01:09:14AM +0300, Igor Zubkov wrote:
> buildreq вешает избыточные зависимости при сборке kde приложений --
> kde-i18n-ru и kde-i18n-uk (попросту говоря, какие i18n пакеты нашёл такие и
> прописал). Плюс, вешает зависимости на qt-settings и kde-settings. Правда в
> том что они лишнии я немного сомневаюсь.
>
> Что будем делать?
Попробуйте buildreq2. Он "всё показывает", а избыточные зависимости
пытается оптимизировать.
----------- следующая часть -----------
#!/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 } => $class;
}
sub READLINE {
my $self = shift;
{
local $_ = readline $$self{fh} or return;
chomp;
if (s/^(\d+)(\s+)(.*?)\s+<unfinished\s+\.\.\.>$/$1$2$3/) {
die "$progname: pid $1 unfinished twice\n"
if exists $$self{trace}{$1};
$$self{trace}{$1} = $_;
redo;
} elsif (s/^(\d+)\s+<\.\.\.\s+\w+\s+resumed>//) {
die "$progname: pid $1 resumed without being unfinished\n"
if not exists $$self{trace}{$1};
$_ = delete($$self{trace}{$1}) . $_;
}
return $_;
}
}
package main;
################################################################
my $filereq_trace_files;
sub filereq (@) {
local $| = 1 if $filereq_trace_files;
my ($pid, $fd) = &strace;
tie local *FH, SPP => $fd;
my %files; local $_;
while (<FH>) {
if (m#^\d+\s+\w+[(]"(/.+?)"#) {
$files{$1}++;
if ($filereq_trace_files) {
my $file = $1;
if ($file =~ $filereq_trace_files) {
print "$progname: $file\n";
}
}
}
}
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{ ^/(?:tmp|dev|home|proc|mnt)/
| ^/etc/rpm/macros[.]d/
| ^/usr/share/aclocal/
| ^/etc/gnome-vfs-.*/modules/
| ^/usr/share/fonts/.*/fonts[.]cache\b
| ^/etc/perl5/Net/libnet[.]cfg
}x; # 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, @args) = @_;
my @args0 = ("--nodeps", "--define", "__buildreqs 1", "--define", "__nprocs 1");
unshift @args, "-bc" unless grep /^-b\w$/ => @args;
my $packages = packagereq("rpmbuild", @args0, @args, "--", $spec);
$$packages{basesystem} ||= []; # hardcoded
return $packages;
}
################################################################
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 (reverse @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 cleanup (@) {
my @packages = @_;
my @new;
my $bad = qr{^glibc-core-|^basesystem$|^rpm-build$|^ccache$|^hostinfo$}; # hardcoded
my @new;
foreach my $pkg (@packages) {
if ($pkg =~ $bad) {
print "Removing $pkg...\n";
next;
}
my @pkgparts = split /-/, $pkg, 2;
goto add unless @pkgparts == 2;
my @prov = qP($pkg);
foreach my $prov (@prov) {
my @provparts = split /-/, $prov, 2;
next unless @provparts == 2;
next unless $pkgparts[1] eq $provparts[1];
if ($pkgparts[0] =~ /^\Q$provparts[0]\E[\d.]+$/) {
print "Substituting $pkg -> $prov...\n";
$pkg = $prov;
}
}
add:
push @new, $pkg;
}
return @new;
}
sub optimize (@) {
my @packages = @_;
print "BuildRequires: @packages\n";
print "\tExpanding...\n";
@packages = expand(@packages);
print "BuildRequires: @packages\n";
print "\tSqueezing...\n";
@packages = squeeze(@packages);
print "BuildRequires: @packages\n";
my @new = cleanup(@packages);
print "BuildRequires: @new\n" if "@new" ne "@packages";
return @new;
}
sub explain ($) {
my $packages = shift;
foreach my $pkg (sort keys %$packages) {
print "$pkg\n";
my @files = sort @{$$packages{$pkg}};
print "\t$_\n" foreach @files;
}
}
################################################################
my $fmt0 = "# Added by $progname on %s\nBuildRequires: %s\n";
my $fmt1 = "# Added by $progname on %s (%s)\nBuildRequires: %s\n";
my $catch0 = quotemeta $fmt0; $catch0 =~ s/\\%s\b/(.+)/g; $catch0 = qr{^$catch0}m;
my $catch1 = quotemeta $fmt1; $catch1 =~ s/\\%s\b/(.+)/g; $catch1 = qr{^$catch1}m;
sub spec_args ($) {
my $spec = shift;
open my $fh, $spec or die "$progname: $spec: $!\n";
local $/ = undef; local $_ = <$fh>;
if (/$catch1/mo) {
my $args = $2;
use Text::ParseWords qw(shellwords);
my @args = shellwords($args);
warn "spec args: @args\n";
return @args;
}
return;
}
sub fmt_args (@) {
my @args = grep { $_ ne "-bc" } @_;
foreach (grep /[\s\\'"]/ => @args) {
s/[\\"]/\\$1/g;
$_ = qq("$_");
}
return "@args";
}
sub fmt_now () {
use POSIX qw(strftime);
my $now = strftime "%a %b %d %Y", localtime;
return $now;
}
sub fmt_packages {
my @packages = sort @_;
return "@packages";
}
sub alter_spec ($$$) {
my $spec = shift;
my $packages = shift; $packages = fmt_packages(@$packages);
my $args = shift; $args = fmt_args(@$args);
my $date = fmt_now;
my $tag = $args
? sprintf $fmt1, $date, $args, $packages
: sprintf $fmt0, $date, $packages
;
local ($^I, @ARGV) = ("~", $spec); # perlfaq5
local $/ = undef; local $_ = <>;
s/$catch0/$tag/mo
or
s/$catch1/$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);
Getopt::Long::Configure("bundling");
my %opt_rpmargs;
GetOptions help => \my $opt_help,
filereq => \my $opt_filereq,
packagereq => \my $opt_packagereq,
squeeze => \my $opt_squeeze,
"tracepkg=s" => \my @opt_tracepkg,
"b=s" => \my $opt_stage,
map { +"$_=s" => \@{$opt_rpmargs{$_}} } qw(define with without enable disable)
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;
my @opt_rpmargs;
while (my ($opt, $args) = each %opt_rpmargs) {
foreach my $arg (@$args) {
push @opt_rpmargs, "--$opt" => $arg;
}
}
unshift @opt_rpmargs, "-b$opt_stage" if $opt_stage;
if (@opt_tracepkg) {
my @files = map { @{$_->filenames} }
map { $$rpmdb{$_} or die "$progname: tracepkg: $_: no such package" } @opt_tracepkg;
if (@files) {
my $re_files = join "|" => map quotemeta, @files;
$filereq_trace_files = qr{^(?:$re_files)$};
}
}
################################################################
if ($opt_filereq) {
my @files = filereq(@ARGV);
print join("\n" => @files), "\n";
} elsif ($opt_squeeze) {
optimize(@ARGV);
} elsif ($opt_packagereq) {
my $packages = packagereq(@ARGV);
explain($packages);
optimize(keys %$packages);
} else {
foreach my $spec (@ARGV) {
my @args = @opt_rpmargs ? @opt_rpmargs : spec_args($spec);
my $packages = buildreq($spec, @args);
explain($packages);
my @packages = optimize(keys %$packages);
alter_spec($spec, \@packages, \@args) 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/20050714/c8976808/attachment-0001.bin>
Подробная информация о списке рассылки Devel