#!/usr/bin/perl -w

# mergerpm.pl, by Philip Rowlands (phr@doc.ic.ac.uk)
# Last modified 2002-11-07, add explicit jump label for "next OUTER"

# The output of this script is another script (shell), which
# is verbosely commented and will remove all but the latest
# versions of packages. The generated script should be
# sanity-checked before running.
#
# The first (main) directory given is stripped of all duplicate packages,
# the older ones being deleted.
# Subsequent directories are searched for newer packages. If found, they are
# copied to the main directory, replacing older versions. Duplicate packages
# in these directories are noted, but ignored.

#TODO
# - Use the RPM perl module, instead of calling /usr/bin/rpm

# turn on for debugging output
$debug = 1;
$| = 1 if ($debug);	# no buffering

$maindir = $ARGV[0] or &usage;
shift(@ARGV);
@otherdirs = @ARGV;

foreach $_ ($maindir, @otherdirs) {
	unless (-d && -r && -x) {
		die ("$_ not an accessible directory\n");
	}
}

# mergerpm finds multiple rpms that have the same name and architecture,
# and deletes all but the most recent.

@rpms = glob("$maindir/*.rpm") or die("No RPMs in $maindir\n");
foreach(@ARGV) {
	@temprpms = glob("$_/*.rpm") or die ("No RPMs in $_\n");
	push(@rpms, @temprpms);
}

# create one big rpm command line
@rpmcmd = ('rpm', '-qp', '--queryformat', '%{NAME} %{ARCH}\n', '--');
push(@rpmcmd, @rpms);
#debug(join(' ', @rpmcmd));
#debug("\n");

# spawn subprocess to read package info
open(FOO, "-|") || exec(@rpmcmd);
foreach (@rpms) {
	&debug("Analysing $_\n");
	$temp = <FOO>;
	chomp($temp);
	# build a hash of arrays of version info, indexed by name+arch
	push(@{$namearch{$temp}}, $_);
	undef $temp;
}
close(FOO);

# find common names and architectures
OUTER:
foreach $name (keys %namearch) {
	&debug("Comparing $name\n");
	if (@{$namearch{$name}} > 1) {	# more than one match
		debug(join(" ", @{$namearch{$name}})."\n");
		$bestbuildtime = 0;
		foreach $rpm (@{$namearch{$name}}) {
			# **nasty hack**
			# the proper version comparison that rpm makes is rather
			# complicated, and involves comparing EPOCH, VERSION, and
			# RELEASE tags. We, instead, assume that the package with the
			# most recent build date is the latest version. This should be
			# sanity checked by human eye before results are committed.
			$buildtime = `rpm -qp --queryformat "%{BUILDTIME}" -- $rpm`;
			$buildtimes{$rpm} = $buildtime;
			if ($buildtime > $bestbuildtime) {
				$bestbuildtime = $buildtime;
				$bestbuildrpm = $rpm;
			}
		}
		if ($bestbuildtime != 0) {
			&debug("Latest version of $name is $bestbuildrpm, at $bestbuildtime\n");
			foreach $rpm (@{$namearch{$name}}) {
				# where are the rpms
				($t1) = ($rpm =~ m|(.+)/[^/]+|);
				($t2) = ($bestbuildrpm =~ m|(.+)/[^/]+|);
				#&debug("t1 = $t1\nt2 = $t2\n");
				if ($buildtimes{$rpm} eq $bestbuildtime) {
					# either $rpm is $bestbuildrpm,
					# or is in a different dir
					if ($rpm eq $bestbuildrpm) {
						debug("$rpm is equal to $bestbuildrpm; skipping\n");
						next OUTER;
					}
					if ($t1 ne $t2) {
						debug("$t1 is up-to-date with respect to $t2; skipping\n");
						next OUTER;
					}
				}
				if ($rpm ne $bestbuildrpm) {
					# are they both in same dir
					if ($t1 eq $t2) {
						if ($t1 eq $maindir) {
							print "\n# delete the older package\n";
							print "rm -f -- '$rpm'\n";
						} else {
							&debug("Redundant packages $rpm and $bestbuildrpm in $t1\n");
						}
					}
					# is the older one in maindir
					elsif (($t1 eq $maindir && $t2 ne $maindir) ||
							($t2 eq $maindir && $t1 ne $maindir)) {
						print "\n# delete old RPM then copy in the new\n";
						print "rm -f -- '$rpm'\n";
						print "cp -p -- '$bestbuildrpm' '$maindir'\n";
					}
					# something went wrong
					else {
						# e.g. maindir rpm newer than update
						&debug("rpm = $rpm\n");
						&debug("bestbuildrpm = $bestbuildrpm\n");
						die("unexpected error comparing packages\n");
					}
				}
			}
		} else {
			warn("Something went wrong finding latest version of $name\n");
		}
	}
}

print("echo Now run genhdlist\n");

sub usage {
	die "syntax: $0 <dir> [dir]...\n";
}

sub debug {
	if ($debug) {print STDERR @_};
}
