#!/usr/bin/perl -w

# apt-show-versions - Lists available package versions with distribution

# This program parses the dpkg status file and the APT lists for the
# installed and available package versions and distribution and shows
# upgrade options within the specific distribution of the selected
# package

# Copyright (C) 2001 Christoph Martin

# Author: Christoph Martin <martin@uni-mainz.de>
# Maintainer: Christoph Martin <martin@uni-mainz.de>
# Version: 0.02

# This file 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, or (at your option) any
# later version.

# This file 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 file; see the file COPYING.  If not, write to the Free
# Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

use strict;
use Getopt::Long;

my $VERSION ='0.02';

# process commandline parameters
my %opts;
unless (GetOptions (\%opts,
		    'status-file|stf=s',
		    'list-dir|ld=s',
		    'package|p=s',
		    'regex|r',
		    'allversions|a',
		    'upgradeable|u',
		    'brief|b',
		    'verbose|v',
		    'help|h')) {
    exit 1;
}

if (exists $opts{'help'}) {
    print <<EOF;
Apt-Show-Versions v.$VERSION (c) Christoph Martin

Usage:
 apt-show-versions	   shows available versions of installed packages.

Options:
 -stf|--status-file=<file>  Use <file> as the dpkg status file instead
                            of /var/lib/dpkg/status
 -ld|list-dir=<directory>   Use <directory> as path to apt's list files instead
                            of /var/state/apt/lists/ or /var/lib/apt/lists/
 -p|--package=<package>     Print versions for <package>.
 -r|--regex                 Read package with -p as regex
 -u|--upgradeable           Print only upgradeable packages
 -a|--allversions           Print all available versions.
 -b|--brief                 Short output.
 -v|--verbose               Verbose messages.
 -h|--help                  Print this help.
EOF
# ' (make emacs perl-mode happy)
    exit;
}

# Path to apt's list files
my $list_dir;
if ($opts{'list-dir'}) {
	$list_dir = $opts{'list-dir'};
}
# New APT 5.0 path
elsif (-d "/var/lib/apt/lists/") {
	$list_dir = "/var/lib/apt/lists/";
}
# Old APT path
elsif (-d "/var/state/apt/lists/") {
	$list_dir = "/var/state/apt/lists/";
}
else {die "Can't find a valid lists directory\n"}

# Path to dpkg status file
my $status_file = $opts{'status-file'} || "/var/lib/dpkg/status";

opendir(DIR, $list_dir) or die "Can't opendir $list_dir: $!";
my @files = map { $list_dir . $_} grep /Packages$/, readdir(DIR);
unless (scalar @files > 0) {die "Error: No information about packages! (Maybe no deb entries?)\n"};
closedir DIR ;

# Get hash with all installed packages
my $ipackages = parse_file ($status_file, 1);

my $apackages;
my %releases = ();

# 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
	    next;
    $archiv =~ s/Archive: //;
    $archiv =~ s/Suite: //;
    $archiv =~ s/\n//;
    $releases{$archiv} = 1;
    
    my $href = &parse_file ($_);
    foreach (keys %$href) {
	# 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
	    cmp_version($href->{$_}->{'Version'},
			$apackages->{$_}{$archiv}->{'Version'})) {
	    next;
	}
	# add package info together with release to hash
	$apackages->{$_}{$archiv} = $href->{$_};
    }
}

# print info for selected package
if (exists $opts{'package'} &&
    !exists $opts{'regex'} ) {
    my $key = $opts{'package'};

    print_package ($key);
    exit;
}

# print info for all packages or packages matching regex
foreach my $key (keys %$ipackages) {
    next if (exists $opts{'package'} &&
	     exists $opts{'regex'} &&
	     !($key =~ m/$opts{'package'}/));
    print_package ($key);
}

# print uptodate or upgradeable status of package depending on
# distribution and return 1 if we had to say anything

sub print_version {
    my ($archiv, $package, $iversion, $aversion) = @_;

    if ((defined $aversion) and cmp_version($iversion, $aversion)) {
	print "$package/$archiv"
	    . (!defined($opts{'brief'})
	       ? " upgradeable from $iversion to $aversion\n"
	       : "\n");
	return 1;
    } elsif ((defined $aversion) and ($iversion eq $aversion)) {
	print "$package/$archiv"
	    . (!defined($opts{'brief'})
	       ? " uptodate $iversion\n"
	       : "\n")
	    unless (defined $opts{'upgradeable'});
	return 1;
    } else {
#	print "DEBUG: $package/$archiv $aversion:$iversion\n";
	return 0;
    }
}

# print information about package


sub print_package {
    my ($package) = @_;
    # 
    my @all_releases = ("stable", "proposed-updates", "testing", "unstable");
    my @releases = ();
    # Only report on release we found 
    foreach (@all_releases) {
	if (exists $releases{$_}) {
	    push @releases, $_;
	}
    }

    # print more information if required
    if ($opts{'allversions'}) {
	if ($ipackages->{$package}->{'Package'}) {
	    print $ipackages->{$package}->{'Package'}, "\t";
	    unless ($ipackages->{$package}->{'Status'} =~ /not-installed/ ||
		$ipackages->{$package}->{'Status'} =~ /config-files/) {
		print "$ipackages->{$package}->{'Version'}\t";
	    }
	    print "$ipackages->{$package}->{'Status'}\n";
	} else {
	    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";
	    }
	}
    }

    my $iversion = $ipackages->{$package}->{'Version'};

    # print info about upgrade status (only if package is installed)

    if ($ipackages->{$package}->{'Version'}) {
	my $found = 0;
	foreach (@releases) {
	    my $version = $apackages->{$package}{$_}->{'Version'};
	    $found = print_version($_, $package, $iversion, $version);
	    last if $found;
	}
	unless ($found || (defined $opts{'upgradeable'})) {
	    print "$package: No available version\n";
	}
    }
    
#    my $sversion = $apackages->{$package}{"stable"}->{'Version'};
#    my $tversion = $apackages->{$package}{"testing"}->{'Version'};
#    my $uversion = $apackages->{$package}{"unstable"}->{'Version'};

    # print info about upgrade status (only if package is installed)
#    if ($ipackages->{$package}->{'Version'}) {
#	print_version("stable", $package, $iversion, $sversion) ||
#	    print_version("testing", $package, $iversion, $tversion) ||
#		print_version("unstable", $package, $iversion, $uversion) ||
#		    (defined $opts{'upgradeable'}) ||
#			print "$package: No available version\n";
#    }
}

#-------------------------------------------------------
# FUNCTION: cmp_version (STRING, STRING)
#
# Compares complete version numbers ala epoch:upstream-debian
# and returns true if the first version string is greater
# than the second.
#--------------------------------------------------------

sub max {
    my ($first, $second) = @_;

    return $first < $second ? $second: $first;
}

# compare nondigits lexical according to debian policy: letters before
# nonletters

sub cmp_lexical {
    my ($first, $second) = @_;

    return 0 if ($first eq $second);

    for (my $i = 0; $i < max (length($first), length($second)); $i++) {
	return -1 if ($i == length($first));
	return 1 if ($i == length($second));
	
	my $f = substr($first, $i, 1);
	my $l = substr($second, $i, 1);
	next if ($f eq $l);
	if ($f =~ /[A-Za-z]/) {
	    if ($l =~ /[A-Za-z]/) {
#		print "fala";
		return $first cmp $second;
	    } elsif ($l eq "") {
#		print "falo";
		return 1;
	    } else {
#		print "faln";
		return -1;
	    }
	} elsif ($f eq "") {
#	    print "f0lx";
	    return -1;
	} else {
	    if ($l =~ /[A-Za-z]/) {
#		print "fnla";
		return 1;
	    } else {
#		print "fnln";
		return $first cmp $second;
	    }
	}
    }
    print "We should never come here!\n";
    return $first cmp $second;
}

# recursive function to compare upstream or debian version part

sub compare {
    my ($first, $second) = @_;

    # equal if both are empty
    return (0) unless ($first ne "" || $second ne "");

    # parse next version string part and set numerical part to 0 if empty
    my ($nondig1, $dig1, $remainder1) = ($first =~ /^(\D*)?(\d*)(.*)?/);
    $dig1 = 0 unless ($dig1 ne "");
    my ($nondig2, $dig2, $remainder2) = ($second =~ /^(\D*)?(\d*)(.*)?/);
    $dig2 = 0 unless ($dig2 ne "");

    return (cmp_lexical ($nondig1, $nondig2)) unless ($nondig1 eq $nondig2);
    return ($dig1 <=> $dig2) unless ($dig1 == $dig2);
    return compare($remainder1, $remainder2);
}

sub cmp_version {
    my ($first, $second) = @_;

    # parse version number in epoch:upstream-debian and set to 0 if empty
    my ($first_epoch,
	$first_upstream,
	$first_debian) = ($first =~ /^(.*:)?(.*?)(-.*)?$/);
    $first_epoch = "0:" unless defined $first_epoch;
    $first_debian = "-0" unless defined $first_debian;
    $first_epoch =~ s/:$//;
    $first_debian =~ s/^-//;

    my ($second_epoch,
	$second_upstream,
	$second_debian) = ($second =~ /^(.*:)?(.*?)(-.*)?$/);
    $second_epoch = "0:" unless defined $second_epoch;
    $second_debian = "-0" unless defined $second_debian;
    $second_epoch =~ s/:$//;
    $second_debian =~ s/^-//;

    my $ret;
    if ($first_epoch == $second_epoch) {
	$ret = compare($first_upstream, $second_upstream);
	if ($ret == 0) {
	    $ret = compare($first_debian, $second_debian);
	}
    } else {
	$ret = ($first_epoch <=> $second_epoch);
    }

    # give the same return codes like 'dpkg --compare-versions .. ge ..'
    if ($ret == -1) {
	$ret = 256;
    } elsif ($ret == 1) {
	$ret = 0;
    }

    return $ret;

    # this will never be reached, but should give the same
    # result as $ret
    
    my $ret2 = system("dpkg --compare-versions $first ge $second");
    print "** $ret <> $ret2 ** \n" unless $ret == $ret2;
    return $ret2;
}

# ------------------------------------------------------
# FUNCTION: HASHREF = 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.
# ------------------------------------------------------

sub parse_file {
	my ($file, $status) = @_;
	my ($key, $value, $package, $packages);

	open FILE, $file or die "Can't open file $file: $!";
	if ($opts{'verbose'}) {print "Parsing $file...";};
	while (<FILE>) {
		if (/^$/){
			unless (defined $package) {next};

			if ($status) { # Are we parsing the status file?
			        # if we did not specify a package or pattern
			        # only include installed packages
				unless ((!exists $opts{'package'} &&
					 ($package->{'Status'} =~ /not-installed/ ||
					  $package->{'Status'} =~ /config-files/))) {
					$packages->{ $package->{'Package'}} = $package;
				}
			}
			else {
				$packages->{$package->{'Package'}} = $package;
			}
			undef $package;
			next;
		}
		unless ((/^Package/) || (/^Version/) || (/^Status/) || (/^Source/)) {next};
		($key, $value) = split /: /, $_;
		$value =~ s/\n//;
		$value =~ s/\s\(.*\)$//; # Remove any Version information in ()
		$package->{$key} = $value;
	}
	if ($opts{'verbose'}) {print " completed.\n"};
	close FILE;
	return $packages;
}

# script documentation (POD style)

=head1 NAME

apt-show-versions - Lists available package versions with distribution

=head1 DESCRIPTION

apt-show-versions parses the dpkg status file and the APT lists for
the installed and available package versions and distribution and
shows upgrade options within the specific distribution of the selected
package.

This is really useful if you have a mixed stable/testing environment
and want to list all packages which are from testing and can be
upgraded in testing.

=head1 SYNOPSIS

B<apt-show-versions> [B<-h>] [B<-p> I<package name>] [B<-a>] [B<-b>]

=head1 OPTIONS

If you don't give any options the status of all installed packages is
printed.

=over 4

=item B<-p> I<package>, B<--package>=I<package>

Print available and installed versions for specified I<package>. If
B<-p> is not specified, all installed packages are displayed.

=item B<-r>, B<--regex>

interpret I<package> from option B<-p> as a regex.

=item B<-u>, B<--upgradeable>

Print only upgradeable packages

=item B<-a>, B<--allversions>

Print all available versions of the selected packages

=item B<-b>, B<--brief>

Print only package_name/distribution for upgradeable packges

=item B<-v>, B<--verbose>

Prints out verbose messages.

=item B<-stf> I<file>, B<--status-file>=I<file>

Use I<file> as the dpkg status file instead of /var/lib/dpkg/status

=item B<-ld> I<directory>, B<--list-dir>=I<directory>

Use I<directory> as path to apt's list files instead of
/var/state/apt/lists/ or /var/lib/apt/lists/

=item B<-h>, B<--help>

Prints out command-line help.

=head1 EXAMPLES

If you want to know for all your installed packages wether they are
uptodate or upgradeable, use:

    apt-show-versions

If you want to have a list of all upgradeable packages:

    apt-show-versions -u

To get a list of all available versions of libc6:

    apt-show-versions -a -p libc6

To upgrade all packages in testing:

    apt-get install `apt-show-versions -u -b | fgrep testing`

=head1 AUTHOR

Christoph Martin, martin@uni-mainz.de

=head1 SEE ALSO

apt(1), dpkg(1)

=cut
