[Pkg-asv-commits] r18 - trunk
ahoenen-guest at alioth.debian.org
ahoenen-guest at alioth.debian.org
Sun Jan 13 14:51:52 UTC 2008
Author: ahoenen-guest
Date: 2008-01-13 14:51:52 +0000 (Sun, 13 Jan 2008)
New Revision: 18
Modified:
trunk/apt-show-versions
Log:
Replace hardcoded list of supported release names by dynamic determination of
used release names. This enables (among others) automatic support for oldstable
and for inofficial repositories (and should close about half of the open bug
reports).
Associated with this are changes in the output format of option -a:
- Avoid repetition for the default-release version.
- Strictly sort versions by version number as primary criterion (for details
look sub sort_pkg_releases).
Example:
Old output:
$ apt-show-versions -a dblatex
dblatex 0.2.8-2 install ok installed
dblatex 0.2.8-2 testing
dblatex 0.2-2 stable
dblatex 0.2.8-2 testing
dblatex 0.2.8-2 unstable
dblatex/testing uptodate 0.2.8-2
New output:
./apt-show-versions -a dblatex
dblatex 0.2.8-2 install ok installed
No oldstable version
dblatex 0.2-2 stable
dblatex 0.2.8-2 testing
dblatex 0.2.8-2 unstable
dblatex/testing uptodate 0.2.8-2
Modified: trunk/apt-show-versions
===================================================================
--- trunk/apt-show-versions 2008-01-12 14:15:22 UTC (rev 17)
+++ trunk/apt-show-versions 2008-01-13 14:51:52 UTC (rev 18)
@@ -51,6 +51,13 @@
my $VERSION;
$VERSION ='0.12';
+# Provide some constants (to avoid redundant literals).
+my $CODENAME = 'Codename';
+my $NAME = 'Name';
+my $RELEASE = 'Release';
+my $SUITE = 'Suite';
+my $UNKNOWN = 'unknown';
+
# process commandline parameters
my %opts;
# If more than one packages are requested by name, each one gets registered
@@ -122,6 +129,10 @@
my @files;
my $filesref;
+my %used_suites = ();
+# Determine the release names currently used by this host.
+my %releasenames = &determine_releasenames();
+
if (exists $opts{'initialize'}) {
unlink $apackagescachefile;
unlink $ipackagescachefile;
@@ -152,7 +163,7 @@
$ipackages = retrieve($ipackagescachefile);
}
if (!-e $ipackagescachefile or -M $status_file < -M $ipackagescachefile or !ref($ipackages)) {
- $ipackages = parse_file ($status_file, 1);
+ ($ipackages, undef) = parse_file ($status_file, 1);
($< == 0) and (store($ipackages, $ipackagescachefile) or
warn "Can't write $ipackagescachefile");
}
@@ -168,60 +179,23 @@
my $default_release = $_config->get("APT::Default-Release");
-my %releases = ();
-my @official_releases = qw(stable proposed-updates testing unstable);
-unshift @official_releases, $default_release if $default_release;
-my %official_releases = map { $_ => 1 } @official_releases;
+my @official_suites = qw(oldstable stable proposed-updates testing unstable);
+# %official_suites:
+# - Keys: Known official suite names
+# - Values: Order index
+my %official_suites;
+foreach (0 .. $#official_suites) {
+ $official_suites{$official_suites[$_]} = $_ + 1;
+}
# Get available package information out of all Packages files
foreach (@files) {
- my $release = $_;
- $release =~ s/Packages/Release/;
- $release = quotemeta $release;
- my $archiv;
- $archiv = `fgrep -s Archive $release` or
- $archiv = `fgrep -s Suite $release` or
- ($release =~ /(potato|woody|sarge|etch|lenny|sid|stable|testing|unstable|experimental)/ and $archiv = $1) or
- $archiv = "unknown";
- # next;
- $archiv =~ s/Archive: //;
- $archiv =~ s/Suite: //;
- $archiv =~ s/\n//;
- $releases{$archiv} = 1;
-
# Parse Packages file if creation time is newer than packages cache
- if (! -e $apackagescachefile or -C $_ < -M $apackagescachefile or $cache_file_corrupt) {
- my $href = &parse_file ($_);
+ if (! -e $apackagescachefile or -C $_ < -M $apackagescachefile
+ or $cache_file_corrupt) {
+ my ($href, $release) = &parse_file ($_);
foreach (keys %$href) {
- # if ((defined $apackages->{$_}{$archiv}) &&
- # exists $opts{'package'} &&
- # !exists $opts{'regex'} &&
- # $opts{'package'} eq $_ ) {
- # print "DEBUG: " . $apackages->{$_}{$archiv}->{'Version'} .
- # ":" . $href->{$_}->{'Version'} .
- # ":" . $vs->compare($apackages->{$_}{$archiv}->{'Version'},
- # $href->{$_}->{'Version'}) . "\n";
- # }
- # skip packages which we don't want to see
- # next unless (!exists $opts{'package'} ||
- # ((exists $opts{'regex'} &&
- # ($href->{$_}->{'Package'} =~ m/$opts{'package'}/)) ||
- # ($href->{$_}->{'Package'} eq $opts{'package'})));
- # skip package info with same release but smaler version
- if ((defined $apackages->{$_}{$archiv}) and
- ($vs->compare($apackages->{$_}{$archiv}->{'Version'},
- $href->{$_}->{'Version'}) > 0)) {
- if ((exists $opts{'package'}
- and not exists $opts{'regex'}
- and $opts{'package'} eq $_)
- or $pkg_names{$_}) {
- # print "DEBUG: " . $apackages->{$_}{$archiv}->{'Version'} .
- # ":" . $href->{$_}->{'Version'} . " next\n";
- }
- next;
- }
- # add package info together with release to hash
- $apackages->{$_}{$archiv} = $href->{$_};
+ $apackages->{$_}{$release} = $href->{$_};
}
}
}
@@ -287,21 +261,10 @@
sub print_package {
my ($package) = @_;
- #
- my @releases = ();
- # Only report on release we found
- # include official releases first
- foreach (@official_releases) {
- if (exists $releases{$_}) {
- push @releases, $_;
- }
- }
- # include also other releases
- foreach (keys %releases) {
- push @releases, $_
- unless $official_releases{$_};
- }
+ my @pkg_releases =
+ sort sort_pkg_releases values(%{$apackages->{$package}});
+
# print more information if required
if ($opts{'allversions'}) {
if ($ipackages->{$package}->{'Package'}) {
@@ -315,17 +278,36 @@
print "Not installed\n";
}
- # foreach ("stable", "testing", "unstable") {
- foreach (@releases) {
- if (defined $apackages->{$package}{$_}) {
- print $apackages->{$package}{$_}->{'Package'}, "\t";
- print $apackages->{$package}{$_}->{'Version'}, "\t";
- print $_, "\n";
- } else {
- print "No $_ version\n"
- if $official_releases{$_};
+ # The base of the two indexes $official_handled_idx and $official_idx is 1:
+ # first value of %official_suites.
+ my $official_handled_idx = 0; # Initialize: nothing handled yet.
+ foreach my $pkg (@pkg_releases) {
+ # First handle missing official suites to be listed before current
+ # release.
+ my $official_idx =
+ $official_suites{$releasenames{$pkg->{$RELEASE}}{$SUITE}};
+ if ($official_idx) {
+ foreach ($official_handled_idx .. $official_idx - 2) {
+ if ($used_suites{$official_suites[$_]}) {
+ print "No $official_suites[$_] version\n";
+ }
+ }
+ $official_handled_idx = $official_idx;
}
+ # Then list current release.
+ print $pkg->{'Package'}, "\t";
+ print $pkg->{'Version'}, "\t";
+ print $releasenames{$pkg->{$RELEASE}}{$NAME}, "\n";
}
+ # Handle missing official suites for packages without any available
+ # releases.
+ unless (@pkg_releases) {
+ foreach (0 .. $#official_suites) {
+ if ($used_suites{$official_suites[$_]}) {
+ print "No $official_suites[$_] version\n";
+ }
+ }
+ }
}
my $iversion = $ipackages->{$package}->{'Version'};
@@ -334,12 +316,15 @@
if (($ipackages->{$package}->{'Version'}) &&
(!($ipackages->{$package}->{'Status'} =~ /config-files/))) {
+ # Reorder package version structures to prefer the default release.
+ @pkg_releases = &reorder_pkg_releases(@pkg_releases);
my $found = 0;
my $aversion = 0;
- foreach (@releases) {
- my $version = $apackages->{$package}{$_}->{'Version'};
+ foreach (@pkg_releases) {
+ my $version = $_->{'Version'};
if ($version) {
- $found = print_version($_, $package, $iversion, $version);
+ $found = print_version($releasenames{$_->{$RELEASE}}{$NAME}, $package,
+ $iversion, $version);
$aversion = $version;
}
last if $found;
@@ -348,8 +333,8 @@
# Test whether installed version is newer
# than all available versions.
my $newer_indic = 1;
- foreach (@releases) {
- my $cmp_version = $apackages->{$package}{$_}->{'Version'};
+ foreach (@pkg_releases) {
+ my $cmp_version = $_->{'Version'};
if ($cmp_version and
$vs->compare($iversion, $cmp_version) <= 0)
{
@@ -386,18 +371,19 @@
}
# ------------------------------------------------------
-# FUNCTION: HASHREF = parse_file FILE (STATUS)
+# FUNCTION: HASHREF, RELEASE_KEY = parse_file FILE (STATUS)
#
# Parses FILE into an HASHREF of Hashes
# Set STATUS when the file should be parsed just for
# installed packages (here the dpkg status file)
-# Returns HASHREF.
+# Returns HASHREF and key of corresponding %releasenames record.
# ------------------------------------------------------
sub parse_file {
my ($file, $status) = @_;
my ($key, $value, $package, $packages);
+ my $release = &determine_pkgfile_release($file);
open FILE, $file or die "Can't open file $file: $!";
if ($opts{'verbose'}) {print "Parsing $file...";};
while (<FILE>) {
@@ -419,6 +405,7 @@
if (!defined $packages->{$package->{'Package'}} or
$vs->compare($packages->{$package->{'Package'}}{'Version'},
$package->{'Version'}) < 0) {
+ $package->{$RELEASE} = $release;
$packages->{$package->{'Package'}} = $package;
}
}
@@ -433,9 +420,178 @@
}
if ($opts{'verbose'}) {print " completed.\n"};
close FILE;
- return $packages;
+ return $packages, $release;
}
+################################################################################
+# Determine the release of the specified package file.
+################################################################################
+sub determine_pkgfile_release {
+ my $pkgfile = shift;
+
+ $pkgfile =~ s{.*/}{};
+ return undef if ($pkgfile eq 'status');
+ foreach (keys %releasenames) {
+ return $_ if ($_ eq substr($pkgfile, 0, length($_)));
+ }
+ # As package file has no release file, create a fallback %releasenames
+ # record based on the information of the package file name.
+ my $releasename;
+ foreach my $suite (@official_suites) {
+ if (index($pkgfile, "_${suite}_") != -1) {
+ # Packagefile belongs to a known suite.
+ ($releasename = $pkgfile) =~ s/(.*$suite).*/$1/;
+ $releasenames{$releasename}{$SUITE} = $suite;
+ $releasenames{$releasename}{$NAME} = $suite;
+ last;
+ }
+ }
+ unless ($releasename) {
+ # No release information available for this package file:
+ # create a dummy %releasenames record.
+ $releasename = $pkgfile;
+ $releasenames{$releasename}{$SUITE} = $UNKNOWN;
+ $releasenames{$releasename}{$NAME} = $UNKNOWN;
+ }
+ $releasenames{$releasename}{$CODENAME} = $UNKNOWN;
+ return $releasename;
+}
+
+################################################################################
+# Determine the release names currently used by this host.
+################################################################################
+sub determine_releasenames {
+ my %rel_names;
+ opendir LIST_DIR, $list_dir
+ or die "Failed to open directory $list_dir: $!\n";
+ while (defined(my $rel_file = readdir LIST_DIR)) {
+ my $file_name = "$list_dir/$rel_file";
+ if ($rel_file =~ m/(.*)_Release$/) {
+ $rel_file = $1;
+ }
+ else {
+ next;
+ }
+ open RELEASE_FILE, "< $file_name"
+ or die "Failed to open file $file_name for reading: $!\n";
+ while (defined (my $line = <RELEASE_FILE>)) {
+ if ($line =~ m/^\s*($SUITE|$CODENAME):\s*(\S+)\s*$/o) {
+ $rel_names{$rel_file}{$1} = $2;
+ }
+ # After extracting values for Suite and Codename, do not parse
+ # rest of release file.
+ # Thus normally only the first lines of the release file must be
+ # read, whereas the much bigger rest may be skipped.
+ if (defined $rel_names{$rel_file}{$SUITE} and
+ defined $rel_names{$rel_file}{$CODENAME}) {
+ last;
+ }
+ }
+ close RELEASE_FILE
+ or die "Failed to close file $file_name: $!\n";
+ # Register suite as used.
+ if (defined $rel_names{$rel_file}{$SUITE}) {
+ $used_suites{$rel_names{$rel_file}{$SUITE}} = 1;
+ }
+ # Provide default values for missing fields.
+ foreach ($SUITE, $CODENAME) {
+ unless (defined $rel_names{$rel_file}{$_}) {
+ $rel_names{$rel_file}{$_} = $UNKNOWN;
+ }
+ }
+ # Determine name relevant to user (as used in sources.list):
+ # either Suite or Codename.
+ if ($rel_file =~ m/_$rel_names{$rel_file}{$SUITE}/) {
+ $rel_names{$rel_file}{$NAME} = $rel_names{$rel_file}{$SUITE};
+ }
+ elsif ($rel_file =~ m/_$rel_names{$rel_file}{$CODENAME}/) {
+ $rel_names{$rel_file}{$NAME} = $rel_names{$rel_file}{$CODENAME};
+ }
+ else {
+ # Fall back to Suite.
+ $rel_names{$rel_file}{$NAME} = $rel_names{$rel_file}{$SUITE};
+ }
+ }
+ closedir LIST_DIR
+ or die "Failed to close directory $list_dir: $!\n";
+ return %rel_names;
+}
+
+################################################################################
+# Reorder package releases in a way that within the releases of the same
+# version number the default release gets placed first.
+################################################################################
+sub reorder_pkg_releases {
+ my @releases = @_;
+
+ if (@releases and $default_release) {
+ # Reordering strategy:
+ # - Precondition: The releases are sorted by version already.
+ # - Iterate over the release list: from "left" to "right".
+ # - For the releases of each version:
+ # - Find the first release that is not the default release.
+ # - If right from this "move candidate" the default release is found,
+ # move it left before the move candidate.
+ my $move_idx; # Index of move candidate
+ foreach my $idx (0 .. $#releases) {
+ my $rel_key = $releases[$idx]->{$RELEASE};
+ if (defined $move_idx) {
+ # There exists a move candidate.
+ if ($releases[$idx]->{'Version'} eq
+ $releases[$move_idx]->{'Version'}) {
+ # Current release is of same version as move candidate.
+ if ($releasenames{$rel_key}{$SUITE} eq $default_release or
+ $releasenames{$rel_key}{$CODENAME}
+ eq $default_release) {
+ # Move current release before move candidate in order to
+ # place default release first.
+ my $rel = splice @releases, $idx, 1;
+ splice @releases, $move_idx, 0, $rel;
+ $move_idx = $idx;
+ }
+ }
+ else {
+ # Version change
+ undef $move_idx;
+ }
+ }
+ unless (defined $move_idx) {
+ # Test whether current release is move candidate.
+ if ($releasenames{$rel_key}{$SUITE} ne $default_release and
+ $releasenames{$rel_key}{$CODENAME} ne $default_release) {
+ $move_idx = $idx;
+ }
+ }
+ }
+ }
+ return @releases;
+}
+
+################################################################################
+# Sorting function for package releases
+# Sorting hierarchy:
+# 1) Release number
+# 2) @official_suites (in array order) before other ones
+# 3) Release name
+################################################################################
+sub sort_pkg_releases {
+ my $cmp_versions = $vs->compare($a->{'Version'}, $b->{'Version'});
+ return $cmp_versions if ($cmp_versions);
+ my $cmp_suites = (&suite_idx($releasenames{$a->{$RELEASE}}{$SUITE}) <=>
+ &suite_idx($releasenames{$b->{$RELEASE}}{$SUITE}));
+ return $cmp_suites if ($cmp_suites);
+ return($releasenames{$a->{$RELEASE}}{$NAME} cmp
+ $releasenames{$b->{$RELEASE}}{$NAME});
+}
+
+################################################################################
+# Return the sorting index of the specified suite name.
+# Unofficial suites are sorted last.
+################################################################################
+sub suite_idx {
+ return($official_suites{$_[0]} || length(keys(%official_suites)) + 1);
+}
+
# script documentation (POD style)
=head1 NAME
More information about the Pkg-asv-commits
mailing list