#!/usr/bin/perl
#
# Script to generate a template with one 'pkg_ronly' for each RPM present in
# the specified directory. Optionaly, this script can download the update RPMs
# from a specified location.
#
# Only the most recent version is inserted into the template.
#
# Arguments :
#    - Directory to process
#    - URL where to retrieve RPMs (optional)
#
# STDOUT must be redirected to produce the template.
#
# It is recommended to redirect STDERR to another file as it can produce a lot
# of output, especially if downloading is done at the same time.
#
# Common sources of RPM are :
#    - gLite 3.0 base : http://glitesoft.cern.ch/EGEE/gLite/APT/R3.0/rhel30/RPMS.Release3.0/
#    - gLite 3.0 external packages : http://glitesoft.cern.ch/EGEE/gLite/APT/R3.0/rhel30/RPMS.externals/
#    - gLite 3.0 updates : http://glitesoft.cern.ch/EGEE/gLite/APT/R3.0/rhel30/RPMS.updates/
#
# Written by Michel Jouvin <jouvin@lal.in2p3.fr> - 16/7/06
#
# FIXME : still pretty brute force, lacking error control...

use strict;

sub usage {
  print "usage:\trpmUpdates.pl rpm_directory\n";
  print "\n";
  print "STDOUT must be redirected to produce the template.\n";
  print "It is recommended to redirect STDERR to another file as it can produce a lot\n";
  print "of output, especially if downloading is done at the same time.\n";
  exit 0;
}

# This function compare RPM version numer and returns :
#   - 1 if 1st arg considered greater than 2nd
#   - 0 if equal
#   - -1 if 1st arg considered less than 2nd
sub version_compare {
  if ( @_ != 2 ) {
    print STDERR "version_compare : wrong number of args\n";
    exit 1;
  }
  my ($first, $second) = @_;

  #print STDERR "first = $first\n";
  # Brute force splitting
  my @first_toks = ($first =~ m/(\d*)(?:[\.\-]?)/g);
  my @second_toks = ($second =~ m/(\d*)(?:[\.\-]?)/g);
  my $max_tok = scalar(@first_toks);
  if (@second_toks > $max_tok) {
    $max_tok = scalar(@second_toks);
  }
  for (my $i=0; $i<$max_tok; $i++)  {
    #print STDERR "toks = ".@first_toks[$i].",".@second_toks[$i]."\n";
    if ( defined(@first_toks[$i]) && !defined(@second_toks[$i]) ) {
      return 1;
    } elsif ( !defined(@first_toks[$i]) && defined(@second_toks[$i]) ) {
      return -1;
    } elsif ( (length(@first_toks[$i])==0) && (length(@second_toks[$i])==0) ) {
      next;
    } elsif ( @first_toks[$i] == @second_toks[$i] ) {
      next;
    } else {
      if ( (@first_toks[$i] =~ /^\d+$/) && (@second_toks[$i] =~ /^\d+$/) ) {
        if ( @first_toks[$i] > @second_toks[$i] ) {
          return 1;
        } else {
          return -1;
        }
      } else {
        if ( @first_toks[$i] gt @second_toks[$i] ) {
          return 1;
        } else {
          return -1;
        }
      }
    }
    
  }
  return 0;
}

if ( @ARGV == 0 ) {
  usage();
}

my $repository = @ARGV[0];
my $source_url = undef;


# If a source URL has been specified, load RPMs (only new ones)

if ( defined($source_url) ) {
}

# Process each rpm present in the repository

opendir (REPOS, $repository) || die "Error opening directory $repository";
my @rpms = grep /\.rpm$/, readdir(REPOS);

my %version;
my %arch;

print "# Template to add update RPMs to base configuration\n\n";
print "template rpms/errata;\n\n";

foreach my $rpm (@rpms) {
  print STDERR "Processing $rpm.. ";
  my $rpminfo = qx%rpm -qp $repository/$rpm --queryformat '\%{name},\%{version},\%{release},\%{arch}'%;
  #print STDERR "RPM = $rpminfo\n";
  my ($name, $version, $release, $arch) = split /,/, $rpminfo;
  $version .= "-${release}";
  my $namearch = $name . "," . $arch;
  my $internal_name = "$name-$version.$arch.rpm";
  unless ( "$internal_name" eq $rpm ) {
    print STDERR "RPM $rpm internal name ($internal_name) doesn't match RPM file name. Skiiped.\n";
    next:
  }

  if ( !exists($version{$namearch}) || (version_compare($version,$version{$namearch}) > 0) ) {
    print STDERR "added (replacing older versions)\n";
    $version{$namearch} = $version;
  } else {
    print STDERR "skipped (newer version present)\n";
  }
}

# Add an entry for the most recent version of every RPM, except kernel.
# Kernel version is defined explicitly in node configuration and must
# not be based on the last one available.
# Kernel modules are added for all possible kernel versions. This is not
# a problem as their name contains the kernel version used and
# will not match an already installed RPM if the kernel version used is not
# matching.

foreach my $namearch (sort(keys(%version))) {
  my ($name, $arch) = split /,/, $namearch;
  if ( $name =~ /^kernel(?!-module-)/ ) {
    print STDERR "Adding commented-out entry for kernel $name version $version{$namearch} arch $arch\n";
    print "#'/software/packages'=pkg_ronly('$name','$version{$namearch}','$arch','multi');\n";
  } else {
    print STDERR "Adding entry for $name version $version{$namearch} arch $arch\n";
    print "'/software/packages'=pkg_ronly('$name','$version{$namearch}','$arch');\n";
  }
}