tracked-packages

[Roderick Schertler <roderick@argon.org>]

Here is a Perl script I use to know what newer versions of the packages
I'm tracking from unstable are available.  It takes as arguments the
names of the Packages files from the newer distribution (or it reads
stdin for the data).  It isn't much, but it came up on #perl and Ben
asked me to send a copy to the list.

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

# $Id: tracked-packages,v 1.8 1998-09-23 23:06:49-04 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 FileHandle		  ();
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 versioncmp_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 versioncmp {
    my ($v1, $v2) = @_;

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

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

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

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

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

    @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:";

    STATUS->input_record_separator('');
    AVAIL->input_record_separator('');

    # Load %have with installed packages.
    while (<STATUS>) {
	if (/^Status:.*\sinstalled\b/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 versioncmp($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;
	}
	PACKAGES->input_record_separator('');
	while (<PACKAGES>) {
	    ($pkg, $version) = parse $_;
	    if (exists $tracking{$pkg}) {
    	    	my $cmp = versioncmp($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;

-- 
Roderick Schertler
roderick@argon.org