#!/usr/bin/perl -w
use strict;

# $Id: tracked-packages,v 1.9 2001-03-09 09:02:02-05 roderick Exp $
#
# Roderick Schertler <roderick@argon.org>

# This program checks the Debian available and status files to see what
# packages are installed which are newer than what are available (and
# therefore were manually installed from a newer release) and then it
# reads some given packages files (presumably from the newer release)
# and reports what newer versions of the tracked packages are available.

# Copyright (C) 1998 Roderick Schertler
#
# 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.
#
# For a copy of the GNU General Public License write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use Proc::WaitStat	qw(close_die waitstat);

(my $Me = $0) =~ s-.*/--;

my $Available	= '/var/lib/dpkg/available';
my $Debug	= 0;
my $Exit	= 0;
my $Status	= '/var/lib/dpkg/status';
my $Verbose	= 1;

sub xmess {
    push @_, " $!\n" if $_[$#_] =~ /:$/;
    "$Me: ", @_;
}

sub xwarn {
    warn xmess @_;
    $Exit ||= 1;
}

sub xdie {
    die xmess @_;
}

# It would be good if dpkg-perl provided a version comparison function,
# and if dpkg --compare-versions provided a <=>-like comparison.

sub version_cmp_dpkg {
    my ($v1, $op, $v2) = @_;

    system 'dpkg', '--compare-versions', $v1, $op, $v2;
    return 1 if $? == 0;
    xdie "invalid return from dpkg (", waitstat $?, ") comparing $v1 $op $v2\n"
	if $? != 256;
    return 0;
}

sub version_cmp {
    my ($v1, $v2) = @_;

    # Save a fork/exec/wait for the common case.
    return  0 if $v1 eq $v2;

    return -1 if version_cmp_dpkg $v1, 'lt', $v2;
    return  0 if version_cmp_dpkg $v1, 'eq', $v2;
    return  1;
}

sub parse {
    local $_ = shift;
    my ($pkg, $version);

    chomp;
    /^Package:\s*(\S+)\s*$/im or xdie "no valid package field:\n$_";
    $pkg = $1;
    /^Version:\s*(\S+)\s*$/im or xdie "no valid version field:\n$_";
    $version = $1;
    return $pkg, $version;
}

sub main {
    my (%have, $pkg, $version, %tracking, $file);

    # Read in paragraph mode.
    $/ = '';

    @ARGV or ! -t		or xdie "no packages files specified\n";
    open STATUS, $Status	or xdie "can't read $Status:";
    open AVAIL, $Available	or xdie "can't read $Available:";

    # Load %have with installed packages.
    while (<STATUS>) {
	if (/^Status:.*\sinstalled\s/im) {
	    ($pkg, $version) = parse $_;
	    $have{$pkg} = $version;
	}
    }
    close_die *STATUS, $Status;

    # For packages both installed and in AVAIL, move packages which are
    # newer installed into %tracking.
    while (<AVAIL>) {
	($pkg, $version) = parse $_;
	if (exists $have{$pkg}) {
	    $tracking{$pkg} = $have{$pkg}
		if version_cmp($have{$pkg}, $version) > 0;
	    delete $have{$pkg};
	}
    }
    close_die *AVAIL, $Available;

    # Move packages installed but not in AVAIL to %tracking.
    @tracking{keys %have} = values %have;

    @ARGV = qw(-) unless @ARGV;
    for $file (@ARGV) {
	unless (open PACKAGES, $file) {
	    xwarn "can't read $file:";
	    next;
	}
	while (<PACKAGES>) {
	    ($pkg, $version) = parse $_;
	    if (exists $tracking{$pkg}) {
    	    	my $cmp = version_cmp($tracking{$pkg}, $version);
		printf "%-8s %-20s have %-20s available %s\n",
    	    	    	$cmp < 0 ? 'updated' : $cmp == 0 ? 'current' : 'newer',
			$pkg, $tracking{$pkg}, $version
		    if $Verbose || $cmp;
		delete $tracking{$pkg};
	    }
	}
	close_die *PACKAGES, $file;
    }

    for $pkg (keys %tracking) {
	printf "%-8s %-20s have %-20s available nil\n",
		'gone', $pkg, $tracking{$pkg};
    }

    return 0;
}

$Exit = main || $Exit;
$Exit = 1 if $Exit and not $Exit % 256;
exit $Exit;