#! /usr/bin/perl
#
# Copyright (C) Colin Watson 2003, 2004, 2005, 2006, 2007, 2008, 2010.
#
# Version comparison algorithm code based on Dpkg::Version:
#   Copyright (C) Ian Jackson.
#   Copyright (C) Colin Watson.
#   Copyright (C) Don Armstrong 2007.
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.

use warnings;
use strict;
use feature qw(say state);

use Fcntl qw(:flock);
use File::Path;
use Getopt::Long;

use constant VERSION => '0.21';

use constant USER_CONFIG => "$ENV{HOME}/.madison-lite";
use constant SYSTEM_CONFIG => '/etc/madison-lite';

use constant CACHE_FORMAT => 2;

my $configfile;
my $simplemirror;
my $caching = 1;
my $update_cache = 0;
my $source_and_binary = 0;
my $regex = 0;
my ($architectures, %architectures);
my ($components, %components);
my ($suites, @suites);

my %config;
my (@packages, %packages);


############################################################################
# Utility functions
############################################################################

# Print a usage message to FILEHANDLE and exit with status EXITCODE.
sub usage (*$) {
    my ($filehandle, $exitcode) = @_;
    print $filehandle <<EOF;
Usage: madison-lite [options] package [...]

Inspect a Debian package archive and display the versions of the given
packages found in each suite.

  --config-file FILE         read configuration from FILE
  --mirror DIRECTORY         use DIRECTORY as top level of Debian mirror
  --nocache                  don't cache parsed Packages and Sources files

  -a, --architecture ARCH    only show info for ARCH(es)
  -c, --component COMPONENT  only show info for COMPONENT(s)
  -h, --help                 show this help and exit
  -r, --regex                treat PACKAGE as a regular expression
  -s, --suite SUITE          only show info for SUITE(s)
  -S, --source-and-binary    show info for binary children of source packages

ARCH, COMPONENT, and SUITE can be comma- or space-separated lists.
EOF
    exit $exitcode;
}

# Print version information to standard output and exit with zero status.
sub showversion () {
    say 'madison-lite version ', VERSION;
    exit 0;
}

# Read configuration file FILENAME into %config. Return true if the file
# was opened successfully, otherwise false.
sub read_config ($) {
    my $filename = shift;
    return 0 unless open my $config, '<', $filename;
    local $_;
    while (<$config>) {
	chomp;
	next if /^#/;
	if (/^mirror\s+(.*)/) {
	    $config{mirror} = $1;
	} elsif (/^suite\s+(.*?) # name
			\s+(.*?) # directory
			((?: \s+(.*?) )*) # optional components
		  $/x) {
	    my ($name, $directory, $components) = ($1, $2, $3);
	    $config{suites}{$name} = $directory;
	    push @{$config{suiteorder}}, $name;
	    $components =~ s/^\s+//;
	    $config{suitecomponents}{$name} = [split ' ', $components];
	} else {
	    say STDERR "$0: $filename:$.: unrecognized directive '$_'";
	}
    }
    return 1;
}

# Compare two architecture names. Normal comparison except that 'source'
# always compares earlier.
sub archcmp ($$)
{
    if ($_[0] eq 'source') {
	if ($_[1] eq 'source') {
	    return 0;
	} else {
	    return -1;
	}
    } else {
	if ($_[1] eq 'source') {
	    return 1;
	} else {
	    return $_[0] cmp $_[1];
	}
    }
}

# Parse a Debian version number into its component parts.
sub parseversion ($)
{
    my $ver = shift;
    my %verhash;
    if ($ver =~ /:/)
    {
	$ver =~ /^(\d+):(.+)/ or die "bad version number '$ver'";
	$verhash{epoch} = $1;
	$ver = $2;
    }
    else
    {
	$verhash{epoch} = 0;
    }
    if ($ver =~ /(.+)-(.+)$/)
    {
	$verhash{version} = $1;
	$verhash{revision} = $2;
    }
    else
    {
	$verhash{version} = $ver;
	$verhash{revision} = 0;
    }
    return %verhash;
}

# Compare upstream-version or Debian-revision components of a Debian version
# number.
sub verrevcmp ($$)
{
    my $order = sub {
	my ($x) = @_;
	# #define order(x) ((x) == '~' ? -1 \
	#            : cisdigit((x)) ? 0 \
	#            : !(x) ? 0 \
	#            : cisalpha((x)) ? (x) \
	#            : (x) + 256)
	# This comparison is out of dpkg's order to avoid
	# comparing things to undef and triggering warnings.
	if (not defined $x) {
	    return 0;
	} elsif ($x eq '~') {
	    return -1;
	} elsif ($x =~ /^\d$/) {
	    return 0;
	} elsif ($x =~ /^[A-Z]$/i) {
	    return ord($x);
	} else {
	    return ord($x) + 256;
	}
    };

    my $next_elem = sub {
	my $a = shift;
	return @{$a} ? shift @{$a} : undef;
    };

    my ($val, $ref) = @_;
    $val //= "";
    $ref //= "";
    my @val = split //, $val;
    my @ref = split //, $ref;
    my $vc = $next_elem->(\@val);
    my $rc = $next_elem->(\@ref);
    while (defined $vc or defined $rc) {
	my $first_diff = 0;
	while ((defined $vc and $vc !~ /^\d$/) or
	       (defined $rc and $rc !~ /^\d$/)) {
	    my $vo = $order->($vc);
	    my $ro = $order->($rc);
	    # Unlike dpkg's verrevcmp, we only return 1 or -1 here.
	    return (($vo - $ro > 0) ? 1 : -1) if $vo != $ro;
	    $vc = $next_elem->(\@val);
	    $rc = $next_elem->(\@ref);
	}
	while (defined $vc and $vc eq '0') {
	    $vc = $next_elem->(\@val);
	}
	while (defined $rc and $rc eq '0') {
	    $rc = $next_elem->(\@ref);
	}
	while (defined $vc and $vc =~ /^\d$/ and
	       defined $rc and $rc =~ /^\d$/) {
	    $first_diff = ord($vc) - ord($rc) if !$first_diff;
	    $vc = $next_elem->(\@val);
	    $rc = $next_elem->(\@ref);
	}
	return 1 if defined $vc and $vc =~ /^\d$/;
	return -1 if defined $rc and $rc =~ /^\d$/;
	return $first_diff if $first_diff;
    }
    return 0;
}

# Compare the two arguments as dpkg-style version numbers. Returns -1 if the
# first argument represents a lower version number than the second, 1 if the
# first argument represents a higher version number than the second, and 0
# if the two arguments represent equal version numbers.
sub vercmp ($$)
{
    my %version = parseversion $_[0];
    my %refversion = parseversion $_[1];
    return 1 if $version{epoch} > $refversion{epoch};
    return -1 if $version{epoch} < $refversion{epoch};
    my $r = verrevcmp $version{version}, $refversion{version};
    return $r if $r;
    return verrevcmp $version{revision}, $refversion{revision};
}

# Find the first of FILENAME, FILENAME.gz, FILENAME.bz2, or FILENAME.xz that
# exists.
sub find_list_file ($) {
    my $filename = shift;
    if (-f $filename) {
	return $filename;
    } elsif (-f "$filename.gz") {
	return "$filename.gz";
    } elsif (-f "$filename.bz2") {
	return "$filename.bz2";
    } elsif (-f "$filename.xz") {
	return "$filename.xz";
    } else {
	return undef;
    }
}

# Open a Packages or Sources file FILENAME, decompressing it if necessary.
# Return a filehandle associated with that (uncompressed) file, or undef if
# it could not be opened successfully.
sub open_list_file ($) {
    my $filename = shift;
    return undef unless defined $filename;
    if ($filename =~ /\.gz$/) {
	open my $fh, '-|', 'zcat', $filename or return undef;
	return $fh;
    } elsif ($filename =~ /\.bz2$/) {
	open my $fh, '-|', 'bzcat', $filename or return undef;
	return $fh;
    } elsif ($filename =~ /\.xz$/) {
	open my $fh, '-|', 'xzcat', $filename or return undef;
	return $fh;
    } else {
	open my $fh, '<', $filename or return undef;
	return $fh;
    }
}

# Print a warning about caching being disabled, unless it has been printed
# before.
sub caching_disabled ($) {
    state $cache_warning_printed = 0;
    return if $cache_warning_printed;
    my $why = shift;
    say STDERR "$0: caching disabled because $why";
    $cache_warning_printed = 1;
}

my $cache_dir_created = 0;

sub ensure_cache_dir () {
    my $cache_dir = USER_CONFIG . '/cache';

    return $cache_dir if $cache_dir_created;

    eval { mkpath ($cache_dir); };
    die "$0: can't create cache directory '$cache_dir': $@" if $@;

    $cache_dir_created = 1;

    unless (-f "$cache_dir/CACHEDIR.TAG") {
	if (open my $tag, '>', "$cache_dir/CACHEDIR.TAG") {
	    print $tag <<EOF;
Signature: 8a477f597d28d172789f06886806bc55
# This file is a cache directory tag created by madison-lite.
# For information about cache directory tags, see:
#	http://www.brynosaurus.com/cachedir/
EOF
	    close $tag;
	}
    }

    return $cache_dir;
}

my $cache_lock_fh = undef;

# Obtain a (blocking) read-lock on the cache
sub take_cache_read_lock () {
    return 1 if defined($cache_lock_fh);

    my $cache_dir = ensure_cache_dir;
    unless (open $cache_lock_fh, '+>', "$cache_dir/lock") {
	die "Unable to open lock-file $cache_dir/lock";
    }
    flock $cache_lock_fh, LOCK_SH;
    return 1;
}

# Upgrade to a write-lock (blocking)
sub upgrade_cache_lock () {
    flock $cache_lock_fh, LOCK_EX;
}

# Encode FILENAME into a cache filename.
sub cache_filename ($) {
    my $filename = shift;

    eval { require Digest::MD5; import Digest::MD5 qw(md5_hex); };
    if ($@) {
	caching_disabled 'Digest::MD5 cannot be loaded';
	return undef;
    }

    my $cache_dir = ensure_cache_dir;
    return "$cache_dir/" . md5_hex ($filename);
}

# Print the cache format to FILEHANDLE.
sub cache_print_format (*) {
    my $filehandle = shift;
    print $filehandle 'Format: ', CACHE_FORMAT, "\n";
}

# Check the cache format in FILEHANDLE. Return true if it's OK, otherwise
# false.
sub cache_check_format (*) {
    my $filehandle = shift;
    my $line = <$filehandle>;
    return 0 unless defined $line;
    chomp $line;
    if ($line eq ('Format: ' . CACHE_FORMAT)) {
	return 1;
    } else {
	return 0;
    }
}

# Convert a list file FILENAME into cached form. The package cache contains:
#   <package> <version>
# The source cache contains:
#   <source> <binaries> (space-separated)
# Return true if a cached form is now available, otherwise false.
sub cache_list_file ($$$) {
    my ($filename, $what, $is_packages) = @_;
    my $real_filename = find_list_file $filename;
    unless (defined $real_filename) {
	warn "$0: can't find $what\n";
	return 0;
    }
    my $listtime = (stat $real_filename)[9];
    my $cache_filename = cache_filename $filename;
    return 0 unless defined $cache_filename;

    my ($pcache, $scache);

    # Already cached?
    if (not $update_cache and
	(-f "$cache_filename.pkg" and
	 (stat "$cache_filename.pkg")[9] == $listtime) and
	(-f "$cache_filename.src" and
	 (stat "$cache_filename.src")[9] == $listtime)) {
	if ((open $pcache, '<', "$cache_filename.pkg") and
	    (open $scache, '<', "$cache_filename.src") and
	    cache_check_format ($pcache) and
	    cache_check_format ($scache)) {
	    return 1;
	}
	undef $pcache;
	undef $scache;
    }

    upgrade_cache_lock;

    my $fh = open_list_file $real_filename;

    unless (open $pcache, '>', "$cache_filename.pkg") {
	caching_disabled "'$cache_filename.pkg' cannot be opened: $!";
	return 0;
    }
    cache_print_format $pcache;
    print $pcache "Original: $filename\n";

    my %sources;

    local $/ = ''; # paragraph mode
    local $_;
    while (<$fh>) {
	if (/^Package:\s+(.*)/m) {
	    my $package = $1;
	    next if $package =~ /\s/;
	    if (/^Version:\s+(.*)/m) {
		my $version = $1;
		if ($is_packages and /^Architecture: all$/m) {
		    print $pcache "$package $version all\n";
		} else {
		    print $pcache "$package $version\n";
		}
	    }
	    if (/^Source:\s+(.*)/m) {
		# Packages file
		push @{$sources{$1}}, $package;
	    }
	    # Don't bother with Binary: entries in Sources files. There
	    # should always be corresponding Package: and Source: pairs in
	    # Packages, and if there aren't we won't be able to do anything
	    # useful with the source-to-binary mapping anyway.
	}
    }

    close $pcache;
    utime $listtime, $listtime, "$cache_filename.pkg";

    unless (open $scache, '>', "$cache_filename.src") {
	caching_disabled "'$cache_filename.src' cannot be opened: $!";
	return 0;
    }
    cache_print_format $scache;
    print $scache "Original: $filename\n";
    for my $source (sort keys %sources) {
	print $scache "$source ", (join ' ', @{$sources{$source}}), "\n";
    }
    close $scache;
    utime $listtime, $listtime, "$cache_filename.src";

    return 1;
    # $fh is auto-closed
}

# Search a list file for %packages, given a FILEHANDLE and a precompiled
# regex FIELD matching the desired field names.
sub search_list_file ($$$$) {
    my ($fh, $field, $is_packages, $arch) = @_;
    my @results;

    # Precompile search pattern.
    my $packlist;
    if ($regex) {
	$packlist = join '|', map "(?:$_)", keys %packages;
    } else {
	$packlist = join '|', map "\Q$_\E\$", keys %packages;
    }
    my $search = qr/^$field:\s+(?:$packlist)/;

    local $/ = ''; # paragraph mode
    local $_;
    while (<$fh>) {
	if (/$search/m) {
	    next unless /^Package: (.*)/m; # might have been Package|Source
	    my $foundpackage = $1;
	    next unless /^Version: (.*)/m;
	    my $foundversion = $1;
	    my $foundsource;
	    # If the source isn't in our list of packages to search for,
	    # then it doesn't matter for sorting purposes, so just pretend
	    # it's $foundpackage.
	    if (/^Source: (.*)/m and exists $packages{$1}) {
		$foundsource = $1;
	    } else {
		$foundsource = $foundpackage;
	    }
	    # not necessarily already set for source packages matched by regex
	    unless (exists $packages{$foundsource}) {
		$packages{$foundsource} = $foundsource;
		push @packages, $foundsource;
	    }
	    if ($is_packages and /^Architecture: all/m) {
		push @results, [$foundsource, $foundpackage, $foundversion, 'all'];
	    } else {
		push @results, [$foundsource, $foundpackage, $foundversion, $arch];
	    }
	}
    }

    return @results;
}

# Search the cache file corresponding to FILENAME for %packages.
sub search_cache ($$) {
    my ($filename, $arch) = @_;
    my $cache_filename = cache_filename $filename;
    return () unless defined $cache_filename;
    my @results;

    my $pkglist;
    my $match;

    if ($regex) {
	$pkglist = join '|', map "(?:$_)", keys %packages;
    } else {
	$pkglist = join '|', map "\Q$_\E\$", keys %packages;
    }
    $match = qr/^(?:$pkglist)/;

    if (($source_and_binary or $regex) and
	open my $scache, '<', "$cache_filename.src") {
	# Look for source cache entries, indicating additional packages we
	# need to find.
	local $_;
	while (<$scache>) {
	    next if /^\S+: /;
	    my ($key, @values) = split;
	    if (($source_and_binary and $key =~ /$match/) or
		($regex and grep /$match/, @values)) {
		$packages{$_} = $key foreach @values;
	    }
	}
	close $scache;
    }

    if ($regex) {
	$pkglist = join '|', map "(?:$_)", keys %packages;
    } else {
	$pkglist = join '|', map "\Q$_\E\$", keys %packages;
    }
    $match = qr/^(?:$pkglist)/;

    open my $pcache, '<', "$cache_filename.pkg" or return ();
    local $_;
    while (<$pcache>) {
	next if /^\S+: /;
	my ($key, $value, $is_all) = split;
	if ($key =~ /$match/) {
	    # not necessarily already set for source packages matched by regex
	    unless (exists $packages{$key}) {
		$packages{$key} = $key;
		push @packages, $key;
	    }
	    if (defined $is_all and $is_all eq 'all') {
		push @results, [$packages{$key}, $key, $value, 'all'];
	    } else {
		push @results, [$packages{$key}, $key, $value, $arch];
	    }
	}
    }
    close $pcache;

    return @results;
}

# Search the Packages file in a directory, if any, for %packages.
sub search_packages ($$) {
    my ($dir, $arch) = @_;

    if ($caching and
	take_cache_read_lock and
	cache_list_file "$dir/Packages", "Packages list file in '$dir'", 1) {
	return search_cache "$dir/Packages", $arch;
    } else {
	my $fh = open_list_file (find_list_file "$dir/Packages");
	unless (defined $fh) {
	    warn "$0: can't find Packages list file in '$dir'\n";
	    return;
	}

	my $field;
	if ($source_and_binary) {
	    $field = qr/(?:Package|Source)/;
	} else {
	    $field = qr/Package/;
	}

	return search_list_file $fh, $field, 1, $arch;
	# $fh is auto-closed
    }
}

# Search the Sources file in a directory, if any, for %packages.
sub search_sources ($$) {
    my ($dir, $arch) = @_;

    if ($caching and
	take_cache_read_lock and
	cache_list_file "$dir/Sources", "Sources list file in '$dir'", 0) {
	return search_cache "$dir/Sources", $arch;
    } else {
	my $fh = open_list_file (find_list_file "$dir/Sources");
	unless (defined $fh) {
	    warn "$0: can't find Sources list file in '$dir'\n";
	    return;
	}

	my $field = qr/Package/;

	return search_list_file $fh, $field, 0, $arch;
	# $fh is auto-closed
    }
}


############################################################################
# Read configuration
############################################################################

Getopt::Long::Configure qw(no_ignore_case);
my $optresult = GetOptions (
    'help|h|?' => sub { usage *STDOUT, 0 },
    'version' => \&showversion,
    'config-file=s' => \$configfile,
    'mirror=s' => \$simplemirror,
    'cache!' => \$caching,
    'update!' => \$update_cache,
    'source-and-binary|S' => \$source_and_binary,
    'regex|r' => \$regex,
    'architecture|a=s' => \$architectures,
    'component|c=s' => \$components,
    'suite|s=s' => \$suites,
);

if (!$optresult) {
    usage *STDERR, 1;
} elsif (!@ARGV) {
    usage *STDERR, 1;
}

if ($configfile) {
    unless (read_config $configfile) {
	say STDERR "$0: can't find configuration file '$configfile'";
    }
} else {
    unless (read_config (USER_CONFIG . '/config')) {
	read_config (SYSTEM_CONFIG . '/config');
    }
}

$config{mirror} = $simplemirror if defined $simplemirror;

# Apply default configuration if necessary.
unless (exists $config{mirror}) {
    $config{mirror} = '.';
}
unless (exists $config{suites}) {
    opendir MIRROR, "$config{mirror}/dists"
	or die "$0: can't open mirror directory '$config{mirror}/dists'\n";
    my @dirents = sort grep { !/^\.\.?$/ } readdir MIRROR;
    for my $dirent (@dirents) {
	# Ignore symlinks to other suites in the same directory (e.g.
	# unstable -> sid).
	if (-l "$config{mirror}/dists/$dirent" and
	    (readlink "$config{mirror}/dists/$dirent") !~ m[/]) {
	    next;
	}
	if (-d "$config{mirror}/dists/$dirent") {
	    $config{suites}{$dirent} = "dists/$dirent";
	    push @{$config{suiteorder}}, $dirent;
	    $config{suitecomponents}{$dirent} = [];
	}
    }
    closedir MIRROR;
    die "$0: no suites found in $config{mirror}/dists\n"
	unless exists $config{suites};
}


############################################################################
# Main search loop
############################################################################

@packages = @ARGV;
%packages = map { $_ => $_ } @packages;

%architectures = map { $_ => 1 } split /[, ]+/, $architectures
    if defined $architectures;
%components = map { $_ => 1 } split /[ ,]+/, $components
    if defined $components;

# Find the list of suites we're looking at.
my @allsuites;
if (defined $suites) {
    @suites = split /[, ]+/, $suites if defined $suites;
    for my $cursuite (@suites) {
	die "$0: unknown suite '$cursuite'\n"
	    unless exists $config{suites}{$cursuite};
    }
} else {
    @suites = @{$config{suiteorder}};
}

# Compare two suite names in configured suite order.
sub suitecmp ($$)
{
    for my $suite (@suites) {
	if ($_[0] eq $suite) {
	    if ($_[1] eq $suite) {
		return 0;
	    } else {
		return -1;
	    }
	} elsif ($_[1] eq $suite) {
	    return 1;
	}
    }
    return $_[0] cmp $_[1];
}

# Search through all Packages and Sources files for %packages.
my %results;
for my $cursuite (@suites) {
    my $cursuitedir = $config{suites}{$cursuite};
    $cursuitedir = "$config{mirror}/$cursuitedir" if $cursuitedir !~ m[^/];
    # e.g. /debian/dists/stable

    # Find the list of components we're looking at; might be listed
    # explicitly in the configuration file and/or on the command line.
    my @components = @{$config{suitecomponents}{$cursuite}};
    unless (@components) {
	unless (opendir SUITE, $cursuitedir) {
	    warn "$0: can't open suite directory '$cursuitedir'\n";
	    next;
	}
	my @dirents = sort grep { !/^\.\.?$/ } readdir SUITE;
	for my $dirent (@dirents) {
	    push @components, $dirent if -d "$cursuitedir/$dirent";
	}
	closedir SUITE;
    }
    @components = grep { $components{$_} } @components if %components;

    for my $curcomp (@components) {
	next if $curcomp =~ /^\.\.?$/;
	# e.g. /debian/dists/stable/main
	my $curcompdir = "$cursuitedir/$curcomp";

	unless (opendir COMPONENT, "$curcompdir") {
	    warn "$0: can't open component directory '$curcompdir'\n";
	    next;
	}
	while (my $curarch = readdir COMPONENT) {
	    my @archresults;
	    my $curarchdir = "$curcompdir/$curarch";
	    if ($curarch =~ /^binary-(.*)$/) {
		# e.g. /debian/dists/stable/main/binary-i386
		$curarch = $1;
		next if defined $architectures and
			not $architectures{$curarch};
		@archresults = search_packages $curarchdir, $curarch;
	    } elsif ($curarch eq 'source') {
		# e.g. /debian/dists/stable/main/source
		next if defined $architectures and
			not $architectures{'source'};
		@archresults = search_sources $curarchdir, $curarch;
	    } else {
		next;
	    }

	    for my $result (@archresults) {
		my ($ressource, $respackage, $resversion, $resarch) = @$result;
		$results{$ressource}{$respackage}{$resversion}{$cursuite}{$curcomp}{$resarch} = 1;
	    }
	}
	closedir COMPONENT;
    }
}

# Calculate optimal column sizes.
my @sizes = (0, 0, 0);
for my $package (@packages) {
    next unless exists $results{$package};
    for my $binpkg (sort keys %{$results{$package}}) {
	for my $version (sort vercmp keys %{$results{$package}{$binpkg}}) {
	    for my $suite (sort suitecmp keys %{$results{$package}{$binpkg}{$version}}) {
		for my $comp (sort keys %{$results{$package}{$binpkg}{$version}{$suite}}) {
		    my $dispsuite = $suite;
		    if ($comp ne 'main') {
			$dispsuite = "$suite/$comp";
		    }
		    my $pkglen = length $binpkg;
		    my $verlen = length $version;
		    my $suitelen = length $dispsuite;
		    $sizes[0] = $pkglen if $pkglen > $sizes[0];
		    $sizes[1] = $verlen if $verlen > $sizes[1];
		    $sizes[2] = $suitelen if $suitelen > $sizes[2];
		}
	    }
	}
    }
}

# Print out the results.
for my $package (@packages) {
    next unless exists $results{$package};
    for my $binpkg (sort keys %{$results{$package}}) {
	for my $version (sort vercmp keys %{$results{$package}{$binpkg}}) {
	    for my $suite (sort suitecmp keys %{$results{$package}{$binpkg}{$version}}) {
		for my $comp (sort keys %{$results{$package}{$binpkg}{$version}{$suite}}) {
		    my $dispsuite = $suite;
		    if ($comp ne 'main') {
			$dispsuite = "$suite/$comp";
		    }
		    printf " %-*s | %-*s | %-*s | %s\n",
			$sizes[0], $binpkg, $sizes[1], $version,
			$sizes[2], $dispsuite,
			(join ', ', sort archcmp keys %{$results{$package}{$binpkg}{$version}{$suite}{$comp}});
		}
	    }
	}
    }
}
