From mboxrd@z Thu Jan  1 00:00:00 1970
Return-Path: <at@altlinux.ru>
Date: Thu, 14 Jul 2005 03:09:41 +0400
From: Alexey Tourbin <at@altlinux.ru>
To: devel@altlinux.ru
Message-ID: <20050713230941.GE3337@solemn.turbinal.org>
Mail-Followup-To: devel@altlinux.ru
References: <200507120109.17125.icesik@mail.ru>
Mime-Version: 1.0
Content-Type: multipart/signed; micalg=pgp-sha1;
	protocol="application/pgp-signature"; boundary="R6sEYoIZpp9JErk7"
Content-Disposition: inline
In-Reply-To: <200507120109.17125.icesik@mail.ru>
Subject: [devel] Re: buildreq =?koi8-r?b?ySDJ2sLZ1M/eztnFINrB18nTyc3P09TJ?=
X-BeenThere: devel@altlinux.ru
X-Mailman-Version: 2.1.5
Precedence: list
Reply-To: ALT Devel discussion list <devel@altlinux.ru>
List-Id: ALT Devel discussion list <devel.altlinux.ru>
List-Unsubscribe: <https://lists.altlinux.ru/mailman/listinfo/devel>,
	<mailto:devel-request@altlinux.ru?subject=unsubscribe>
List-Archive: <http://lists.altlinux.ru/pipermail/devel>
List-Post: <mailto:devel@altlinux.ru>
List-Help: <mailto:devel-request@altlinux.ru?subject=help>
List-Subscribe: <https://lists.altlinux.ru/mailman/listinfo/devel>,
	<mailto:devel-request@altlinux.ru?subject=subscribe>
X-List-Received-Date: Wed, 13 Jul 2005 23:09:47 -0000
Archived-At: <http://lore.altlinux.org/devel/20050713230941.GE3337@solemn.turbinal.org/>
List-Archive: <http://lore.altlinux.org/devel/>
List-Post: <mailto:devel@altlinux.org>


--R6sEYoIZpp9JErk7
Content-Type: multipart/mixed; boundary="Oiv9uiLrevHtW1RS"
Content-Disposition: inline


--Oiv9uiLrevHtW1RS
Content-Type: text/plain; charset=koi8-r
Content-Disposition: inline
Content-Transfer-Encoding: quoted-printable

On Tue, Jul 12, 2005 at 01:09:14AM +0300, Igor Zubkov wrote:
> buildreq =D7=C5=DB=C1=C5=D4 =C9=DA=C2=D9=D4=CF=DE=CE=D9=C5 =DA=C1=D7=C9=
=D3=C9=CD=CF=D3=D4=C9 =D0=D2=C9 =D3=C2=CF=D2=CB=C5 kde =D0=D2=C9=CC=CF=D6=
=C5=CE=C9=CA --=20
> kde-i18n-ru =C9 kde-i18n-uk (=D0=CF=D0=D2=CF=D3=D4=D5 =C7=CF=D7=CF=D2=D1,=
 =CB=C1=CB=C9=C5 i18n =D0=C1=CB=C5=D4=D9 =CE=C1=DB=A3=CC =D4=C1=CB=C9=C5 =
=C9=20
> =D0=D2=CF=D0=C9=D3=C1=CC). =F0=CC=C0=D3, =D7=C5=DB=C1=C5=D4 =DA=C1=D7=C9=
=D3=C9=CD=CF=D3=D4=C9 =CE=C1 qt-settings =C9 kde-settings. =F0=D2=C1=D7=C4=
=C1 =D7=20
> =D4=CF=CD =DE=D4=CF =CF=CE=C9 =CC=C9=DB=CE=C9=C9 =D1 =CE=C5=CD=CE=CF=C7=
=CF =D3=CF=CD=CE=C5=D7=C1=C0=D3=D8.
>=20
> =FE=D4=CF =C2=D5=C4=C5=CD =C4=C5=CC=C1=D4=D8?

=F0=CF=D0=D2=CF=C2=D5=CA=D4=C5 buildreq2.  =EF=CE "=D7=D3=A3 =D0=CF=CB=C1=
=DA=D9=D7=C1=C5=D4", =C1 =C9=DA=C2=D9=D4=CF=DE=CE=D9=C5 =DA=C1=D7=C9=D3=C9=
=CD=CF=D3=D4=C9
=D0=D9=D4=C1=C5=D4=D3=D1 =CF=D0=D4=C9=CD=C9=DA=C9=D2=CF=D7=C1=D4=D8.

--Oiv9uiLrevHtW1RS
Content-Type: text/plain; charset=us-ascii
Content-Disposition: attachment; filename=buildreq2
Content-Transfer-Encoding: quoted-printable

#!/usr/bin/perl
# vim: ts=3D4 sw=3D4

use 5.006;
use strict;
use sort 'stable';

use File::Basename qw(basename);
my $progname =3D basename $0;

################################################################

sub strace (@) {
	pipe my ($r, $w) or die "$progname: pipe: $!\n";
	my $pid =3D 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 =3D "/dev/fd/" . fileno($w);
		my @strace =3D (qw(strace -kqfF -e trace=3Dfile -o) =3D> $out =3D> "--");
		exec @strace, @_;
		die "$progname: exec strace: $!\n";
	}
}

################################################################

package SPP;

sub TIEHANDLE {
	my ($class, $fh) =3D @_;
	return bless { fh =3D> $fh } =3D> $class;
}

sub READLINE {
	my $self =3D shift;
	{
		local $_ =3D 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} =3D $_;
			redo;
		} elsif (s/^(\d+)\s+<\.\.\.\s+\w+\s+resumed>//) {
			die "$progname: pid $1 resumed without being unfinished\n"
				if not exists $$self{trace}{$1};
			$_ =3D delete($$self{trace}{$1}) . $_;
		}
		return $_;
	}
}

package main;

################################################################

my $filereq_trace_files;

sub filereq (@) {
	local $| =3D 1 if $filereq_trace_files;
	my ($pid, $fd) =3D &strace;
	tie local *FH, SPP =3D> $fd;
	my %files; local $_;
	while (<FH>) {
		if (m#^\d+\s+\w+[(]"(/.+?)"#) {
			$files{$1}++;
			if ($filereq_trace_files) {
				my $file =3D $1;
				if ($file =3D~ $filereq_trace_files) {
					print "$progname: $file\n";
				}
			}
		}
	}
	untie *FH;
	close $fd;
	waitpid($pid, 0) =3D=3D $pid or die "$progname: waitpid: $!\n";
	$? =3D=3D 0 or die "$progname: strace exit status $?\n";
	return sort grep { -f } keys %files;
}

################################################################

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

my %qR;
sub qR ($) {
	my $name =3D shift;
	my $deps =3D $qR{$name} ||=3D $$rpmdb{$name} && $$rpmdb{$name}{REQUIRENAME=
};
	return wantarray ? @$deps : scalar @$deps;
}

my %qP;
sub qP ($) {
	my $name =3D shift;
	my $deps =3D $qP{$name} ||=3D $$rpmdb{$name} && $$rpmdb{$name}{PROVIDES};
	return wantarray ? @$deps : scalar @$deps;
}

my %qwP;
sub qwP ($) {
	my $name =3D shift;
	my $deps =3D $qwP{$name} ||=3D [ map { $$_{NAME} } $rpmdb->find_what_provi=
des($name) ];
	return wantarray ? @$deps : scalar @$deps;
}

################################################################

sub packagereq (@) {
	my $bad =3D=20
		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 =3D grep { not /$bad/ } &filereq;
	my %packages;
	foreach my $file (@files) {
		my $hdr =3D $rpmdb->find_by_file($file);
		next unless $hdr;
		my $package =3D $$hdr{NAME};
		next unless $package;
		push @{$packages{$package}}, $file;
	}
	return \%packages;
}

sub buildreq ($@) {
	my ($spec, @args) =3D @_;
	my @args0 =3D ("--nodeps", "--define", "__buildreqs 1", "--define", "__npr=
ocs 1");
	unshift @args, "-bc" unless grep /^-b\w$/ =3D> @args;
	my $packages =3D packagereq("rpmbuild", @args0, @args, "--", $spec);
	$$packages{basesystem} ||=3D []; # hardcoded
	return $packages;
}

################################################################

sub expand (@) {
	my %packages =3D my %expanded =3D map { $_ =3D> 1 } @_;
	do {
		%packages =3D %expanded;
		my @packages =3D sort keys %packages;
		foreach my $pkg (@packages) {
			my @req =3D qR($pkg) or next;
			foreach my $req (@req) {
				next if $expanded{$req};
				if (exists $$rpmdb{$req}) {
					print "$pkg -> $req\n";
					$expanded{$req} =3D 1;
					next;
				} else {
					my @prov =3D qwP($req);
					next unless @prov;
					next if grep { $expanded{$_} } @prov;
					@prov =3D 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]} =3D 1;
				}
			}
		}
	} while keys(%expanded) > keys(%packages);
	return sort keys %expanded;
}

sub intersect ($$) {
	my ($aref1, $aref2) =3D @_;
	my @sect;
	foreach my $e1 (@$aref1) {
		foreach my $e2 (@$aref2) {
			push @sect, $e1 if $e1 eq $e2;
		}
	}
	return unless @sect;
	@sect =3D sort { length($a) <=3D> length($b) } sort @sect;
	return wantarray ? @sect : $sect[0];
}

sub squeeze (@) {
	my @packages =3D sort { qR($a) <=3D> qR($b) } sort @_;
	my %packages =3D map { $_ =3D> 1 } @packages;
PREY:
	foreach my $p0 (@packages) {
		my @req0 =3D qR($p0); my @prov0 =3D qP($p0);
RAPTOR:=09
		foreach my $pN (reverse @packages) {
			next PREY unless $packages{$p0};
			next RAPTOR if $p0 eq $pN;
			my @reqN =3D qR($pN); my @provN =3D qP($pN);
			my $do =3D intersect [ $p0 ] =3D> \@reqN;
			my $dox =3D intersect \@prov0 =3D> \@reqN;
			my $undo =3D intersect [ $pN ] =3D> \@req0;
			my $undox =3D intersect \@provN =3D> \@req0;
			if ($do and (not ($undo or $undox) or $packages{$pN})) {
				print "$p0 < $pN\n";
				$packages{$p0} =3D 0;
				next PREY;
			}
			if ($dox and (not ($undo or $undox) or $packages{$pN})) {
				print "$p0 < $dox < $pN\n";
				$packages{$p0} =3D 0;
				next PREY;
			}
		}
	}
	return sort grep { $packages{$_} } keys %packages;
}

################################################################

sub cleanup (@) {
	my @packages =3D @_;
	my @new;
	my $bad =3D qr{^glibc-core-|^basesystem$|^rpm-build$|^ccache$|^hostinfo$};=
 # hardcoded
	my @new;
	foreach my $pkg (@packages) {
		if ($pkg =3D~ $bad) {
			print "Removing $pkg...\n";
			next;
		}
		my @pkgparts =3D split /-/, $pkg, 2;
		goto add unless @pkgparts =3D=3D 2;
		my @prov =3D qP($pkg);
		foreach my $prov (@prov) {
			my @provparts =3D split /-/, $prov, 2;
			next unless @provparts =3D=3D 2;
			next unless $pkgparts[1] eq $provparts[1];
			if ($pkgparts[0] =3D~ /^\Q$provparts[0]\E[\d.]+$/) {
				print "Substituting $pkg -> $prov...\n";
				$pkg =3D $prov;
			}
		}
add:
		push @new, $pkg;
	}
	return @new;
}
=09
sub optimize (@) {
	my @packages =3D @_;
	print "BuildRequires: @packages\n";
	print "\tExpanding...\n";
	@packages =3D expand(@packages);
	print "BuildRequires: @packages\n";
	print "\tSqueezing...\n";
	@packages =3D squeeze(@packages);
	print "BuildRequires: @packages\n";
	my @new =3D cleanup(@packages);
	print "BuildRequires: @new\n" if "@new" ne "@packages";
	return @new;=09
}

sub explain ($) {
	my $packages =3D shift;
	foreach my $pkg (sort keys %$packages) {
		print "$pkg\n";
		my @files =3D sort @{$$packages{$pkg}};
		print "\t$_\n" foreach @files;
	}
}

################################################################

my $fmt0 =3D "# Added by $progname on %s\nBuildRequires: %s\n";
my $fmt1 =3D "# Added by $progname on %s (%s)\nBuildRequires: %s\n";

my $catch0 =3D quotemeta $fmt0; $catch0 =3D~ s/\\%s\b/(.+)/g; $catch0 =3D q=
r{^$catch0}m;
my $catch1 =3D quotemeta $fmt1; $catch1 =3D~ s/\\%s\b/(.+)/g; $catch1 =3D q=
r{^$catch1}m;

sub spec_args ($) {
	my $spec =3D shift;
	open my $fh, $spec or die "$progname: $spec: $!\n";
	local $/ =3D undef; local $_ =3D <$fh>;
	if (/$catch1/mo) {
		my $args =3D $2;
		use Text::ParseWords qw(shellwords);
		my @args =3D shellwords($args);
		warn "spec args: @args\n";
		return @args;
	}
	return;
}

sub fmt_args (@) {
	my @args =3D grep { $_ ne "-bc" } @_;
	foreach (grep /[\s\\'"]/ =3D> @args) {
		s/[\\"]/\\$1/g;
		$_ =3D qq("$_");
	}
	return "@args";
}

sub fmt_now () {
	use POSIX qw(strftime);
	my $now =3D strftime "%a %b %d %Y", localtime;
	return $now;
}

sub fmt_packages {
	my @packages =3D sort @_;
	return "@packages";
}

sub alter_spec ($$$) {
	my $spec =3D shift;
	my $packages =3D shift; $packages =3D fmt_packages(@$packages);
	my $args =3D shift; $args =3D fmt_args(@$args);
	my $date =3D fmt_now;
	my $tag =3D $args
		? sprintf $fmt1, $date, $args, $packages=20
		: sprintf $fmt0, $date, $packages
		;
	local ($^I, @ARGV) =3D ("~", $spec); # perlfaq5
	local $/ =3D undef; local $_ =3D <>;
	s/$catch0/$tag/mo=20
		or
	s/$catch1/$tag/mo=20
		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 =3D shift;
	pod2usage
		-message =3D> "$progname: calculate build dependencies",
		-output =3D> $rv ? \*STDERR : \*STDOUT,
		-exitval =3D> $rv,
		-verbose =3D> 1;
}=09

use Getopt::Long qw(GetOptions);
Getopt::Long::Configure("bundling");

my %opt_rpmargs;

GetOptions help =3D> \my $opt_help,
	filereq		=3D> \my $opt_filereq,
	packagereq	=3D> \my $opt_packagereq,
	squeeze		=3D> \my $opt_squeeze,

	"tracepkg=3Ds" =3D> \my @opt_tracepkg,
=09
	"b=3Ds"		=3D> \my $opt_stage,
	map { +"$_=3Ds" =3D> \@{$opt_rpmargs{$_}} } qw(define with without enable =
disable)
=09
		or usage(1);

my $opt_buildreq =3D 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) =3D each %opt_rpmargs) {
	foreach my $arg (@$args) {
		push @opt_rpmargs, "--$opt" =3D> $arg;
	}
}
unshift @opt_rpmargs, "-b$opt_stage" if $opt_stage;

if (@opt_tracepkg) {
	my @files =3D map { @{$_->filenames} }
	map { $$rpmdb{$_} or die "$progname: tracepkg: $_: no such package" } @opt=
_tracepkg;
	if (@files) {
		my $re_files =3D join "|" =3D> map quotemeta, @files;
		$filereq_trace_files =3D qr{^(?:$re_files)$};
	}
}

################################################################

if ($opt_filereq) {
	my @files =3D filereq(@ARGV);
	print join("\n" =3D> @files), "\n";
} elsif ($opt_squeeze) {
	optimize(@ARGV);
} elsif ($opt_packagereq) {
	my $packages =3D packagereq(@ARGV);
	explain($packages);
	optimize(keys %$packages);
} else {
	foreach my $spec (@ARGV) {
		my @args =3D @opt_rpmargs ? @opt_rpmargs : spec_args($spec);
		my $packages =3D buildreq($spec, @args);
		explain($packages);
		my @packages =3D optimize(keys %$packages);
		alter_spec($spec, \@packages, \@args) if @packages;
	}
}

__END__

=3Dhead1	NAME

buildreq2 - calculate build dependencies

=3Dhead1	SYNOPSIS

	buildreq2 specfile...
	buildreq2 --filereq cmd [args...]
	buildreq2 --packagereq cmd [args...]
	buildreq2 --squeeze pkg...

=3Dhead1	AUTHOR

Written by Alexey Tourbin <at@altlinux.org>,
based upon earlier work by Dmitry V. Levin <ldv@altlinux.org>.

=3Dhead1	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.

=3Dcut


--Oiv9uiLrevHtW1RS--

--R6sEYoIZpp9JErk7
Content-Type: application/pgp-signature
Content-Disposition: inline

-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.2.5 (GNU/Linux)

iD8DBQFC1Z81fBKgtDjnu0YRAuaxAJ9Oa1rjHfrCCXRqNLKld6NZdoJ8CwCeJHKm
RLO/E2sbw84YEkWwNDjbt28=
=IS53
-----END PGP SIGNATURE-----

--R6sEYoIZpp9JErk7--