#!/usr/bin/perl

$CompsFile = "comps";
$RPMSDir = "../RPMS";

##################################################################

# This version comparison code was sent in by Robert Mitchell and, although
# not yet perfect, is better than the original one I had. He took the code
# from freshrpms and did some mods to it. Further mods by Simon Liddington
# <sjl96v@ecs.soton.ac.uk>.
#
# Splits string into minors on . and change from numeric to non-numeric
# characters. Minors are compared from the beginning of the string. If the
# minors are both numeric then they are numerically compared. If both minors
# are non-numeric and a single character they are alphabetically compared, if
# they are not a single character they are checked to be the same if the are not
# the result is unknown (currently we say the first is newer so that we have
# a choice to upgrade). If one minor is numeric and one non-numeric then the
# numeric one is newer as it has a longer version string.
sub cmp_vers_part($$) {
    my($va, $vb) = @_;
    my(@va_dots, @vb_dots);
    my($a, $b);
    my($i);

    @va_dots = split(/\./, $va);
    @vb_dots = split(/\./, $vb);

    $a = shift(@va_dots);
    $b = shift(@vb_dots);
    while ((defined($a) && $a ne '') || (defined($b) && $b ne '')) {
        # compare each minor from left to right
        if ($a eq '') { return -1; }        # the longer version is newer
        if ($b eq '') { return 1; }
        if ($a =~ /^\d+$/ && $b =~ /^\d+$/) {
            # numeric compare
            if ($a != $b) { return $a <=> $b; }
        }
        elsif ($a =~ /^\D+$/ && $b =~ /^\D+$/) {
            # string compare
            if (length($a) == 1 && length($b) == 1) {
                # only minors with one letter seem to be useful for versioning
                if ($a ne $b) { return $a cmp $b; }
            }
            elsif (($a cmp $b) != 0) {
                # otherwise we should at least check they are the same and if not say unknown
                # say newer for now so at least we get choice whether to upgrade or not
                return -1;
            }
        }
        elsif ( ($a =~ /^\D+$/ && $b =~ /^\d+$/) || ($a =~ /^\d+$/ && $b =~ /^\D+$/) )
        {
            # if we get a number in one and a word in another the one with a number
            # has a longer version string
            if ($a =~ /^\d+$/) { return 1; }
            if ($b =~ /^\d+$/) { return -1; }
        }
        else {
            # minor needs splitting
            $a =~ /\d+/ || $a =~ /\D+/;
            # split the $a minor into numbers and non-numbers
            my @va_bits = ($`, $&, $');
            $b =~ /\d+/ || $b =~ /\D+/;
            # split the $b minor into numbers and non-numbers
            my @vb_bits = ($`, $&, $');

            for ($j=2; $j >= 0; $j--) {
                if ($va_bits[$j] ne '') { unshift(@va_dots,$va_bits[$j]); }
                if ($vb_bits[$j] ne '') { unshift(@vb_dots,$vb_bits[$j]); }
            }
        }
        $a = shift(@va_dots);
        $b = shift(@vb_dots);
    }
    return 0;
}

# RPM_Compare_Version - compare RPM version strings
# Arguments:
#    $_[0]              version string of "a"
#    $_[1]              version string of "b"
# Returns:              "a" <=> "b"
#        -1 = a < b, 0 = a==b, 1 = a > b
sub RPM_Compare_Version($$) {
    my ($Version1,$Release1,$Version2,$Release2,$Result);
    ($Version1,$Release1) = split (/-/,$_[0]);
    ($Version2,$Release2) = split (/-/,$_[1]);
    if ($VersionCheckMode) {
        print "Version 1: $Version1\n";
        print "Release 1: $Release1\n";
        print "Version 2: $Version2\n";
        print "Release 2: $Release2\n";
    }
    $Result = cmp_vers_part ($Version1,$Version2);
    if ($Result) {
        return ($Result);
    }
    return (cmp_vers_part ($Release1,$Release2));
}

$| = 1;

print "Indexing RPMs... ";

# First, find out what every RPM requires and provides
opendir (DIR, $RPMSDir) or die "Can't open directory of RPMS: $RPMSDir\n";
while ($ThisRPM = readdir(DIR)) {
   unless ($ThisRPM =~ /^\./) {
      @Prov = `rpm -q --provides -p $RPMSDir/$ThisRPM`;
      @Files = `rpm -q -l -p $RPMSDir/$ThisRPM`;
      @Req = `rpm -q --requires -p $RPMSDir/$ThisRPM`;
      $VersionRel = $ThisRPM;
      $VersionRel =~ s/.*-([^-]+-[^-]+)\.[^.]+\.rpm$/$1/;
      $Version = $ThisRPM;
      $Version =~ s/.*-([^-]+)-[^-]+\.[^.]+\.rpm$/$1/;
      $ThisRPM =~ s/-[^-]+-[^-]+\.[^.]+\.rpm$//;
      push (@{$Provides{$ThisRPM}}, @Prov);
      push (@{$Provides{$ThisRPM}}, @Files);
      push (@{$Provides{$ThisRPM}}, "$ThisRPM\n");
      push (@{$Provides{$ThisRPM}}, "$ThisRPM = $Version\n");
      push (@{$Provides{$ThisRPM}}, "$ThisRPM = $VersionRel\n");
      push (@{$Requires{$ThisRPM}}, @Req);
   }
}
closedir (DIR);

foreach $RPM (keys %Provides) {
   foreach $Provide (@{$Provides{$RPM}}) {
      chomp ($Provide);
      $Provide =~ s/^\s*//;
      $Provide =~ s/\s*$//;
      push (@{$ProvideIndex{$Provide}}, $RPM);
   }
}

foreach $RPM (keys %Requires) {
   foreach $Require (@{$Requires{$RPM}}) {
      chomp ($Require);
      $Require =~ s/^\s*//;
      $Require =~ s/\s*$//;
      push (@{$RequireIndex{$Require}}, $RPM);
   }
}

print "Done.\n";

print "Indexing workgroups:";

$InWorkgroup = 0;
open (IN, "$CompsFile") or die "Can't open input file: $CompsFile\n";
while ($ThisLine = <IN>) {
   chomp ($ThisLine);
   unless ($ThisLine =~ /^#/) {
      if ( ($Workgroup) = ($ThisLine =~ /^0 --hide (.+)$/) ) {
         if ( (not @ARGV) or (grep /$Workgroup/, @ARGV) ) {
            $InWorkgroup = $Workgroup;
         }
      }
      elsif ( $ThisLine =~ /^1 Base$/ ) {
         $InWorkgroup = "Base";
      }
      elsif (($InWorkgroup) and ($ThisLine =~ /^end$/)) {
         if ($InWorkgroup ne "Base") {
            push (@{$RPMS{$InWorkgroup}}, @Base);
         }
         print " $InWorkgroup";
         $InWorkgroup = 0;
      }
      elsif ($InWorkgroup) {
         if ($InWorkgroup eq "Base") {
            push @Base, $ThisLine;
         }
         else {
            push (@{$RPMS{$InWorkgroup}}, $ThisLine);
         }
      }
   }
}   

print "\n";

print "Processing workgroups:";

foreach $Workgroup (keys %RPMS) {
   print " $Workgroup";
   foreach $RPM (@{$RPMS{$Workgroup}}) {
      push @{$WProvides{$Workgroup}}, @{$Provides{$RPM}};
      push @{$WRequires{$Workgroup}}, @{$Requires{$RPM}};
   }
   %ProvidesHash = ();
   foreach $This (@{$WProvides{$Workgroup}}) {
      chomp ($This);
      $This =~ s/^\s*//;
      $This =~ s/\s*$//;
      $ProvidesHash{$This} = 1;
   }
   foreach $ThisRequire (@{$WRequires{$Workgroup}}) {
      unless ($ThisRequire =~ /\(none\)/) {
         chomp ($ThisRequire);
         $ThisRequire =~ s/^\s*//;
         $ThisRequire =~ s/\s*$//;
         if ($ThisRequire =~ />/) {
            $VerA = $ThisRequire;
            $VerA =~ s/.+ >=* //;
            $VerA =~ s/^([^-]+)$/$1-0/;
            $ThisRequireName = $ThisRequire;
            $ThisRequireName =~ s/ >=* .*$//;
            @Other = grep /^\Q$ThisRequireName\E = /, @{$WProvides{$Workgroup}};
            $Satisfied = 0;
            foreach $ThisOther (@Other) {
               $VerB = $ThisOther;
               $VerB =~ s/^.+ = //;
               $VerB =~ s/^([^-]+)$/$1-0/;
               $Result = RPM_Compare_Version ($VerA, $VerB);
               if ( (($ThisRequire =~ />=/) and ($Result <= 0)) or
                    (($ThisRequire =~ />/) and ($Result < 0)) ) {
                  $Satisfied = 1;
               }
            }
            unless ($Satisfied) {
               $NotSatisfied{$Workgroup}{$ThisRequire} = 1;
            }
         }
         else {
            unless ($ProvidesHash{$ThisRequire}) {
               $NotSatisfied{$Workgroup}{$ThisRequire} = 1;
            }
         }
      }
   }
}

print "\n";

foreach $Workgroup (keys %NotSatisfied) {
   print "\n\n$Workgroup has unsatisfied dependencies:\n";
   foreach $Depend (keys %{$NotSatisfied{$Workgroup}}) {
      print "   $Depend is needed by:\n";
      foreach $This (@{$RequireIndex{$Depend}}) {
   	   if (grep /^\Q$This\E/, @{$RPMS{$Workgroup}}) {
            print "      $This\n";
         }
      }
      if ($Depend =~ /(=|>)/) {
         $ThisRequireName = $Depend;
         $ThisRequireName =~ s/ [>=]+ .*$//;
         foreach $This (@{$ProvideIndex{$ThisRequireName}}) {
            chomp ($This);
            print "      *$This provides $Depend\n";
         }
      }
      foreach $This (@{$ProvideIndex{$Depend}}) {
         chomp ($This);
         print "      *$This provides $Depend\n";
      }
   }
}

print "\n";

close (IN);