#!/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 [rpm_source_url]\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 ( @ARGV == 2 ) {
  $source_url = @ARGV[1];
}


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

if ( defined($source_url) ) {
  print STDERR "Loading new RPMs from $source_url (may take a while)...\n";
  my $output;
  my $temp_dir = '/tmp';
  if ( -f "$temp_dir/index.html" ) {
    unlink "$temp_dir/index.html";
  }
  $output = qx%wget $source_url --directory-prefix $temp_dir%;
  $output = qx%wget --force-html -N --no-directories -A.rpm --directory-prefix $repository --base $source_url/ -i $temp_dir/index.html%;
}

# 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 update/rpms;\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";
  }
}

foreach my $namearch (sort(keys(%version))) {
  my ($name, $arch) = split /,/, $namearch;
  print STDERR "Adding entry for $name version $version{$namearch} arch $arch\n";
  print "'/software/packages'=pkg_ronly('$name','$version{$namearch}','$arch');\n";
}
