From: Alexey Tourbin <at@altlinux.ru> To: devel@altlinux.ru Subject: [devel] buildreq2 Date: Tue, 12 Apr 2005 06:13:21 +0400 Message-ID: <20050412021321.GQ3309@solemn.turbinal.org> (raw) [-- Attachment #1.1: Type: text/plain, Size: 1046 bytes --] Здравствуйте. Предварительная версия 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 $ Пробуйте. :) [-- Attachment #1.2: buildreq2 --] [-- Type: text/plain, Size: 8418 bytes --] #!/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 [-- Attachment #2: Type: application/pgp-signature, Size: 189 bytes --]
reply other threads:[~2005-04-12 2:13 UTC|newest] Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions: You may reply publicly to this message via plain-text email using any one of the following methods: * Save the following mbox file, import it into your mail client, and reply-to-all from there: mbox Avoid top-posting and favor interleaved quoting: https://en.wikipedia.org/wiki/Posting_style#Interleaved_style * Reply using the --to, --cc, and --in-reply-to switches of git-send-email(1): git send-email \ --in-reply-to=20050412021321.GQ3309@solemn.turbinal.org \ --to=at@altlinux.ru \ --cc=devel@altlinux.ru \ /path/to/YOUR_REPLY https://kernel.org/pub/software/scm/git/docs/git-send-email.html * If your mail client supports setting the In-Reply-To header via mailto: links, try the mailto: link
ALT Linux Team development discussions This inbox may be cloned and mirrored by anyone: git clone --mirror http://lore.altlinux.org/devel/0 devel/git/0.git # If you have public-inbox 1.1+ installed, you may # initialize and index your mirror using the following commands: public-inbox-init -V2 devel devel/ http://lore.altlinux.org/devel \ devel@altlinux.org devel@altlinux.ru devel@lists.altlinux.org devel@lists.altlinux.ru devel@linux.iplabs.ru mandrake-russian@linuxteam.iplabs.ru sisyphus@linuxteam.iplabs.ru public-inbox-index devel Example config snippet for mirrors. Newsgroup available over NNTP: nntp://lore.altlinux.org/org.altlinux.lists.devel AGPL code for this site: git clone https://public-inbox.org/public-inbox.git