#!/usr/bin/perl
#
# splice - Merge RPM repositories
#
# Copyright (C) 1999-2006 Martin K. Petersen <mkp@mkp.net>
# Released under the terms of the GNU General Public License v2.
#
# splice is a tool for merging RPM repositories.  It was designed to
# automate the process of overlaying a set of customized RPMS on top
# of pristine Red Hat Linux releases (without modifying the original
# package pool).
#
# Repositories must be listed increasing priority order. This is so
# that foo-1.0-1.myversion.ia64.rpm takes precedence over
# foo-1.0-1.ia64.rpm.
# 
# The fundamental assumption is that the root repository is consistent
# and the overlayed repos contain upgrades to it.  Arch tags are only
# added once (from the root repo).  This means that for multiarchs
# the selection of packages will match the root repo.
# 
# IOW, splicing the following with -a ia64 will pull in both i386 and
# ia64 versions of foo but only the ia64 version of bar.
#
#   root/foo-1.0-1.i386.rpm
#   root/foo-1.0-1.ia64.rpm
#   root/bar-2.0-1.ia64.rpm
#   ovl1/foo-1.0-2.i386.rpm
#   ovl1/foo-1.0-2.ia64.rpm 
#   ovl1/bar-2.0-2.i386.rpm
#   ovl1/bar-2.0-2.ia64.rpm
# 
# Several repositories can be stacked, and splice can optionally hold
# back newer versions to match what the root repository has (-r).
# This makes it possible to have one common RPM repository containing
# newer packages and still spin distros using "the original" set of
# RPMS.
#
# Splicing the following with -r gives foo-1.0-2.ia64.rpm.  Without -r
# the result would be foo-2.0-1.ia64.rpm.
#
#   root/foo-1.0-1.ia64.rpm
#   ovl1/foo-1.0-2.ia64.rpm
#   ovl1/foo-2.0-1.ia64.rpm
#
# splice's -n switch only includes package keys found in the root
# repository.  New packages found in the overlays will not be added.
# Splicing the following with -n gives foo-1.0-2.ia64.rpm.  Without -n
# bar-2.0-1.ia64.rpm would also be included.
#
#   root/foo-1.0-1.ia64.rpm
#   ovl1/foo-1.0-2.ia64.rpm
#   ovl1/bar-2.0-1.ia64.rpm
#
# An exclude file containing a list of keys can be specified to drop
# certain packages from the pool. The architecture can be overridden
# on the command line.  And finally splice can write a log file
# containing the output from the state machine to facilitate debugging
# or documenting the process.
#
# TODO:
#
#   - The tags should be added from the repo where a package is first
#     found.  Not just from root repo.

use Getopt::Std;


# From Sort::Versions. Copyright 1996, Kenneth J. Albanowski
sub versioncmp( $$ ) {
    my @A = ($_[0] =~ /([-.]|\d+|[^-.\d]+)/g);
    my @B = ($_[1] =~ /([-.]|\d+|[^-.\d]+)/g);

    my ($A, $B);
    while (@A and @B) {
	$A = shift @A;
	$B = shift @B;
	if ($A eq '-' and $B eq '-') {
	    next;
	} elsif ( $A eq '-' ) {
	    return -1;
	} elsif ( $B eq '-') {
	    return 1;
	} elsif ($A eq '.' and $B eq '.') {
	    next;
	} elsif ( $A eq '.' ) {
	    return -1;
	} elsif ( $B eq '.' ) {
	    return 1;
	} elsif ($A =~ /^\d+$/ and $B =~ /^\d+$/) {
	    if ($A =~ /^0/ || $B =~ /^0/) {
		return $A cmp $B if $A cmp $B;
	    } else {
		return $A <=> $B if $A <=> $B;
	    }
	} else {
	    $A = uc $A;
	    $B = uc $B;
	    return $A cmp $B if $A cmp $B;
	}	
    }
    @A <=> @B;
}


# Regular Expression matching RPM packages:
# 	<pkg>-<version>-<release>.<tag>.rpm
sub decompose {
    my $str = shift;
    return ($_ =~ /\/([\w_\.\-\+]+)-([\w\.]+)-([\w\.]+)\.(\w+)\.rpm/);
}


# Update stored values for the package.  
# Each package can have more tags (i.e. i386 and i686).
sub update {
    $pkg  = shift;
    $ver  = shift;
    $rel  = shift;
    $path = shift;
    $packages{$pkg}{'pkg'}  = $pkg;
    $packages{$pkg}{'ver'}  = $ver;
    $packages{$pkg}{'rel'}  = $rel;
    $packages{$pkg}{'path'} = $path;

    $ppath = "$packages{$pkg}{'path'}/$packages{$pkg}{'pkg'}-" .
	"$packages{$pkg}{'ver'}-$packages{$pkg}{'rel'}";

    foreach $tag (sort keys %{ $packages{$pkg}{'tag'} }) {
	if (-f "$ppath.$tag.rpm") {
	    print LOG "  FOUND       $ppath.$tag.rpm\n" if $log;
	}
	else {
	    print LOG "  MISSING     $ppath.$tag.rpm\n" if $log;
	    print STDERR "ERROR: $ppath.$tag.rpm is missing!\n";
	}
    }

}

# Update stored values for the package.  
# Each package can have more tags (i.e. i386 and i686).
sub current {
    $pkg  = shift;
    $ver  = shift;
    $rel  = shift;
    $path = shift;
}

# Archs compatible?
sub compat_arch {
    $_ = shift;

    # Works for i386, x86_64 and ia64
    return 1 if (/$arch/ || /noarch/ || /src/);
    return 1 if ($arch eq "i386" && /i.86/);

    return 0;
}

# Usage information
sub main::HELP_MESSAGE {
    print STDERR "Usage: splice [-a arch] [-e exclude_file] [-l log_file] [-r] DIR...\n\n";
    print STDERR "Repositories should be listed in increasing priority order\n";
    print STDERR "  -a <arch>  Target different arch than this host\n";
    print STDERR "  -e <file>  Exclude keys listed in this file\n";
    print STDERR "  -l <file>  Write comprehensive log to file\n";
    print STDERR "  -n         No new keys.  Build package list from root repo only\n";
    print STDERR "  -r         Replace only mode.  Don't upgrade to later versions.\n";
}


$main::VERSION = "$Id: splice,v 1.10 2006/04/07 23:46:01 mkp Exp $\\n" .
    "Copyright 1999-2006 Martin K. Petersen <mkp\@mkp.net>\n";
$Getopt::Std::STANDARD_HELP_VERSION = true;


# main()
getopts('a:e:l:nr');

if ($opt_a) { 
    $arch = $opt_a; 
} 
else { 
    $arch = `arch`; chomp $arch; 
}

$arch =~ s/i.86/i386/;

$exclude = $opt_e;
if ($opt_e) {
    if (! -T "$opt_e") {
	print STDERR "Argument to -e ($opt_e) must be a text file!\n";
	exit 1;
    }

    open(EXCLUDE, $opt_e) || die "Can't open exclude list $opt_e";
}

$log = $opt_l;
if ($opt_l) {
    open(LOG, ">$opt_l") || die "Can't open logfile $opt_l";
}

$no_new_keys = $opt_n;
$replace_only = $opt_r;


# Enough arguments specified?
if ($#ARGV < 0) {
    main::HELP_MESSAGE();
    exit 1;
}

$repo = 0;

# For each RPM repository specified on command line
while ($#ARGV >= 0) {
    $repo_dir = shift;
    open(FILES, "ls -1 $repo_dir/*rpm|");

    print LOG "======================================================================\n" if $log;
    print LOG "PASS $repo - $repo_dir\n" if $log;

    while (<FILES>) {
	$cur = $_;

	# Break up the package name into subcomponents
	($pkg, $ver, $rel, $tag) = decompose();
	die "Unparsable by regexp: $cur\n" if ($pkg eq "");

	print LOG "----------------------------------------------------------------------\n" if $log;
	print LOG "CHECKING      $repo_dir/$pkg-$ver-$rel.$tag\n" if $log;


	if ($repo > 0 && ! compat_arch($tag)) {
	    print LOG "  INCOMP ARCH $pkg-$ver-$rel.$tag\n" if $log;
	    goto NEXT;
	}

	# If this is a new package
	if (! defined $packages{$pkg}) {

	    # In no_new_keys mode, only add keys from root repo
	    if ($repo > 0 && $no_new_keys) {
		print LOG "  NOT IN ROOT $pkg-$ver-$rel\n" if $log;
	    }
	    else {
		print LOG "  ADD PKG     $pkg-$ver-$rel\n" if $log;
		update($pkg, $ver, $rel, $repo_dir);
		$packages{$pkg}{'tag'}{$tag} = $tag;
	    }
	    goto NEXT;
	}

	$old_ver  = $packages{$pkg}{'ver'};
	$old_rel  = $packages{$pkg}{'rel'};
	$old_path = $packages{$pkg}{'path'};

	# Only add multi arch tags during first pass
	$packages{$pkg}{'tag'}{$tag} = $tag if ($repo == 0);

	# Skip if this version is older
	if (versioncmp($ver, $old_ver) == -1) { 	# ver < old_ver
	    print LOG "  OLDER VERS  $pkg-$ver-$rel < $old_path/$pkg-$old_ver-$old_rel\n" if $log;
	    goto NEXT;
	}

	# Add if this version is newer and we're not in replace only mode
	if (versioncmp($ver, $old_ver) == 1) {     	# ver > old_ver
	    print LOG "  NEWER VERS  $pkg-$ver-$rel > $old_path/$pkg-$old_ver-$old_rel\n" if $log;
	    if ($replace_only) {
		print LOG "  KEPT BACK   $pkg-$ver-$rel\n";
	    }
	    else {
		update($pkg, $ver, $rel, $repo_dir);
	    }
	    goto NEXT;
	}

	# Check that release is same or newer if it's the same version
	if (versioncmp($rel, $old_rel) == -1) {  	# rel < old_rel
	    print LOG "  OLDER REL    $pkg-$ver-$rel < $old_path/$pkg-$old_ver-$old_rel\n" if $log;
	    goto NEXT;
	}

	# else rel >= old_rel
	print LOG "  GTEQ REL    $pkg-$ver-$rel >= $old_path/$pkg-$old_ver-$old_rel\n" if $log;
	update($pkg, $ver, $rel, $repo_dir);

NEXT:
	if ($log && defined $packages{$pkg}) {
	    print LOG "  CURRENT     $packages{$pkg}{'path'}/$pkg-" . 
		"$packages{$pkg}{'ver'}-$packages{$pkg}{'rel'}\n";
	}

    }

    close(FILES);
    $repo++;
}

# If a prune list was specified, drop the listed packages
if ($exclude) {
    print LOG "======================================================================\n" if $log;

    while (<EXCLUDE>) {
	$pkg = $_; chomp $pkg;
	next unless $pkg;
	
	
	if (exists $packages{$pkg}) {
	    print LOG "EXCLUDING     $packages{$pkg}{'path'}/$pkg-" . 
		"$packages{$pkg}{'ver'}-$packages{$pkg}{'rel'}\n" if $log;
	}
	else {
	    print LOG "EXCL ERROR    $pkg\n" if $log;
	    next;
	}
	
	delete $packages{$pkg};
    }

    close (EXCLUDE);
}

print LOG "======================================================================\n" if $log;

# Print the resulting master file
foreach $pkg (sort keys %packages) {
    foreach $tag (sort keys %{ $packages{$pkg}{'tag'} }) {
	print "$packages{$pkg}{'path'}/$packages{$pkg}{'pkg'}-",
	"$packages{$pkg}{'ver'}-$packages{$pkg}{'rel'}.",
	"$packages{$pkg}{'tag'}{$tag}.rpm\n";
    }
}

close (LOG) if $log;
exit 0;

# EOF