r13192 - in /scripts/perl-5.10-transition: Makefile find-rebuild-order print-packages-file
ntyni at users.alioth.debian.org
ntyni at users.alioth.debian.org
Mon Jan 21 19:40:30 UTC 2008
Author: ntyni
Date: Mon Jan 21 19:40:30 2008
New Revision: 13192
URL: http://svn.debian.org/wsvn/?sc=1&rev=13192
Log:
scripts for planning the order of the necessary rebuild of XS modules
Added:
scripts/perl-5.10-transition/Makefile
scripts/perl-5.10-transition/find-rebuild-order (with props)
scripts/perl-5.10-transition/print-packages-file (with props)
Added: scripts/perl-5.10-transition/Makefile
URL: http://svn.debian.org/wsvn/scripts/perl-5.10-transition/Makefile?rev=13192&op=file
==============================================================================
--- scripts/perl-5.10-transition/Makefile (added)
+++ scripts/perl-5.10-transition/Makefile Mon Jan 21 19:40:30 2008
@@ -1,0 +1,14 @@
+APTLIST=$(shell ./print-packages-file)
+
+all: perlapi.out
+
+%.out: %.in find-rebuild-order essential
+ ./find-rebuild-order -v -e essential -f $< > $@
+essential: $(APTLIST)
+ grep-dctrl -n -X -sPackage -FEssential yes $< > $@
+perlapi.in: $(APTLIST)
+ grep-dctrl -n -sPackage -FDepends,Pre-Depends perlapi-5\.8 $< > $@
+clean:
+ $(RM) perlapi.in perlapi.out essential
+$(APTLIST):
+ test -r $(APTLIST)
Added: scripts/perl-5.10-transition/find-rebuild-order
URL: http://svn.debian.org/wsvn/scripts/perl-5.10-transition/find-rebuild-order?rev=13192&op=file
==============================================================================
--- scripts/perl-5.10-transition/find-rebuild-order (added)
+++ scripts/perl-5.10-transition/find-rebuild-order Mon Jan 21 19:40:30 2008
@@ -1,0 +1,402 @@
+#!/usr/bin/perl -w
+use strict;
+
+use AptPkg::Config '$_config';
+use AptPkg::System '$_system';
+use AptPkg::Cache;
+use AptPkg::Source;
+use Getopt::Std;
+
+=pod
+
+=head1 NAME
+
+find-rebuild-order - plan a rebuild for a set of uninstallable packages
+
+=head1 DESCRIPTION
+
+Given a list of uninstallable packages, try to find the correct order
+for rebuilding them. This is done by scanning the build-dependencies
+and their recursive dependencies for any other uninstallable packages
+
+The 'build-essential' package is always scanned at startup for
+uninstallable recursive dependencies. These require manual attention
+because nothing can be rebuilt before 'build-essential' can be installed.
+
+Optionally, a list of essential packages (those having the Essential:yes
+field) can be read from a separate file and checked for any uninstallable
+recursive dependencies. These require manual attention because all
+packages may rely upon them being installed at build time.
+
+=head1 USAGE
+
+B<find-rebuild-order> [ B<-v> ] [ B<-d> ] [ S<B<-e> I<ESSENTIAL-FILE>> ]
+S<( B<-f> I<FILE> | I<package1> [ I<...> ] )>
+
+=over
+
+=item -v
+
+Enable verbose output on standard error. You'll probably want this.
+
+=item -d
+
+Enable debugging output on standard error. You probably won't want this.
+
+=item -f FILE
+
+Read the list of packages from file FILE, one package per line. Perl-style
+comments (#) are allowed and skipped. Only the first field on each line
+is significant.
+
+If '-f' is not specified, the list of packages are expected as
+command-line arguments.
+
+=item -e ESSENTIAL-FILE
+
+Read the list of essential packages from file ESSENTIAL-FILE, one package
+per line. Perl-style comments (#) are allowed and skipped. Only the
+first field on each line is significant.
+
+=back
+
+=head1 OUTPUT FORMAT
+
+The machine-readable output consists of lines of the form 'PACKAGE ROUND'
+where ROUND denotes the rebuild order increasing from 1. It may be 0 for
+dependencies of essential or build-essential packages, or 'U' (undefined)
+for packages that need each other in a circular manner for building.
+
+The output is always sorted by ROUND, and circular build-dependencies
+('U') are detected and printed in the end of the run.
+
+Additionally, explanations targeted at humans (mostly listing reverse
+dependencies of the packages) are given on separate lines as Perl-style
+comments (ie. starting with the '#' sign.)
+
+=head1 BUGS AND LIMITATIONS
+
+Only the first one of alternative dependencies is scanned, which is intended
+to be an approximation of what the Debian buildds do.
+
+Version numbers in versioned dependencies are ignored.
+
+Architecture specifications in dependencies are ignored.
+
+Virtual packages are skipped with a warning.
+
+The program is big, slow and recursive.
+
+=head1 NOTES
+
+This program was written to help with the Debian Perl 5.10 transition,
+but it might be generic enough to be useful for other purposes too.
+
+The package dependency information comes from the APT cache via the
+AptPkg modules (packaged in Debian as libapt-pkg-perl). Multiple suites
+in /etc/apt/sources.list may confuse this program, although it tries
+to look up the latest version of each package.
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2008 Niko Tyni <ntyni at debian.org>.
+
+This program is licensed under the terms of the GNU General Public License
+(GPL), version 2 or later, as published by the Free Software Foundation.
+
+=cut
+
+(my $self = $0) =~ s#.*/##;
+
+sub usage {
+ print STDERR "Usage: $self [-e <essential-file>] [-d] [-v] (-f <file> | package1 [...])\n";
+ exit 1;
+}
+
+my %opts;
+getopts('e:dvf:', \%opts) or usage;
+
+my @packages;
+my @essential;
+
+my $debug = exists $opts{d};
+my $verbose = exists $opts{v};
+
+if (exists $opts{f}) {
+ @packages = read_packages_from_file($opts{f});
+} else {
+ @packages = @ARGV;
+}
+
+# From /usr/share/doc/libapt-pkg-perl/examples/apt-cache
+#
+# initialise the global config object with the default values and
+# setup the $_system object
+$_config->init;
+$_system = $_config->system;
+my $versioning = $_system->versioning;
+# supress cache building messages
+$_config->{quiet} = 2;
+
+
+my $bincache = AptPkg::Cache->new;
+my $srccache = AptPkg::Source->new;
+
+# a mapping from binary package name to an AptPkg::Source object
+my %source_of;
+
+# the main list of uninstallable packages we're working with
+# the values are AptPkg::Cache::Version objects for the latest
+# binary package
+my %uninstallable;
+
+# a global cache of uninstallable recursive dependencies of a package,
+# so we don't need to hunt them down each time
+my %uninstallable_dependencies_cache;
+
+notice("reading apt cache");
+
+for my $pkg (@packages) {
+ my @slist = $srccache->find($pkg) or do {
+ warn("no such source package: $pkg");
+ next;
+ };
+ my $s = src_latest(@slist);
+ my $blist = $bincache->{$pkg} or do {
+ warn("no such binary package: $pkg");
+ next;
+ };
+
+ my $b = bin_latest($blist);
+ debug("looked up $pkg/$b->{VerStr} from the package cache");
+
+ $source_of{$pkg} = $s;
+ $uninstallable{$pkg} = $b;
+}
+
+notice("starting with " . (scalar keys %uninstallable) . " uninstallable packages");
+print "# Generated by $self\n# <package> <rebuild round>\n";
+
+if (exists $opts{e}) {
+ notice("scanning file $opts{e} for essential packages");
+ @essential = read_packages_from_file($opts{e});
+ notice("check if any dependencies of essential packages are uninstallable");
+ my $found = 0;
+ for my $e (@essential) {
+ my $uninstallable_essential = find_uninstallable_dependencies($e, {}, []);
+ for (keys %$uninstallable_essential) {
+ print "# $_ is virtually essential ("
+ . join(" -> ", @{$uninstallable_essential->{$_}}, $_)
+ . ")\n";
+ print "$_ 0\n";
+ $found++;
+ delete $uninstallable{$_};
+ # reset the cache, it may be invalid after the delete
+ %uninstallable_dependencies_cache = ();
+ }
+ }
+ notice("found $found virtually essential packages");
+}
+
+{ # smaller scope for the variables
+ notice("check if any dependencies of build-essential packages are uninstallable");
+ my $found = 0;
+ my $uninstallable_build_essential = find_uninstallable_dependencies('build-essential', {}, []);
+ for my $be (keys %$uninstallable_build_essential) {
+ print "# $be is virtually build-essential ("
+ . join(" -> ", @{$uninstallable_build_essential->{$be}}, $be)
+ . ")\n";
+ print "$be 0\n";
+ delete $uninstallable{$be};
+ $found++;
+ # reset the cache, it may be invalid after the delete
+ %uninstallable_dependencies_cache = ();
+ }
+ notice("found $found virtually build-essential packages");
+}
+
+my $round = 1;
+
+while (1) { # actually, as long as we find something to build
+ my %needed_by;
+ my %needs_packages;
+
+ my $count = scalar keys %uninstallable;
+ notice("starting round $round: $count uninstallable packages left");
+
+ while (my ($name, $b) = each %uninstallable) {
+ my $s = $source_of{$name};
+
+ # only use the first alternative in OR'd dependencies, skip others
+ my $skip_next = 0;
+ for (@{$s->{BuildDepends}{"Build-Depends"}}) {
+ my $skip_this = $skip_next;
+ if (defined $_->[1] && ($_->[1] == AptPkg::Dep::Or)) {
+ $skip_next = 1;
+ } else {
+ $skip_next = 0;
+ }
+ next if $skip_this;
+ my $visited = {};
+ debug("$s->{Package}: Build-Depends on $_->[0]");
+ $uninstallable_dependencies_cache{$_->[0]} =
+ find_uninstallable_dependencies($_->[0], $visited, []);
+ my @result = keys %{$uninstallable_dependencies_cache{$_->[0]}};
+ debug("$s->{Package} => $_->[0] ->" . join(" ", @result)) if @result;
+ for (@result) {
+ $needed_by{$_}{$name} = 1;
+ $needs_packages{$name}{$_} = 1;
+ }
+ }
+ }
+
+ # output all buildable packages found
+
+ my $buildable_found = 0;
+ for (sort keys %uninstallable) {
+ if (!exists $needs_packages{$_}) {
+ $buildable_found = 1;
+ delete $uninstallable{$_};
+ # include any reverse dependencies as a comment
+ if (exists $needed_by{$_}) {
+ print "# $_ is needed by "
+ . join(" ", sort keys %{$needed_by{$_}})
+ . "\n";
+ }
+ print "$_ $round\n";
+ }
+ }
+
+ if (!$buildable_found) {
+ my $left = scalar keys %uninstallable;
+ if ($left) {
+ notice("circular dependencies found, quitting with $count uninstallable packages left");
+ for (sort keys %uninstallable) {
+ print "# $_ circular dependency: needed by "
+ . join(" ", sort keys %{$needs_packages{$_}})
+ . "\n";
+ if (exists $needed_by{$_}) {
+ print "# $_ circular dependency: needs "
+ . join(" ", sort keys %{$needed_by{$_}})
+ . "\n";
+ }
+ print "$_ U\n";
+ }
+ }
+ last; # this is the only exit place: no buildable packages found anymore
+ }
+
+ # reset the cache on each round
+ %uninstallable_dependencies_cache = ();
+
+ $round++;
+}
+
+notice("all done!");
+
+# find uninstallable recursive dependencies of a given package
+#
+# the second argument is a hash of all visited packages to break
+# circular dependencies
+#
+# the third argument is the dependency path; it's stored in the result hash
+# for informational purposes only
+
+sub find_uninstallable_dependencies {
+ my ($package, $visited, $path) = @_;
+ my $level = scalar @$path;
+ my $prefix = " "x$level;
+ my %ret;
+ $visited->{$package} = 1;
+ if (exists $uninstallable{$package}) {
+ $ret{$package} = $path;
+ }
+ if (exists $uninstallable_dependencies_cache{$package}) {
+ debug("${prefix}$package dependencies already known, returning");
+ return $uninstallable_dependencies_cache{$package};
+ }
+ my @dependencies = lookup_dependencies($package);
+ debug("${prefix}$package depends on " .
+ ((scalar @dependencies) ? join(",", @dependencies) : "nothing"));
+ for my $dep (@dependencies) {
+ if (exists $visited->{$dep}) {
+ #debug("${prefix}already visited $dep, skipping");
+ next;
+ }
+ %ret = (%ret, %{find_uninstallable_dependencies($dep, $visited, [ @$path, $package ])});
+ }
+ return \%ret;
+}
+
+# just find recursive dependencies of a given package
+sub lookup_dependencies {
+ my $pkg = shift;
+ my $blist = $bincache->{$pkg};
+ if (!$blist || !$blist->{VersionList}) {
+ debug("$pkg is not a real package, skipping");
+ return ();
+ };
+
+ my $b = bin_latest($blist);
+ my $depends = $b->{DependsList};
+ my $skipnext = 0;
+ my @ret;
+
+ for (@$depends) {
+ next if $_->{DepType} ne "Depends" && $_->{DepType} ne "PreDepends";
+ my $skipthis = $skipnext;
+ if (defined $_->{CompType} && ($_->{CompType} & AptPkg::Dep::Or)) {
+ $skipnext = 1;
+ } else {
+ $skipnext = 0;
+ }
+ next if $skipthis;
+ push @ret, $_->{TargetPkg}->{Name};
+ }
+ return @ret;
+}
+
+sub read_packages_from_file {
+ my $file = shift;
+ my @ret;
+
+ debug("reading $file");
+ if ($file ne "-") {
+ open(IN, '<', $file) or die("open $file for reading: $!");
+ } else {
+ *IN = *STDIN;
+ }
+ while (<IN>) {
+ next if /^\s*#/;
+ chomp;
+ my ($package, @rest) = split;
+ push @ret, $package;
+ }
+ close IN;
+ return @ret;
+}
+
+sub bin_latest {
+ my $p = shift;
+ return (sort bin_byversion @{$p->{VersionList}})[-1];
+}
+
+sub bin_byversion {
+ return $versioning->compare($a->{VerStr}, $b->{VerStr});
+}
+
+sub src_latest {
+ return (sort src_byversion @_)[-1];
+}
+
+sub src_byversion {
+ return $versioning->compare($a->{Version}, $b->{Version});
+}
+
+sub debug {
+ print STDERR "DEBUG: " . (shift) . "\n" if $debug;
+}
+
+sub notice {
+ print STDERR "NOTE: " . (shift) . "\n" if $verbose;
+}
Propchange: scripts/perl-5.10-transition/find-rebuild-order
------------------------------------------------------------------------------
svn:executable = *
Added: scripts/perl-5.10-transition/print-packages-file
URL: http://svn.debian.org/wsvn/scripts/perl-5.10-transition/print-packages-file?rev=13192&op=file
==============================================================================
--- scripts/perl-5.10-transition/print-packages-file (added)
+++ scripts/perl-5.10-transition/print-packages-file Mon Jan 21 19:40:30 2008
@@ -1,0 +1,18 @@
+#!/usr/bin/perl -w
+use strict;
+use AptPkg::Cache;
+
+# print the full pathname to the packages file for Debian unstable
+# there's probably an easier way to do this, but this seems to work
+
+my $cache = AptPkg::Cache->new;
+for ($cache->files) {
+ next if $_->{IndexType} ne "Debian Package Index"
+ || $_->{Archive} ne "unstable"
+ || $_->{Component} ne "main"
+ || $_->{Origin} ne "Debian";
+ print $_->{FileName};
+ exit 0;
+}
+warn("no packages file for Debian unstable found?");
+print "/no/such/file";
Propchange: scripts/perl-5.10-transition/print-packages-file
------------------------------------------------------------------------------
svn:executable = *
More information about the Pkg-perl-cvs-commits
mailing list