#!/usr/bin/perl
use strict; # Always

### RHUM - RedHat Update Munger v1.2
### Originally written by Nick Levay <nick at nicklevay dot net>
###
### Contributions:
###    - Alex Martin <a.j.martin at qmul dot ac.uk>

### This is free software.  You may copy, modify, and distribute this program
### under the same terms as perl.

#########################
### DEFAULT CONFIGURATION

use vars qw( $DistroRoot @RHUpdates $ghdl );

### Base of RedHat like distro
#$DistroRoot = '/export/rh9cust';
#$DistroRoot = '/export/yarrowcust';

### Default Update Directories (recursive)
#$RHUpdates[0] = '/export/rh9updates';
#$RHUpdates[1] = '/export/beowulf';
#$RHUpdates[2] = '/export/java';
#$RHUpdates[3] = '/export/custom';

### Path to genhdlist (part of anaconda-runtime RPM)
$ghdl = '/usr/lib/anaconda-runtime/genhdlist';

#######################################################
### MAIN (You should not have to edit anything in here)

# Process command line args
use vars qw( $opt_u $opt_d $opt_v $opt_R $opt_U $opt_O $opt_G );
use Getopt::Std;
getopts("udvR:U:O:G:");

# Print version information
if (defined $opt_v) {
	print_version();
	exit;
}

# Process comandline options, override defaults
if (defined $opt_R) {
	$DistroRoot = $opt_R;
}
if (defined $opt_G) {
	$ghdl = $opt_G;
}

# Make sure we have all necessary paths and everything is sane
unless (defined $ghdl && -x $ghdl) {
	print_help("ERROR:  genhdlist missing or not executable!\n\t(Is anaconda-runtime RPM installed?)");
	exit 1;
}
if ($DistroRoot =~ m/^\.\./) {
	my $pwd = $ENV{PWD};
	$pwd =~ s/\/\w*$//;
	$DistroRoot =~ s/^\.\./$pwd$1/;
} elsif ($DistroRoot =~ m/^\./) {
	my $pwd = $ENV{PWD};
	$DistroRoot =~ s/^\./$ENV{PWD}$1/;
}
$DistroRoot =~ s/\/$//;
my $DFlavor;
# What RedHat flavor are we?
if (-d "$DistroRoot/RedHat/RPMS" && -d "$DistroRoot/RedHat/base") {
	$DFlavor = 'RedHat';
} elsif (-d "$DistroRoot/Fedora/RPMS" && -d "$DistroRoot/Fedora/base") {
	$DFlavor = 'Fedora';
} else {
	print_help("ERROR:  Invalid distribution base directory!");
	exit 1;
}
my @UpdateDirs;
foreach my $udir (@RHUpdates, @ARGV) {
	# Catch args that Getopt dosen't (for -d and -u anyway)
	if ($udir =~ m/-[du]/) {
		$opt_u = 1 if $udir eq '-u';
		$opt_d = 1 if $udir eq '-d';
		next;
	}
	if ($udir =~ m/^\.\./) {
		my $pwd = $ENV{PWD};
		$pwd =~ s/\/\w*$//;
		$udir =~ s/^\.\./$pwd$1/;
	} elsif ($udir =~ m/^\./) {
		my $pwd = $ENV{PWD};
		$udir =~ s/^\./$ENV{PWD}$1/;
	}
	unless (-d "$udir") {
		print_help("ERROR:  Update Directory ($udir) invalid!");
		exit 1;
	}
	$udir =~ s/\/$//;
	push(@UpdateDirs, $udir);
}
my $rpmbin;
if (-x '/bin/rpm') {
	$rpmbin = '/bin/rpm';
} elsif (-x '/usr/bin/rpm') {
	$rpmbin = '/usr/bin/rpm';
} else {
	print_help("ERROR:  Could not find rpm in /bin or /usr/bin!");
}
if (@UpdateDirs > 0) {
	print "Update Directories:  " . join(", ", @UpdateDirs) . "\n";
} else {
	print "ERROR:  Must specify at least one update directory!\n\n";
}

# Make sure we have a command
unless (defined $opt_u || defined $opt_d) {
	print_help();
	exit;
}

# Scan RPMS Dirs
my %DRPMS = scan_dirs("$DistroRoot/$DFlavor/RPMS");
my %URPMS = scan_dirs(@UpdateDirs);
my %Updates = compare(\%URPMS, \%DRPMS);

# Print results
if ((defined $opt_d && !defined $opt_u)||(defined $opt_u && !defined $opt_d)) {
	# Exit if we we have no updates to merge
	unless (keys %Updates) {
		print "No updates to merge.\n";
		exit;
	}
	# Process updates
	foreach my $name (keys %Updates) {
		print "$name: \n";
		foreach my $arch (@{$Updates{$name}}) {
			print "  [$arch] ";
			if ($DRPMS{$name}{$arch}[0] && $DRPMS{$name}{$arch}[1]) {
				print $DRPMS{$name}{$arch}[0] . "-" . $DRPMS{$name}{$arch}[1];
			} else {
				print "(none)";
			}
			print " ==> ";
			print $URPMS{$name}{$arch}[0] . "-" . $URPMS{$name}{$arch}[1];
			# Here is where we do updates if -u
			if (defined $opt_u) {
				if (defined $DRPMS{$name}{$arch}[2]) {
					unlink($DRPMS{$name}{$arch}[2])
						|| die "$! trying to delete $DRPMS{$name}{$arch}[2]";
				}
				system("cp -p $URPMS{$name}{$arch}[2] $DistroRoot/$DFlavor/RPMS/");
				print " (done)";
			}
			print "\n";
		}
	}
	# Rebuild hdlist
	if (defined $opt_u) {
		print "Generating hdlist... ";
		system($ghdl, $DistroRoot);
		print "done.\n";
	}
	exit;
} else {
	print_help("NOTE:  Use either -u or -d");
	exit 1;
}

# We should never actually get here
print_help("ERROR:  Unknown Error");
exit 1;

#############
### FUNCTIONS

# Print help screen
sub print_help {
	if ($_[0]) {
		print "$_[0]\n\n";
	}
	print "Usage:  $0 [-udv] [-R <dir>] [-G <dir>] <update dirs>\n\n";
	print "Commands:\n";
	print "\t-u\tMerge updates\n";
	print "\t-d\tMerge updates [DRY RUN]\n";
	print "\t-v\tPrint version information\n";
	print "\nOptions:\n";
	print "\t-R\t<RedHat-Style Distribution Base Directory>\n";
	if (defined $DistroRoot) {
		print "\t\t\t(current: $DistroRoot [$DFlavor])\n";
	} else {
		print "\t\t\t(current: NONE [REQUIRED])\n";
	}
	print "\t-G\t<Path to genhdlist>\n";
	if (defined $ghdl) {
		print "\t\t\t(current: $ghdl)\n";
	} else {
		print "\t\t\t(current: NONE [REQUIRED])\n";
	}
	print "\n\tEdit $0 to change defaults.\n";
}

# Print version information
sub print_version {
	print <<EOF
RHUM - RedHat Update Munger - v1.1
Written by Nick Levay <nick\@nicklevay.net>

Copyright (C) 2003 Nick Levay
This is free software.  You may copy, modify, and distribute this program
under the same terms as perl.
EOF
}

# Scan Update dirs for RPMS
sub scan_dirs {
	my %RPMS;
	foreach my $updatedir (@_) {
		next unless defined $updatedir;
		my %DIR = ();
		print "Scanning: $updatedir\n";
		foreach my $rpm (`find $updatedir -name \"*.rpm\" ! -name \"*src.rpm\"`) {
			# Attempt to parse RPM info
			chomp $rpm;
			my $qstring = '%{NAME} %{VERSION} %{RELEASE} %{ARCH}';
			my $cmd = `$rpmbin -qp $rpm --queryformat \'$qstring\'`;
			my ($name, $ver, $rev, $arch) = split(/ /, $cmd);
			print ".";
			# Complain if anything does not look right
			unless (defined $name && defined $ver
					&& defined $rev && defined $arch) {
				print "HEADER ERROR: $rpm";
				print " (No NAME)" unless defined $name;
				print " (No VERSION)" unless defined $ver;
				print " (No RELEASE)" unless defined $rev;
				print " (No ARCH)" unless defined $arch;
				print "\n";
				next;
			}
			$rpm =~ m/^\/?.*\/([a-z0-9_\+\.-]*)\.rpm$/i;
			my $rpmname = $1;
			if ( $rpmname ne "${name}-${ver}-${rev}.${arch}" ) {
				print "WARNING: $rpm (Filename format incorrect)\n"
			}
			# Add if we don't already have newer one
			if (!defined $DIR{$name}{$arch}) {
				$DIR{$name}{$arch} = [$ver, $rev, $rpm];
			} else {
				my ($ever, $erev) = ($DIR{$name}{$arch}[0], $DIR{$name}{$arch}[1]);
				if (vercompare($ever, $ver) || vercompare($erev, $rev)) {
					$DIR{$name}{$arch} = [$ver, $rev, $rpm];
				}
			}
		}
		foreach my $name (keys %DIR) {
			$RPMS{$name} = $DIR{$name};
		}
		print "\n";
	}
	return %RPMS;
}

# Compare version numbers
sub vercompare {
	# Split up version octets
	my @ver1 = split(/\./, $_[0]);
	my @ver2 = split(/\./, $_[1]);
	
	# Compare each octet until we can make a call
	my $max;
	if ( $#ver1 > $#ver2 ) {
		$max = $#ver1;
	} else {
		$max = $#ver2;
	}
	foreach my $i (0 .. $max) {
		if ($ver1[$i] eq $ver2[$i]) {
			next;
		} elsif ($ver1[$i] > $ver2[$i]) {
			return 0;
		} else {
			return 1;
		}
	}
}

# Compare Updates with Distro
sub compare {
	my ($URPMS, $DRPMS) = @_;
	my %Diff;
	foreach my $name (keys %$URPMS) {
		foreach my $arch (keys %{ $URPMS->{$name} }) {
			my $DRPMver = $DRPMS->{$name}->{$arch}->[0];
			my $DRPMrev = $DRPMS->{$name}->{$arch}->[1];
			my $URPMver = $URPMS->{$name}->{$arch}->[0];
			my $URPMrev = $URPMS->{$name}->{$arch}->[1];
			unless (($DRPMver eq $URPMver) && ($DRPMrev eq $URPMrev)) {
				push @{$Diff{$name}}, $arch;
			}
		}
	}
	return %Diff;
}

# <EOF>