#!/usr/bin/perl -w

# Copyright (C) 2007 Bart Martens <bartm@knars.be>
#
# 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; version 2 of the License.
#
# 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, see <http://www.gnu.org/licenses/>.
# On Debian systems, the complete text of the GNU General Public
# License version 2 can be found in `/usr/share/common-licenses/GPL-2'.

use strict;

# behaves slightly different on gluck.debian.org
use Sys::Hostname;
my $gluck = '';
$gluck = '1' if( hostname eq "gluck" );

# read command line options
use Getopt::Long;
my $packre = '';
my $maintre = '';
my $installed = '';
my $all = '';
my $nocache = '';
my $cacheonly = '';
my $forget = '';
my $export = '';
my $try = '';
my $loadcpan = '';
my $loadsf = '';
my $debug = '';
GetOptions
(
	"packre=s"  => \$packre,
	"maintre=s"  => \$maintre,
	"installed" => \$installed,
	"all" => \$all,
	"nocache"  => \$nocache,
	"cacheonly"  => \$cacheonly,
	"forget" => \$forget,
	"export" => \$export,
	"try=s"  => \$try,
	"loadcpan" => \$loadcpan,
	"loadsf" => \$loadsf,
	"debug" => \$debug,
) or die;
$export = 1 if( $try );
$nocache = 1 if( $try );
$nocache = 1 if( $export );

# create user configuration directory
my $usrcfgdir = glob( "~/.watchupstream" );
mkdir $usrcfgdir if( ! -d $usrcfgdir );

# lock the lockfile
use Fcntl qw(:flock);
open LOCK, ">$usrcfgdir/lockfile" or die;
flock LOCK, LOCK_EX or die;

# tie hash for state variables
use Fcntl;
use NDBM_File;
my %statevar;
tie( %statevar, 'NDBM_File', "$usrcfgdir/statevar", O_RDWR|O_CREAT, 0644 ) or die;

# tie hashes for debian repository information
my %version;
my %maintainer;
my %difffile;
my %bin2src;
tie( %version, 'NDBM_File', "$usrcfgdir/version", O_RDWR|O_CREAT, 0644 ) or die;
tie( %maintainer, 'NDBM_File', "$usrcfgdir/maintainer", O_RDWR|O_CREAT, 0644 ) or die;
tie( %difffile, 'NDBM_File', "$usrcfgdir/difffile", O_RDWR|O_CREAT, 0644 ) or die;
tie( %bin2src, 'NDBM_File', "$usrcfgdir/bin2src", O_RDWR|O_CREAT, 0644 ) or die;

# subroutine to make time limits a bit less strict
sub more_or_less
{
	my $duration = shift;
	return $duration + int(rand($duration/5)) - $duration/10;
}

# load debian repository information
my $oneday = 60 * 60 * 24;
$statevar{'lastrepoload'} = 0 if( ! defined( $statevar{'lastrepoload'} ) );
if( $statevar{'lastrepoload'} + more_or_less($oneday) < time )
{
	if( $gluck )
	{
		open INPUT, "zcat /home/org/ftp.root/debian/dists/sid/*/source/Sources.gz|" or die;
	}
	else
	{
		open INPUT, "cat /var/lib/apt/lists/*_debian_dists_unstable_*_source_Sources|" or die;
	}

	%version = ();
	%maintainer = ();
	%difffile = ();
	%bin2src = ();

	my %field;

	while(<INPUT>)
	{
		chomp;

		%field = () if( /^Package:/ );
		$field{$1} = $2 if( /^(\S+): (.*)$/ );
		$field{$2} = $1 if( /^ \S{32} \d+ (\S+\.(dsc|orig\.tar\.gz|diff\.gz))$/ );

		if( /^$/ )
		{
			$version{$field{'Package'}} = $field{'Version'};
			$maintainer{$field{'Package'}} = $field{'Maintainer'};
			$difffile{$field{'Package'}} = "$field{'Directory'}/$field{'diff.gz'}"
				if( defined( $field{'diff.gz'} ) );

			my $binary = ", " . $field{'Binary'} . ", ";
			while( $binary =~ s/, (\S+), /, / )
			{
				$bin2src{$1} = $field{'Package'};
			}

			%field = ();
		}
	}

	close INPUT;

	$statevar{'lastrepoload'} = time;
}

# literals
my $seppat = '[\-_]';
my $versionpat     = 'v?[\d\.]+(?:rc|rc\d+|pre-rc\d+|-unix|-source|-src|\.src|\.orig|[a-z]|b\d+|beta\d+-src|beta\d+)?';
my $cpanversionpat = 'v?[\d\._]+(?:a|b|b\d+|RC\d+)?';
my $fileexts = 'tar\.gz|tgz|tar\.bz2|zip|pm\.gz|jar|shar\.gz|shar\.Z';
my $watchfiletmp = "$usrcfgdir/watchfile.watch";
my $uversionmangle = 'opts="uversionmangle='
	. 's/(\d)[\-_]?(rc\d+|pre-rc\d+|pre\d+a?)$/$1~$2/;'
	. 's/[\-\.](source|src|orig|unix)$//;'
	. 's/^(\d{8})/0.0.$1/;'
	. 's/-(bin|osx)$/~$1/;'
	. 's/^v(\d)/$1/;'
	. '"';
my $cpanversionmangle = 'opts="uversionmangle=' . 's/^v(\d)/$1/;s/^\.(\d)/0.$1/' . '"';

# tie hashes for cpan information
my %cpanname;
my %cpandir;
tie( %cpanname, 'NDBM_File', "$usrcfgdir/cpanname", O_RDWR|O_CREAT, 0644 ) or die;
tie( %cpandir, 'NDBM_File', "$usrcfgdir/cpandir", O_RDWR|O_CREAT, 0644 ) or die;

# load cpan information
my $oneweek = $oneday * 7;
$statevar{'lastcpanload'} = 0 if( ! defined( $statevar{'lastcpanload'} ) );
if( $loadcpan or $statevar{'lastcpanload'} + more_or_less($oneweek) < time )
{
	%cpanname = ();
	%cpandir = ();
	my %cpanversion = ();

	open INPUT, "wget -q -O - http://cpan.org/modules/02packages.details.txt.gz | zcat |" or die;
	while(<INPUT>)
	{
		chomp;

		next if( /^$/ );
		next if( /^[^ :]+: +\S/ );

		s/^(?:[^ ]+) +(?:[^ ]+) +([^ ]+)$/$1/ or next; #die "$_";
		/^(.+)\/([^\/]+)$/ or die "$_";
		my $cpandir = $1;
		my $cpanfile = $2;

		$cpanfile =~ /^([a-zA-Z\-]+)(-)($cpanversionpat)\.($fileexts)$/ or
		$cpanfile =~ /^([a-zA-Z\-\d]+)(-)($cpanversionpat)\.($fileexts)$/ or
		$cpanfile =~ /^([a-zA-Z\-_]+)(\.pm-)($cpanversionpat)\.($fileexts)$/ or
			next;

		my $cpanname = $1;
		my $separator = $2;
		my $cpanversion = $3;

		my $package = 'lib' . lc( $cpanname ) . '-perl';
		$package =~ s/_/-/;
		$package =~ s/(-perl)-perl$/$1/;

		next if( defined( $cpanversion{$package} )
			and $cpanversion{$package} gt $cpanversion );

		$cpanname{$package} = $cpanname . $separator;
		$cpandir{$package} = $cpandir;
		$cpanversion{$package} = $cpanversion;
	}
	close INPUT;

	$statevar{'lastcpanload'} = time;
}

# tie hashes for sourceforge information
my %sfproject;
tie( %sfproject, 'NDBM_File', "$usrcfgdir/sfproject", O_RDWR|O_CREAT, 0644 ) or die;

# load sourceforge information
$statevar{'lastsfload'} = 0 if( ! defined( $statevar{'lastsfload'} ) );
if( $loadsf or $statevar{'lastsfload'} + more_or_less(4*$oneweek) < time )
{
	%sfproject = ();

	if( $gluck and -f "/home/bartm/src/listsfprojects/sfprojects.txt" )
	{
		open INPUT, "</home/bartm/src/listsfprojects/sfprojects.txt" or die;
		while(<INPUT>)
		{
			chomp;
			$sfproject{$_} = $_;
		}
		close INPUT;
	}

	for( my $offset = 0; $offset < 500; $offset += 50 ) # 70533
	{
		my $count = 0;

		open INPUT, "wget -q -O - 'http://sourceforge.net/top/topalltime.php?type=downloads&offset=$offset'|" or die;
		while(<INPUT>)
		{
			chomp;
	
			/<td><a href="\/projects\/([^\/]+)\/">([^><]+)<\/a>.*<\/td>/ or next;
			$sfproject{$1} = 1;

			$count++;
		}
		close INPUT;

		last if( $count == 0 );
	}

	$statevar{'lastsfload'} = time;
}

# tie hashes for savannah information
my %savannah;
tie( %savannah, 'NDBM_File', "$usrcfgdir/savannah", O_RDWR|O_CREAT, 0644 ) or die;

# load savannah information
$statevar{'lastsavannahload'} = 0 if( ! defined( $statevar{'lastsavannahload'} ) );
if( $statevar{'lastsavannahload'} + more_or_less($oneweek) < time )
{
	%savannah = ();

	open INPUT, "wget -q -O - http://download.savannah.gnu.org/releases/|" or die;
	while(<INPUT>)
	{
		chomp;
		next if( ! /DIR/ );
		next if( ! /href="([^"\/]+)\/">/ );
		$savannah{$1} = 1;
	}
	close INPUT;

	$statevar{'lastsavannahload'} = time;
}

# tie hashes for gnu information
my %gnu;
tie( %gnu, 'NDBM_File', "$usrcfgdir/gnu", O_RDWR|O_CREAT, 0644 ) or die;

# load gnu information
$statevar{'lastgnuload'} = 0 if( ! defined( $statevar{'lastgnuload'} ) );
if( $statevar{'lastgnuload'} + more_or_less($oneweek) < time )
{
	my $gnulist = '';
	open INPUT, "wget -q -O - http://directory.fsf.org/GNU/|" or die;
	while(<INPUT>)
	{
		$gnulist .= $_;
	}
	close INPUT;
	%gnu = ();
	while( $gnulist =~ s/<a href="([^"]+)\.html">[^<]+<\/a>// )
	{
		$gnu{$1} = 1;
	}

	$statevar{'lastgnuload'} = time;
}

# tie hashes for gnome information
my %gnomename;
tie( %gnomename, 'NDBM_File', "$usrcfgdir/gnomename", O_RDWR|O_CREAT, 0644 ) or die;

# load gnome information
$statevar{'lastgnomeload'} = 0 if( ! defined( $statevar{'lastgnomeload'} ) );
if( $statevar{'lastgnomeload'} + more_or_less($oneweek) < time )
{
	my $gnomelist = '';
	open INPUT, "wget -q -O - http://ftp.gnome.org/pub/GNOME/sources/|" or die;
	while(<INPUT>)
	{
		$gnomelist .= $_;
	}
	close INPUT;
	%gnomename = ();
	while( $gnomelist =~ s/<a href="([^"]+)\/">[^<]+\/<\/a>// )
	{
		$gnomename{lc($1)} = $1;
	}

	$statevar{'lastgnomeload'} = time;
}

# tie hashes for kde information
my %kde;
tie( %kde, 'NDBM_File', "$usrcfgdir/kde", O_RDWR|O_CREAT, 0644 ) or die;

# load kde information
$statevar{'lastkdeload'} = 0 if( ! defined( $statevar{'lastkdeload'} ) );
if( $statevar{'lastkdeload'} + more_or_less($oneweek) < time )
{
	%kde = ();
	my $kdelist = '';
	open INPUT, "wget -q -O - ftp://download.kde.org/pub/kde/stable/latest/src/|" or die;
	while(<INPUT>)
	{
		chomp;
		next if( ! /pub\/kde\/stable\/latest\/src\/([^\d\-"]+)-\d/ );
		$kde{$1} .= 1;
	}
	close INPUT;

	$statevar{'lastkdeload'} = time;
}

# subroutine to create a watch file for a known downloadpage
sub create_downloadpage_watchfile
{
	my $package = shift;
	my $downloadpage = shift;
	my $filename = shift;
	my $separator = shift;

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$uversionmangle \\\n";
	print OUTPUT "$downloadpage .*$filename$separator($versionpat)\\.t.*\n";
	close OUTPUT;
}

# subroutine to create a watch file for a known downloaddir
sub create_downloaddir_watchfile
{
	my $package = shift;
	my $downloaddir = shift;
	my $filename = shift;

	print STDERR "create_downloaddir_watchfile: $package $downloaddir $filename\n" if( $debug );

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$uversionmangle \\\n";
	print OUTPUT "$downloaddir/$filename$seppat($versionpat)\\.(?:$fileexts)\n";
	close OUTPUT;
}

# subroutine to create a watch file for cpan
sub create_cpan_watchfile_by_module
{
	my $package = shift;

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$cpanversionmangle \\\n";
	my $cpandir = $cpanname{$package};
	$cpandir =~ s/-.*//;
	my $downloaddir = "http://cpan.org/modules/by-module/$cpandir/";
	print OUTPUT $downloaddir;
	print OUTPUT "$cpanname{$package}($cpanversionpat)\.(?:$fileexts)\n";
	close OUTPUT;
}
sub create_cpan_watchfile_by_author
{
	my $package = shift;

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$cpanversionmangle \\\n";
	my $downloaddir = "http://www.cpan.org/authors/id/" . $cpandir{$package} . '/';
	print OUTPUT $downloaddir;
	print OUTPUT "$cpanname{$package}($cpanversionpat)\.(?:$fileexts)\n";
	close OUTPUT;
}

# subroutine to create a watch file for gnome
sub create_gnome_watchfile
{
	my $package = shift;

	my $downloaddir = 'http://ftp.gnome.org/pub/GNOME/sources/'.$gnomename{$package}.'/(?:[\d\.]+)/';

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$uversionmangle \\\n";
	print OUTPUT "$downloaddir/$gnomename{$package}-(\\d.*)\\.t.*\n";
	close OUTPUT;
}

# subroutine to create a watch file for sourcefourge (sf)
sub create_sf_watchfile
{
	my $package = shift;
	my $sfproject = shift;
	my $filename = shift;

	open OUTPUT, ">$watchfiletmp" or die;
	print OUTPUT "version=3\n";
	print OUTPUT "$uversionmangle \\\n";
	print OUTPUT "http://sf.net/$sfproject/$filename$seppat($versionpat)\\.(?:$fileexts)\n";
	close OUTPUT;
}

# tie hashes for the results
my %resulttime;
my %resultlocal;
my %resultnewest;
my %resultuscan;
tie( %resulttime, 'NDBM_File', "$usrcfgdir/resulttime", O_RDWR|O_CREAT, 0644 ) or die;
tie( %resultlocal, 'NDBM_File', "$usrcfgdir/resultlocal", O_RDWR|O_CREAT, 0644 ) or die;
tie( %resultnewest, 'NDBM_File', "$usrcfgdir/resultnewest", O_RDWR|O_CREAT, 0644 ) or die;
tie( %resultuscan, 'NDBM_File', "$usrcfgdir/resultuscan", O_RDWR|O_CREAT, 0644 ) or die;

# subroutine to derive the source package name from the binary-or-source package name
sub derive_source_package_name
{
	my $pkg = shift;
	my $package;

	$package = $bin2src{$pkg} if( defined( $bin2src{$pkg} ) );
	$package = $pkg if( defined( $version{$pkg} ) );

	return $package;
}

# subroutine to show the result
sub show_result
{
	my $package = shift;
	print "$resulttime{$package} $package"
		. " $resultlocal{$package} $resultnewest{$package} $resultuscan{$package}\n";
}

# subroutine to evaluate a watch file
my $resultuscan;
my $resultnewest;
sub evaluate_watchfile
{
	my $package = shift;
	my $version = shift;

	print STDERR "evaluate_watchfile: $package $version\n" if( $debug );

	$resultuscan = "unknown";
	$resultnewest = 0;

	open INPUT, "uscan"
		. " --timeout 60"
		. " --report-status"
		. " --package $package"
		. " --upstream-version $version"
		. " --watchfile $watchfiletmp"
		. " 2>&1 |" or die;

	while(<INPUT>)
	{
		chomp;
		print STDERR "evaluate_watchfile uscan: $_\n" if( $debug );
		$resultuscan = 'ahead' if( /remote site does not even have current version/ );
		$resultuscan = 'OK' if( /Package is up to date/ );
		$resultuscan = 'outdated' if( /Newer version .*available on remote site/ );
		$resultnewest = $1 if( /Newest version on remote site is (\S+), local version is/ );
	}
	close INPUT;
}

# extract the watch file from the diff file
my $difffiletmp = "$usrcfgdir/difffile.diff.gz";
sub extract_watchfile_from_difffile
{
	my $package = shift;

	unlink "$difffiletmp";
	if( $gluck )
	{
		`cp /home/org/ftp.root/debian/$difffile{$package} $difffiletmp`;
	}
	else
	{
		`wget -q -O $difffiletmp 'http://ftp.debian.org/debian/$difffile{$package}'`;
	}
	unlink $watchfiletmp;
	`touch $watchfiletmp`;
	`filterdiff -z -i '*/debian/*watch' $difffiletmp | patch $watchfiletmp`
		if( ! -z $difffiletmp );
	unlink "$watchfiletmp.orig";
	unlink "$watchfiletmp.rej";
	unlink "$difffiletmp";

	# try to add uversionmangle
	open INPUT, "<$watchfiletmp" or die;
	open OUTPUT, ">$watchfiletmp.NEW" or die;
	my $splitline = 0;
	my $added = 0;
	while(<INPUT>)
	{
		chomp;
		if( $splitline )
		{
			print OUTPUT "$_\n";
			$splitline = 0;
			$splitline = 1 if( /\\\s*$/ );
		}
		elsif( /^version=[23]$/ )
		{
			print OUTPUT "version=3\n";
		}
		elsif( /^\s*#/ || /^\s*$/ )
		{
			print OUTPUT "$_\n";
		}
		elsif( ! $added and /^(http|ftp):\/\/\S+/ )
		{
			print OUTPUT "$uversionmangle \\\n";
			print OUTPUT "$_\n";
			$added = 1;
			$splitline = 1 if( /\\\s*$/ );
		}
		else
		{
			close INPUT;
			close OUTPUT;
			unlink "$watchfiletmp.NEW";
			return;
		}
	}
	close OUTPUT;
	close INPUT;
	unlink "$watchfiletmp";
	rename "$watchfiletmp.NEW", "$watchfiletmp" or die "rename failed";
}

# subroutine to process one package name
sub process_package
{
	my $package = shift;

	# replace binary package by source package
	$package = derive_source_package_name( $package );
	return if( ! defined( $package ) );

	# derive upstream version
	my $version = $version{$package};
	$version =~ s/-\d+(\.\d+)?$//; # cut off debian revision (also for NMU)
	$version =~ s/^\d+://; # cut off epoch
	$version =~ s/(\.|\+|-|~|)dfsg(\.\d+|\d*)$//;
	$version =~ s/(\d)(\.|)ds\d+$/$1/;
	$version =~ s/(\d)(pre\d+)$/$1~$2/;
	$version =~ s/(\d)-(rc\d+)$/$1~$2/;
	$version =~ s/^(\d{8})/0.0.$1/;
	$version =~ s/(\d)(cdbs)$/$1/;
	$version =~ s/(\+deb|[\.\+]debian\d*|\.0debian\d+|\.alan\d+|\.free|\+pristine)$//;

	# forget cached result
	if( $forget )
	{
		delete $resulttime{$package};
		delete $resultlocal{$package};
		delete $resultnewest{$package};
		delete $resultuscan{$package};
		unlink "$usrcfgdir/watchfiles/$package.watch";
		return;
	}

	# return cached result
	if( defined( $resulttime{$package} ) and defined( $resultlocal{$package} )
	and $resultlocal{$package} eq $version
	and $resulttime{$package} + more_or_less($oneweek) > time
	and ! $nocache )
	{
		show_result "$package";
		return;
	}
	return if( $cacheonly );

	# initialize result
	$resulttime{$package} = time;
	$resultlocal{$package} = $version;
	$resultnewest{$package} = "0";
	$resultuscan{$package} = "unknown";

	# get the watch file and evaluate it
	unlink $watchfiletmp;
	$resultuscan = "unknown";
	$resultnewest = 0;
	if( $try )
	{
		if( $resultuscan eq "unknown"
		and $try =~ '^http://([^\.]+)\.(?:sourceforge|sf)\.net/$' )
		{
			create_sf_watchfile $package, $1, $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and $try =~ '^http://sourceforge.net/projects/([^/]+)/?$' )
		{
			create_sf_watchfile $package, $1, $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and $try =~ ( '^http://downloads.sourceforge.net/([^/]+)/([^/]+)'
			.$seppat.$versionpat.'\.(?:'.$fileexts.')' ) )
		{
			create_sf_watchfile $package, $1, $2;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and $try =~ ( '^((?:http|ftp)://.*/)([^/]+)'.$seppat.$versionpat.'\.(?:'.$fileexts.')' ) )
		{
			create_downloaddir_watchfile $package, $1, $2;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown" )
		{
			create_downloadpage_watchfile $package, $try, $package, '-';
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown" )
		{
			create_downloaddir_watchfile $package, $try, $package;
			evaluate_watchfile $package, $version;
		}
	}
	else
	{
		if( $resultuscan eq "unknown"
		and -f "$usrcfgdir/watchfiles/$package.watch" )
		{
			`cp "$usrcfgdir/watchfiles/$package.watch" $watchfiletmp`;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and -f "$usrcfgdir/watchfiles/$package.watch" )
		{
			unlink "$usrcfgdir/watchfiles/$package.watch";
		}
		if( $resultuscan eq "unknown"
		and defined( $difffile{$package} ) )
		{
			extract_watchfile_from_difffile $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $gnu{$package} ) )
		{
			create_downloadpage_watchfile $package,
				'http://directory.fsf.org/GNU/'.$package.'.html', $package, '-';
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $savannah{$package} ) )
		{
			create_downloaddir_watchfile $package, "http://download.savannah.gnu.org/releases/$package/", $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $kde{$package} ) )
		{
			create_downloaddir_watchfile $package, 'ftp://ftp.kde.org/pub/kde/stable/latest/src', $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $gnomename{$package} ) )
		{
			create_gnome_watchfile $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $cpanname{$package} ) )
		{
			create_cpan_watchfile_by_module $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $cpanname{$package} ) )
		{
			create_cpan_watchfile_by_author $package;
			evaluate_watchfile $package, $version;
		}
		if( $resultuscan eq "unknown"
		and defined( $sfproject{$package} ) )
		{
			create_sf_watchfile $package, $sfproject{$package}, $package;
			evaluate_watchfile $package, $version;
		}
	}

	# mark native packages
	$resultuscan = 'native'
		if( $resultuscan eq "unknown" and ! defined( $difffile{$package} ) );

	# cache the result
	$resultuscan{$package} = $resultuscan;
	$resultnewest{$package} = $resultnewest;

	# show the result
	show_result $package;

	# save working watch files for later reuse
	if( $export and $resultuscan{$package} =~ /^(OK|ahead|outdated)$/ )
	{
		mkdir "$usrcfgdir/watchfiles" if( ! -d "$usrcfgdir/watchfiles" );
		`cp "$watchfiletmp" "$usrcfgdir/watchfiles/$package.watch"`;
	}
	unlink $watchfiletmp;
}

# subroutine to evaluate a binary or source package with regular expressions
sub evaluate_package_with_regexps
{
	my $pkg = shift;
	my $package = derive_source_package_name( $pkg );

	return 0 if( ! defined( $package ) );
	return 0 if( $packre and $pkg !~ /$packre/i and $package !~ /$packre/i );
	return 0 if( $maintre and ! defined( $maintainer{$package} ) );
	return 0 if( $maintre and $maintainer{$package} !~ /$maintre/i );

	return 1;
}

# which packages to process
if( $#ARGV >= 0 )
{
	# package names on command line
	my %selected = ();
	my $package;
	foreach my $pkg ( @ARGV )
	{
		$package = derive_source_package_name( $pkg );
		next if( ! defined( $package ) );
		next if( ! evaluate_package_with_regexps( $pkg ) );
		$selected{$package} = 1;
	}
	foreach my $package ( sort keys %selected )
	{
		process_package "$package";
	}
}
elsif( $packre or $maintre )
{
	# regular expression(s)
	my %selected = ();
	my $package;
	foreach my $pkg ( ( keys %bin2src, keys %version ) )
	{
		$package = derive_source_package_name( $pkg );
		next if( ! defined( $package ) );
		next if( ! evaluate_package_with_regexps( $pkg ) );
		$selected{$package} = 1;
	}
	foreach my $package ( sort keys %selected )
	{
		process_package "$package";
	}
}
elsif( $installed )
{
	# process all installed packages
	open INPUT, "dpkg-query -W --showformat='\${Package}\n'|" or die;
	my %selected = ();
	my $package;
	while(<INPUT>)
	{
		chomp;
		$package = derive_source_package_name( $_ );
		next if( ! defined( $package ) );
		$selected{$package} = 1;
	}
	close INPUT;
	foreach my $package ( sort keys %selected )
	{
		process_package "$package";
	}
}
elsif( $all )
{
	# process all packages
	foreach my $package ( sort keys %version )
	{
		process_package "$package";
	}
}
else
{
	# process package names given at stdin
	while(<>)
	{
		chomp;
		next if( /^\s*$/ ); # blank lines
		s/^\d+\s(\S+)\s\S+\s\S+\s\S+$/$1/; # output used as input
		s/.*\/(.*)\.watch$/$1/; # list of watch files used as input
		my $package = $_;
		process_package "$package";
	}
}

# untie hashes
untie %resulttime;
untie %resultlocal;
untie %resultnewest;
untie %resultuscan;
untie %gnomename;
untie %kde;
untie %gnu;
untie %savannah;
untie %sfproject;
untie %cpanname;
untie %cpandir;
untie %version;
untie %maintainer;
untie %difffile;
untie %bin2src;
untie %statevar;

# unlock the lockfile
flock LOCK, LOCK_UN or die;
close LOCK or die;

