#!/usr/bin/perl -w
# Slackware "up2date" hint maker
# Written by Filip Rembialkowski <mailto:plk.zuber@gmail.com>
# This code is placed by the author in public domain

use strict;
use Getopt::Std;
my %opt;
getopts('eh', \%opt);

my @places = (
	'/home/ftp/slackware-current',
	'/home/ftp/pub/slackware-current',
	'/mnt/mirror/slackware-current',
	'/current/slackware-current'
	);
my $CURRENT = '/dev/null';

my %newpack;

sub integer ($) {
	my $i = shift;
	my $len = length $i;
	my $dcount = () = $i =~ /[0-9]/g;
	return ( $len == $dcount ? 1 : 0 );
}

sub newer ($$) { # compare two dot-separated version strings. 
	my($version1,$version2)=@_;
	my $result=0;
	my @version1 = split /\./, $version1;
	my @version2 = split /\./, $version2;
	my $version1len = @version1;
	my $version2len = @version2;
	$version1len == $version2len 
	or warn "# version numbers inconsistent: $version1 $version2\n" 
		and return 1;
	for(my $i=0; $i < $version1len; $i++) {
		my($s1,$s2) = ($version1[$i],$version2[$i]);
		if ( integer($s1) and integer($s2) ) {
			$s1 < $s2 and last;
			$s1 > $s2 and return 1;
		}
		elsif ( integer($s1) or integer($s2) ) {
			warn "# version numbers inconsistent: $version1 $version2\n"; 
			return 1;
		}
		else { # version segments not integer - compare stringwise
			$s1 lt $s2 and last;
			$s1 gt $s2 and return 1;
		}
	}
	$result;
}

sub pkgver { # get package basename without extension,
             # eg. mt-st-0.7-i386-1
	my @segs = split /-/, $_[0]; # split by dashes
	my $len = @segs; # nr of name segments
	warn "#pkgver: short package name($len segs): $_[0]\n" if $len < 4;
	return (0,0,0) if $len < 3 ;
	my($version,$arch,$release) = splice @segs, -3;
	my $name = join('-',@segs);
	my @versegs = split /[._]/, $version;
	my $verlen = @versegs;
#	my $nv = int($release) 
#		+ 1000 * pop(@versegs) 
#		+ 1000000 * pop(@versegs)
#		+ 1000000000 * pop(@versegs);
#	# does not work, they're not numeric
	return ($name,$version,$release);
}


if ( $opt{h} ) {
	print "Usage: slup [ -e | -h ]\n";
	print " -h => This text\n";
	print " -e => try to handle those .new files in /etc\n";
	exit 0;  
}
elsif ( $opt{'e'} ) {
	foreach (`find /etc -type f -name "*.new"`) {
		next unless /^(.*)\.new$/;
		print "#diff -u $1 $1.new | view -\n";
		print " cp $1.new $1\n";
		print " rm $1.new\n";
	}
}
else {

	foreach(@places) {
	 -d $_ and $CURRENT=$_ and last;
	}
	
	for(<$CURRENT/slackware/*/*.tgz>) {
	        my ($basename) = /([^\/]+)\.tgz$/;
	        $newpack{$basename} = $_;
	}
	
	for(<$CURRENT/extra/*/*.tgz>) { # should be optional
	        my ($basename) = /([^\/]+)\.tgz$/;
	        $newpack{$basename} ||= $_;
	}
	
	my $cnt = values %newpack;
	warn "$0: Scanning $cnt packages in $CURRENT\n";
	
	chdir "/var/log/packages"
		or die "$0: Cannot access /var/log/packages, stopping\n";
	
	for my $oldp (<*>) {
		my ($oldname,$oldversion,$oldrelease) = &pkgver($oldp);
		for my $newp (sort keys %newpack) {
			my ($newname,$newversion,$newrelease) = &pkgver($newp);
			next unless $oldname eq $newname;
			next unless newer($newversion,$oldversion)
				or ($newversion eq $oldversion and newer($newrelease,$oldrelease));
			#print "# $oldp --> $newversion\n";
			print "upgradepkg $newpack{$newp} # -$oldp\n";
	        }
	}

}