#!/usr/bin/perl
use warnings;
use strict;
use feature ":5.10";

###
### Reports applicable patches for installed packages and tries to download the patches to /tmp.
### Author: Thomas Rowe  
### License: public domain
###

# Edit these constants.
use constant {
	HOST => "ftp.cerias.purdue.edu",
	PATH => "/pub/os/slackware/slackware-12.2/patches/packages",
	LOCAL_PATCHES => "/var/tmp",
	DO_UPGRADES => 0 # Whether to try and run upgradepkg.  Otherwise, just try and fetch.
};

use Net::FTP;

sub splitname {
	my $name = shift;
	my @k = qw/name version arch build/;
	my %pieces = map { shift @k => $_ } ($name =~ /^([\w\+-]+)-([^-]+)-([^-]+)-(\d+)_*.*$/);
	
	return %pieces;
}

sub version_cmp {
	my ($a, $b) = @_;
	my @vera = split /\./, $a;
	my @verb = split /\./, $b;
	return 0 if @vera ~~ @verb;

	while (@vera and @verb) {
		my $na = shift @vera;
		my $nb = shift @verb;

		my ($na_digits, $na_other_str, $na_pldigits)  = ($na =~ /^(\d+)(\D*)(\d*)/);
		$na_digits //= 0;
		$na_other_str //= '';
		$na_pldigits //= 0;

		my ($nb_digits, $nb_other_str, $nb_pldigits)  = ($nb =~ /^(\d+)(\D*)(\d*)/);
		$nb_digits //= 0;
		$nb_other_str //= '';
		$nb_pldigits //= 0;

		return $na_digits <=> $nb_digits if ($na_digits != $nb_digits);
		return $na_other_str cmp $nb_other_str if ($na_other_str ne $nb_other_str);
		return $na_pldigits <=> $nb_pldigits if ($na_pldigits ne $nb_pldigits);
	}

	# resort to assuming the longer version string is higher.
	if (@vera) {
		return 1;
	}
	elsif (@verb) {
		return -1;
	}
	else {
		return length $a <=> length $b;
	}

	warn "The version string parser choaked on these strings!: $a % $b";
	return undef;
}

sub is_upgrade {
	my ($a, $b) = @_;
	my %old = splitname $a;
	my %new = splitname $b;

	if ($old{name} && $new{name} && $old{name} eq $new{name}
			and version_cmp($old{version}, $new{version}) == -1
			|| $old{build} < $new{build}
			|| $old{arch} ne $new{arch}) {
		return 1;
	}
	return 0;
}

MAIN: {
	my $ftp = Net::FTP->new(HOST)
		or die "Cannot connect: $@";
	$ftp->login("anonymous",'-anonymous@')
		or die "Cannot login: ", $ftp->message;
	$ftp->cwd(PATH)
		or die "Cannnot cwd: ", $ftp->message;

	my @patches = grep { defined } map { /(\S+)\.tgz$/; $1 } $ftp->dir;

	my @installed = map { (split '/', $_)[-1] } glob("/var/log/packages/*");

	my @unapplied;
	foreach my $patch (@patches) {
		# Don't care about already installed patches.
		next if $patch ~~ @installed;

		push @unapplied, $patch if grep { is_upgrade $_, $patch } @installed;
	}

	foreach (@unapplied) {
		say;
		if ($ftp->get("$_.tgz", LOCAL_PATCHES . "/$_.tgz")) {
			say "fetched: " . LOCAL_PATCHES . "/$_.tgz";
		}
		else {
			say STDERR "Couldn't fetch $_ from " . HOST . PATH . ": " . $! . $ftp->message;
		}

		if (DO_UPGRADES) {
			system "upgradepkg " . LOCAL_PATCHES . "/$_.tgz";
		}
	}
}

slackpkg update
slackpkg upgrade-all   <---This command presents you with a list of packages which have changed