[devel] preview: buildreq.pl

[Alexey Tourbin]

<...>
Нужно писать по одной перловой программе в день, тогда жизнь наладится.
В частности, есть идея переработать buildreq и другие утилиты из этого
комплекта, чтобы возникало меньше вопросов.

К сожалению, за день всего сделать не удается.

Примеры использования того, что уже нарисовано, приведены ниже.
Работает быстро (перл вообще работает на редкость быстро).
Завтра нужно подумать над алгоритмом автоматической оптимизации
зависимостей.  Как вы помните, дело было в том, что получаются не
деревья зависимостей (чего хотелось бы), а граф зависимостей (и непонятно,
с какой вершины начинать его "разматывать").

Была также отдельная проблема с виртуальными пакетами.

В идеале, нужно избавиться от предикатной кувалды 
/etc/buildreqs/packages/essential. :)

Если кто-нибудь может подсказать что-нибудь дельное на уровне алгоритма,
прошу подсказать.  Кто не в курсе и кому интересно, искать

Date: Sun, 16 Nov 2003 17:58:30 +0300
Subject: [devel] packagereq/buildreq proposal
Message-ID: <20031116145830.GC1863 на julia.office.altlinux.ru>

Отдельный вопрос -- как это назвать. :)


$ ~/bin/buildreq.pl --packageof /bin/date
coreutils
$ ~/bin/buildreq.pl --packagereq /bin/date
coreutils
glibc-core
glibc-core-i686
glibc-gconv-modules
glibc-locales
$ ~/bin/buildreq.pl --packagereq --explain /bin/date
coreutils
        /bin/date
glibc-core
        /etc/localtime
glibc-core-i686
        /lib/i686/libc.so.6
        /lib/i686/libpthread.so.0
        /lib/i686/librt.so.1
glibc-gconv-modules
        /usr/lib/gconv/gconv-modules.cache
glibc-locales
        /usr/lib/locale/ru_RU.CP1251/LC_COLLATE
        /usr/lib/locale/ru_RU.CP1251/LC_CTYPE
        /usr/lib/locale/ru_RU.CP1251/LC_MONETARY
        /usr/lib/locale/ru_RU.CP1251/LC_NUMERIC
$ ~/bin/buildreq.pl --packagereq -- rpm -bc ~/RPM/SPECS/perl-YAML.spec
<...>
+ exit 0
GConf2
bzip2
bzlib
control
coreutils
findutils
glibc-core
glibc-core-i686
glibc-gconv-modules
glibc-locales
glibc-nss
grep
libalternatives-devel
libbeecrypt
libdb4.2
libpam0-devel
libpopt
librpm
librpmbuild
libruby-devel
libxmms-devel
make
perl-XML-SAX
perl-base
perl-devel
perl-pod
rpm
rpm-build
rpm-build-perl
setup
sh
tar
texinfo
yelp
zlib
$

-- 
Перепишите FAM и давайте искать кошелек под root.
		-- Markov chain after fortunes-ALT
----------- следующая часть -----------
#!/usr/bin/perl
# $Id$

use strict;
#use diagnostics;

sub filereq (@) {
	my @strace = qw(strace -kqfF -e file -o |cat --); # okay, I love cat(1)
	open my $fh, "-|", @strace, @_
		or die "@strace @_ failed\n";
	my %trace; my %files; local $_;
	while (<$fh>) {
		chomp;
		if (s/^(\d+)(\s+)(.*)\s+<unfinished\s+\.\.\.>$/$1$2$3/) {
			die "pid $1 unfinished twice\n"
				if defined $trace{$1};
			$trace{$1} = $_;
			next;
		} elsif (s/^(\d+)\s+<\.\.\.\s+\w+\s+resumed>//) {
			die "pid $1 resumed without being unfinished\n"
				if not defined $trace{$1};
			$_ = delete($trace{$1}) . $_;
		}
		$files{$1}++ if /^\d+\s+\w+\("(\/.+?)"/;
	}
	return \%files;
}

use RPM::Database;
my $rpmdb = RPM::Database->new
	or die "rpmdb: $RPM::err\n";

sub packageof ($) {
	my $hdr = $rpmdb->find_by_file($_[0]);
	$hdr ? $$hdr{NAME} : undef;
}

sub packagereq (@) {
	my $files = filereq @_;
	my %packages;
	while (my ($file, undef) = each %$files) {
		next unless -f $file;
		my $package = packageof $file;
		next unless $package;
		push @{$packages{$package}}, $file;
	}
	return \%packages;
}

use Getopt::Long qw(GetOptions);
GetOptions explain => \my $explain,
	filereq => \my $filereq, packageof => \my $packageof,
	packagereq => \my $packagereq;

$filereq ^ $packageof ^ $packagereq or die "usage: $0 --mode arguments\n";

sub out ($) {
	my $tbl = shift;
	foreach my $k (sort keys %$tbl) {
		print $k . "\n";
		next unless $explain;
		foreach my $v (sort @{$$tbl{$k}}) {
			print "\t$v\n";
		}
	}
}

$filereq and out filereq @ARGV or
$packageof and print packageof($ARGV[0]) . "\n" or
$packagereq and out packagereq @ARGV;
----------- следующая часть -----------
Было удалено вложение не в текстовом формате...
Имя     : =?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/20040429/2aad5d32/attachment-0001.bin>