#!/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.09

# 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;
use Storable qw(store retrieve);

my $apackagescachefile="/var/cache/apt-show-versions/apackages";
my $ipackagescachefile="/var/cache/apt-show-versions/ipackages";
my $filescachefile="/var/cache/apt-show-versions/files";

use AptPkg::Config '$_config';
use AptPkg::System '$_system';
use AptPkg::Version;

$_config->init;
$_system = $_config->system;
my $vs = $_system->versioning;

my $VERSION;
$VERSION ='0.09';

# 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',
		    'nohold|nh',
		    'initialize|i',
		    'verbose|v',
		    'help|h')) {
    exit 1;
}
if (scalar @ARGV == 1) {
    $opts{'package'} = $ARGV[0];
} elsif (scalar @ARGV > 1) {
    die "apt-show-versions: too many arguments\n";
}

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.
 -nh|--nohold               Don't treat holded packages.
 -i|--initialize	    Initialize or update package cache only (as root).
 -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'};
}
else {
	$list_dir = $_config->get_dir("Dir::State::lists");
}

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

if (exists $opts{'initialize'}) {
    unlink $apackagescachefile;
    unlink $ipackagescachefile;
    unlink $filescachefile;
}

# Get Packages-files list from cache or create new list and write
# cache if root
if (-e $filescachefile and -M $filescachefile < -M $list_dir) {
    $filesref = retrieve($filescachefile);
    @files = @$filesref unless !ref($filesref);
}
# Test also to be sure $filescachefile is not corrupt and returns a ref to it
if (!-e $filescachefile or -M $list_dir < -M $filescachefile or !ref($filesref)) {
    opendir(DIR, $list_dir) or die "Can't opendir $list_dir: $!";
    @files = map { $list_dir . $_} grep /Packages$/, readdir(DIR);
    ($< == 0) and (store(\@files, $filescachefile) or
		   warn "Can't write $filescachefile");
}
unless (scalar @files > 0) {die "Error: No information about packages! (Maybe no deb entries?)\n"};
closedir DIR ;

# Get hash with all installed packages from cache or create new hash
# and write cache if root
my $ipackages;

if (-e $ipackagescachefile and -M $ipackagescachefile < -M $status_file) {
    $ipackages = retrieve($ipackagescachefile);
}
if (!-e $ipackagescachefile or -M $status_file < -M $ipackagescachefile or !ref($ipackages)) {
    $ipackages = parse_file ($status_file, 1);
    ($< == 0) and (store($ipackages, $ipackagescachefile) or
		   warn "Can't write $ipackagescachefile");
}

# Get available packages list from cache if possible
my $apackages;
my $cache_file_corrupt;
-e $apackagescachefile and $apackages = retrieve($apackagescachefile);
unless (ref($apackages)) {
    $cache_file_corrupt = 1;
    undef $apackages;
}

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;

# 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|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 ($_);
	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'} &&
		    !exists $opts{'regex'} &&
		    $opts{'package'} eq $_ ) {
#		    print "DEBUG: " . $apackages->{$_}{$archiv}->{'Version'} .
#			":" . $href->{$_}->{'Version'} . " next\n";
		}
		next;
	    }
	    # add package info together with release to hash
	    $apackages->{$_}{$archiv} = $href->{$_};
	}
    }
}
# Store if we are root
($< == 0) and (store($apackages, $apackagescachefile) or
	       die "Warning: Can't write to $apackagescachefile!\n");
# Exit if we are root and using the -i option
($< == 0) and (exists $opts{'initialize'}) and exit;

# 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 ($vs->compare($aversion, $iversion) > 0)) {
	print "$package/$archiv"
	    . (!defined($opts{'brief'})
	       ? " upgradeable from $iversion to $aversion\n"
	       : "\n");
	return 1;
    } elsif ((defined $aversion) and ($vs->compare($aversion, $iversion) == 0)) {
	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 @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{$_};
    }

    # 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"
		    if $official_releases{$_};
	    }
	}
    }

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

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

    if (($ipackages->{$package}->{'Version'}) &&
	(!($ipackages->{$package}->{'Status'} =~ /config-files/))) {
	my $found = 0;
	my $aversion = 0;
	foreach (@releases) {
	    my $version = $apackages->{$package}{$_}->{'Version'};
	    if ($version) {
		$found = print_version($_, $package, $iversion, $version);
		$aversion = $version;
	    } 
	    last if $found;
	}
	if ($aversion && ($vs->compare($iversion, $aversion) > 0)) {
	    print "$package $iversion newer than version in archive\n"
		unless defined($opts{'brief'});
	} else {
	    unless ($found || (defined $opts{'upgradeable'})) {
		print "$package $iversion installed: No available version in archive\n";
	    }
	}
    } else {
#	print "$package not installed: No available versions\n";
	print "$package not installed\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: 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/ || 
					  # don't print holded packages if requested
					  ($opts{'nohold'} && $package->{'Status'} =~ /hold/)))) {
				    $packages->{ $package->{'Package'}} = $package;
				}
			}
			else {
				if (!defined $packages->{$package->{'Package'}} or
				    $vs->compare($packages->{$package->{'Package'}}{'Version'},
				                 $package->{'Version'}) < 0) {
				    $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.

apt-show-versions uses caching for the status information of installed
and available packages. If you run apt-show-versions as root the
cache is updated as needed. If you run as non-root uses the newest
available information, but can't update the cache. If you run as root
with the option B<-i> the cache is initialized or updated only.

=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>. You
can also specify a package name without the option B<-p>. If B<-p> and
a package name are missing, 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 packages

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

Prints out verbose messages.

=item B<-i>, B<--initialize>

Initialize or update package cache only (as root). Do this every time
when the status of the installed or available packages has changed.

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

=back

=head1 EXAMPLES

If you want to know for all your installed packages whether 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(8), dpkg(1)

=cut