# -*-perl-*-

# $Id: Rpms.plm,v 1.24 2012/04/04 19:19:37 timc Exp $

# What package to handle RPMs
# Try to really read all the dependency goo out of the RPM files.

# $Log: Rpms.plm,v $
# Revision 1.24  2012/04/04 19:19:37  timc
# Once again try to figure out why we're -ivh'ing instead of -Uvh'ing -- well
# this time I left a note.
#
# Revision 1.23  2011/05/13 20:43:51  timc
# RPM is deprecated in favor of RPM2 which is apparently just the
# tiniest bit different...
#
# Revision 1.22  2011/05/12 20:43:19  timc
# last change for additions to rpm in rhel6
#
# Revision 1.21  2011/02/23 22:47:53  timc
# one more thing for rhel6
#
# Revision 1.20  2011/02/23 21:46:02  timc
# for rhel6
#
# Revision 1.19  2008/08/18 18:31:49  timc
# Use RPM::vercmp to determine which RPM version is newer by name
#
# Revision 1.18  2008/06/13 17:29:00  thomas
# add --runscripts
#
# Revision 1.17  2008/05/27 14:36:53  thomas
# Add --prefix support
# Remove .none when removing rpm gpg signing keys
#
# Revision 1.16  2007/04/12 16:04:53  thomas
# Alert if the final RPM set differs from the config
#
# Revision 1.15  2007/01/04 19:16:50  thomas
# add skipdeps code
#
# Revision 1.14  2006/09/12 21:14:40  thomas
# fix mkrpms case where metapkg lacked 'type'
#
# Revision 1.13  2006/04/11 14:32:59  thomas
# improve library search for rpm generation
#
# Revision 1.12  2006/01/25 14:45:04  thomas
# Fix search order for implicit dependencies
#
# Revision 1.11  2006/01/10 21:24:21  thomas
# - use XML::Parser for XML::Simple
# - fix code to detect multiple versions/releases vs. multiple architectures
#
# Revision 1.10  2005/07/11 19:25:58  thomas
# Improve arch support for x86_64
#
# Revision 1.9  2004/10/13 16:00:05  thomas
# Add triggers for RPM node changes
# Failed attempt to loop through Install/Remove cycle
# Note problem with multiple arch RPMs
#
# Revision 1.8  2004/08/03 19:44:29  thomas
# New architectures
# don't add extras RPMs for different architectures unless needed
#
# Revision 1.7  2004/07/21 14:56:27  thomas
# Opteron support
#
# Revision 1.6  2004/07/13 21:38:31  thomas
# Sort dependencies for consistency
# Propigate ifarch properly
# Remove unused usage routine
# Change name of variable to force re-install of all rpms
#
# Revision 1.5  2004/07/02 18:59:25  thomas
# eval() xml imports;
# fix undefined errors
#
# Revision 1.4  2004/05/24 14:26:34  thomas
# Completely re-work this class.
#

package What::Node::Rpms;

use strict;
use FileHandle;
#needed for vercmp in mk_isnewer down below
use RPM2;

use XML::Simple;
$XML::Simple::PREFERRED_PARSER = 'XML::Parser';

use Data::Dumper;

use base qw(What::Node);

our %opts = (
	     RPMCMD    => '/s/what-0.1.31/depend/rpm',
	     RPM_INSTALL_ARGS   => [ '--oldpackage', ],
	    );

# Set the priority for this module in $::
$::module_priority{'Rpms'} = 60;

# This shouldn't be needed permanently.  The 2.4.20-20.9 kernel/
# glibc 2.3.2-27.9.6 has a borked nptl implementation.  This causes
# glibc to use a different thread package.  11/13/03 thomas
# Take it out for a while, because several boxes get corrupt dbs.
# $::ENV{LD_ASSUME_KERNEL} = '2.4.1';

###############################################################################
# Apply the current configuration

sub apply {
  my $class = shift;
  my $section = shift;
  my $what = shift;
  my $sname = shift;
  my $cname = shift;

  my ($tried);
  my $data = {};
  $class->getarch($what, $data) or return 0;

  # If I removed anything, try the install loop again.
  my ($installed, $removed, $rpms, $rpmlist, $versions) = (1,1);
  # while ($removed) {
    $installed = $class->InstallStuff($section, $what, $data);
    $removed   = $class->RemoveStuff($section, $what, $data);
  # }

  # Alert if (live != config)
  my ($live, $config) = ('','');
  my ($namekey, $verkey);
  $class->GetCurrent($data);
  # Get live string
  foreach $namekey (sort keys %{$data->{current}}) {
    foreach $verkey (sort keys %{$data->{current}->{$namekey}}) {
      $live .= " $namekey-$verkey";
    }
  }
  # Get config string
  $rpms = $class->find_node ($section, '/rpms');
  $rpmlist = $rpms->getchildren ($section);
  foreach $namekey (sort keys %$rpmlist) {
    $versions = $rpmlist->{$namekey}->getchildren ($section);
    foreach $verkey (sort keys %$versions) {
      $config .= " $namekey-$verkey";
    }
  }

  if ($live ne $config) {
    $class->debug (1, "Rpms: final RPM state not optimal!\n");
  }

  return 1;
}

###############################################################################
# Figure out my architecture and record it

sub getarch {
  my $self = shift;
  my $what = shift;
  my $data = shift;

  my $fh = new FileHandle "/proc/cpuinfo", "r";
  my $cpuvendor;
  $data->{architecture} = undef;
  while (<$fh>) {
    if (/^vendor_id\s+:\s+(\S+)$/) {
      $cpuvendor = $1;
      last;
    }
  }
  if (defined $cpuvendor) {
    ($cpuvendor eq 'GenuineIntel') and $data->{architecture} = 'i686';
    ($cpuvendor eq 'AuthenticAMD') and $data->{architecture} = 'athlon';
    defined ($data->{architecture}) and return 1;
  }
  $self->err ("Rpms: Failed to identify my architecture!\n");
  return 0;
}

########################################################################
# Get the list of rpms currently installed on this machine.

sub GetCurrent {
  my $self = shift;
  my $data = shift;

  my ($fh, $name, $ver, $rel, $arch, $rootopts, $rpmcmd);

  $data->{current} = {};
  $self->debug (3, "Getting list of current rpms\n");
  $rootopts = join (' ', $self->GetRootOpts);
  defined ($rpmcmd = $self->getoption ('RPMCMD')) or die "No RPM command!\n";
  $fh = new FileHandle "$rpmcmd $rootopts -q -a --queryformat '%{NAME} %{VERSION} %{RELEASE} %{ARCH}\n'|";
  defined $fh or die "Can't start rpm (GetCurrent)\n";
  while (<$fh>) {
    $self->debug (4, $_);
    ($name, $ver, $rel, $arch) = split;
    #<hack!>
    $arch eq "(none)" and $arch="none";
    # </hack!>
    if (defined ($name)) {
      $self->debug (4, " Got \$name=$name, \$version=$ver, \$release=$rel, \$arch=$arch\n");
      $data->{current}->{$name}->{"$ver-$rel.$arch"} = "$name-$ver-$rel";
    } else {
      print STDERR "Can't query installed package $_\n";
      return 0;
    }
  }
  return 1;
}

###############################################################################
# Return an array of root options
sub GetRootOpts {
  my @rootopts;

  return @rootopts unless defined $::opts{root};
  push @rootopts, '--root',  $::opts{root};
  push @rootopts, '--noscripts' unless $::opts{runscripts};
  @rootopts;
}

########################################################################
# Make a single pass through the wanted list.
# Upgrade everything that we only want one of.
# Install the new version for anything we want multiple versions of.

sub InstallStuff {
  my $self = shift;
  my $section = shift;
  my $what = shift;
  my $data = shift;

  my ($rpm, $do, $count, $rpmname, $vname, @rpms, $count1);
  $self->makedolist($section, $data);
  $do = $data->{do};

  #print "I think I need to install:\n";
  #foreach $rpmname (sort keys %$do) {
  #  print "  $rpmname -- requires " .  join (',', @{$do->{$rpmname}->{reqs}}) . ".\n";
  #  foreach $vname (keys %{$do->{$rpmname}->{vers}}) {
  #    print "    $vname\n";
  #  }
  #}
  #print "That's what I think I need to install\n";

  # Try to do it one rpm at a time.  Sort by increasing requirement count.
  while (scalar (@rpms = keys %$do)) {
    # Start with the first element
    $rpmname = $rpms[0];
    $count = @{$do->{$rpmname}->{reqs}};
    foreach $rpm (@rpms) {
      $count1 = @{$do->{$rpm}->{reqs}};
      if ($count1 < $count) {
	$count = $count1;
	$rpmname = $rpm;
      }
    }
    $self->InstallSome ($section, $what, '', $data, $rpmname, @{$do->{$rpmname}->{reqs}});
  }

  # Do everything that's left in a single transaction
  $self->makedolist($section, $data);
  $self->InstallSome ($section, $what, '', $data, keys %{$data->{do}});

  delete $data->{do};

  return 0;
}

###############################################################################
# Make the list of what needs to be installed.
# Also, make a new current list.

sub makedolist {
  my $self = shift;
  my $section = shift;
  my $data = shift;

  my ($name, $key, $root, $rpms, $rpmlist, $rname, $versions, $vname, $attrs, $rqename, $rpm);

  # Make a list of everything that needs installing...
  # Also avoid auto-vivication
  $data->{do} = {};
  $self->GetCurrent($data);
  $rpms = $self->find_node ($section, '/rpms');
  defined $rpms or return 0;
  $rpmlist = $rpms->getchildren ($section);
  foreach $rname (keys %$rpmlist) {
    if ($rname eq 'comps') {
      my $robot = 1;
    }
    $versions = $rpmlist->{$rname}->getchildren ($section);
    foreach $vname (keys %$versions) {
      $attrs = $versions->{$vname}->getattrs ($section);
      # Skip if we already have it
      (exists ($data->{current}->{$rname}) &&
       exists ($data->{current}->{$rname}->{$vname}) &&
       !$self->getoption('forceallrpms')) and next;

      # Skip if ifarch says it's not for us
      (defined ($attrs->{ifarch}) &&
       ($attrs->{ifarch} ne $data->{architecture})) and
	  next;

      # Copy it to the do list
      $data->{do}->{$rname}->{vers}->{$vname} = 
	{
	 dir => $attrs->{dir},
	 requires =>
	 (defined $attrs->{requires}?[split (/,/, $attrs->{requires})]:[]),
	};
      exists ($attrs->{basename}) and
	$data->{do}->{$rname}->{vers}->{$vname}->{basename} = $attrs->{basename};
    }
  }
  # $self->err ("Keys in \$self->{do}: " . join (' ', keys %{$self->{do}}) . ".\n");

  # Build the reverse dependency list (what depends on me)
  #$data->{revdep} = {};
  #foreach $rname (keys %{$data->{do}}) {
  #  foreach $vname (keys %{$data->{do}->{$rname}->{vers}}) {
  #    $rpm = $data->{do}->{$rname}->{vers}->{$vname};
  #    foreach $reqname (@{$rpm->{requires}}) {
#	$data->{revdep}->{$reqname}->{$rname} = 1;
#      }
#    }
#  }

  # Now descend the tree of dependencies, building the exhaustive list
  foreach $rname (keys %{$data->{do}}) {
    if ($rname eq 'elfutils-libelf') {
      my $foo = 1;
    }
    $data->{do}->{$rname}->{reqs} = [
				     $self->getallreqs ($data, $rname, {}, {})
				    ];
  }
}


# Return the (recursive, inclusive) list of everything
# required by $rpmname in $data->{do}
# Uses $data->{getallreqs_working}

sub getallreqs
{
  my $class = shift;
  my $data  = shift;
  my $rpmname = shift;
  my $visited = shift;

  my ($vname, $rpm, $reqname);
  my $reqlist = {};

  # Mark me as visited (do my children later)
  $visited->{$rpmname} = 1;

  # Now, visit all my children if they haven't been visited.
  foreach $vname (keys %{$data->{do}->{$rpmname}->{vers}}) {
    $rpm = $data->{do}->{$rpmname}->{vers}->{$vname};
    foreach $reqname (@{$rpm->{requires}}) {
      defined ($data->{do}->{$reqname}) and $reqlist->{$reqname} = 1;
      $visited->{$reqname} and next;
      # Visit that RPM if I need to install it
      exists ($data->{do}->{$reqname}) or next;
      foreach ($class->getallreqs ($data, $reqname, $visited)) {
	defined ($data->{do}->{$_}) and $reqlist->{$_} = 1;
      }
    }
  }
  return keys (%$reqlist);
}
########################################################################
# Install all the flavors of all the passed RPMs

sub InstallSome {
  my ($self, $section, $what, $indent, $data, @rpms) = @_;

  # If we have circular dependencies _and_ multiple versions of
  # one of them, we lose.  Hopefully, that never happens.

  my ($name, $key, $rattrs, $rkids, $dattrs, @upgrades, @installs, $path, %prefixed_installs, %prefixed_upgrades, $prefix);
  my ($checktriggers, $node);

  foreach $name (@rpms) {
    defined ($data->{do}->{$name}) or next;
    defined ($rkids  = $self->getchildren ($section, path => "/rpms/$name"))
      or next;
    foreach $key (keys %{$data->{do}->{$name}->{vers}}) {
      defined ($rattrs = $self->getattrs ($section, path => "/rpms/$name/$key")) or next;
      defined ($rattrs->{dir}) or next;
      defined ($dattrs = $self->getattrs ($section, path => "/dirs/$rattrs->{dir}")) or next;
      if (defined $rattrs->{basename}) {
	$path = "$dattrs->{dir}/$rattrs->{basename}";
      } else {
	$path = "$dattrs->{dir}/$name-$key.rpm";
      }

      #determine if there's a --prefix specified.  If not, $prefix should be ""
      if (defined $rattrs->{prefix}) {
	  $prefix = $rattrs->{prefix};
      } else{
	  $prefix = "";
      }




	#Wed Apr  4 14:16:10 CDT 2012
	#ok, I know why you're here.  It's because you're trying to figure out why
	#what is rpm -ivh'ing instead of -Uvh'ing.  It's either because you have version
	#mismatches in .i386 and .x86_64 rpms, or you are upgrading openafs versions and
	#you can't have a openafs-client-1.6.0 and openafs-client-1.6.1 (for example)
	#in two different kernels -- so you specify both and you try to -ivh the second
	#one instead of -Uvh.  Ugh.
      my $doinstall = 0;
      if (keys %$rkids > 1) {
	# Do upgrade instead of install when the multiple instances
	# are because of different architectures.  Otherwise, we think
	# there are two versions of an rpm, when there is only one, and
	# do an install instead of an upgrade, which causes errors.
	my (%archs);
	foreach (keys %$rkids) {
	  my ($pkg, $arch) = /(.*)(\.[^.]*)/;
          #$::opts{debug}>4 and print Dumper ($pkg);
          #$::opts{debug}>4 and print Dumper ($arch);
	  $archs{$pkg}=1;
	}
	$doinstall = 1 if keys %archs > 1;
      }

#       if ($doinstall) {
# 	push @installs, $path;
#       } else {
# 	push @upgrades, $path;
#       }

      #push $path into hash of arrays keyed on install prefix
      if ($doinstall) {
	  push(@{$prefixed_installs{$prefix}}, $path);
  	  $::opts{debug}>4 and print "prefixed_install:\n";
  	  $::opts{debug}>4 and print Dumper ($path);
      } else {
	  push(@{$prefixed_upgrades{$prefix}}, $path);
  	  $::opts{debug}>4 and print "prefixed_upgrades:\n";
  	  $::opts{debug}>4 and print Dumper ($path);
      }

      # Check for triggers (later)
      $checktriggers->{$name}->{$key} = 1;

      # Mark it as installed now
      $data->{current}->{$name}->{$key} = "installed";
    }
    # Say I don't have to install it any more
    delete $data->{do}->{$name};
  }

#  scalar (@installs) and $self->RunRPM ($what, $indent, '-i', @installs);
#  scalar (@upgrades) and $self->RunRPM ($what, $indent, '-U', @upgrades);

  scalar (%prefixed_installs) and $self->RunRPM ($what, $indent, '-i', %prefixed_installs);
  scalar (%prefixed_upgrades) and $self->RunRPM ($what, $indent, '-U', %prefixed_upgrades);

  foreach $name (keys %$checktriggers) {
    foreach $key (keys %{$checktriggers->{$name}}) {
      # Get the node
      defined ($node = $self->find_node ($section, "/rpms/$name/$key", 0))
	or next;
      # Run triggers iff needed
      $node->run_triggers ($section, $what, "/Rpms/rpms/$name/$key");
    }
  }


  return 0;
}


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

sub RemoveStuff {
  my $self = shift;
  my $section = shift;
  my $what = shift;
  my $data = shift;

  my ($name, $key, $rpm, $this);
  my $tried = 0;
  my %rpms = ();
  my $die_dollar_under_die;

  $self->GetCurrent($data);

  # Reverse check - Delete any packages that we don't want
  $self->debug (3, "Removing unwanted rpms\n");
  foreach $name (keys %{$data->{current}}) {
    foreach $key (keys %{$data->{current}->{$name}}) {
      $rpm = $self->find_node ($section, "/rpms/$name/$key");
      if (!defined ($rpm)) {
	# Delete the rpm if there are multiple versions installed --or--
	# we don't want any versions installed.
	# (I.e. don't delete the last if we want one installed)
	if (keys %{$data->{current}->{$name}} > 1 ||
	    !exists $data->{node}->{rpms}->{$name} ||
	    !keys %{$data->{node}->{rpms}->{$name}}) {
	  # 7/6/05 include the arch in the thing to delete
	  # push @rpms, $data->{current}->{$name}->{$key};
	  # <HACK>
	  # 5/16/08 Can't remove old signing keys with .none (arch) present
	  ($this = "$name-$key") =~ s/^(gpg-pubkey-.*)\.none/$1/;
	  # </HACK>
	  push @{$rpms{''}}, $this;
	  delete $data->{current}->{$name}->{$key};
	  keys %{$data->{current}->{$name}} or
	    delete $data->{current}->{$name};
         #Fri Oct 26 14:34:21 CDT 2012 timc@cs.wisc.edu
         #httpd is treated slightly differently as it *always* needs to uninstall with a --noscripts argument
         if ($name eq 'httpd') {
            $::opts{debug}==3 and print "foobar\n";
            $::opts{debug}==3 and print "name: $name\n";
            $::opts{debug}==3 and print "name-key: $name-$key\n";
         } #if
	}
      }
    }
  }

  $::opts{debug}==3 and print "dwa\n";
  $::opts{debug}==3 and print Dumper(\%rpms);
  foreach $die_dollar_under_die (keys %rpms) {
     $::opts{debug}==3 and print "fuuuuuu: $die_dollar_under_die\n";
  }

  %rpms and return $self->RunRPM ($what, '', '-e', %rpms);
  return 0;
}

########################################################################
# Run the rpm command with appropriate version variances.

sub RunRPM {
  my $self = shift;
  my $what = shift;
  my $indent = shift;
  #my ($mode, @args) = @_;
  my ($mode, %prefixed_args) = @_;

  my @args;
  my @rpmargs;
  my $prefix;
  my $return;

  
  #go through hash by keys -- keys are the prefix, values are @args just like before
  foreach $prefix (keys %prefixed_args) {
      #set @args to be value of the $prefix key -- which is an array
      @args = @{$prefixed_args{$prefix}};
      @rpmargs = ($mode eq '-e') ? () : @{$self->getoption('RPM_INSTALL_ARGS')};

      #if a prefix exists, add it as an rpmarg
      if ($prefix) {
	  #$prefix exists and should be the argument to --prefix
	  push @rpmargs, '--prefix', $prefix;
      } #if

      $return = $self->do_system ($what, $indent,
				  $self->getoption('RPMCMD'),
				  @rpmargs,
				  $self->GetRootOpts,
				  $mode, @args);
	  
  } #foreach



      
  #if ($return) {
  #  die "$RPMCMD returned $return!\n";
  #}
  return $return;

}


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

sub do_system() {
  my $self = shift;
  my $what = shift;
  my $indent = shift;
  my (@argv) = @_;

  $self->debug (1, $indent . join (' ', @argv) . "\n");
  $self->getoption ('donothing') and return 0;
  return ((system (@argv)) >> 8);
}


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

# Here are the mkrpms bits

# Data structures:
# $self in mkrpms is not a What::Node::* class.

# It is a Big Data Structure.  It has several children,
# which look like:

# $self->{master}
# Is an XML::Simple read of the master file.

# $self->{comps}
# Is an XML::Simple read of the comps file specified by $self->{master}

# $self->{work}
# Contains intermediate working data.  Initially built by setup by
# inverting the rpms and comps data from the master file.
# $self->{work}->{$pkgname}->{comps}
# ...are the comps structures inverted by setup.  They are then expanded
# into $self->{work}->{$pkgname}->{rpms}.
#
# $self->{work}->{$pkgname}->{rpms}->{$rpmname}
# ...is an arrayref of hashrefs.  Each hash corresponds to one wanted RPM, and
# contains attrs like version, release, noimplicitdeps, dirs, etc.  These
# entries are created by addrpm.

# $self->{rpms}
# Contains data read from the various directories specified in $self->{master}
#
# $self->{rpms}->{dirs}->{$groupname}->{$rpmname}
# ...is an array of hashrefs.  Each hash corresponds to an rpm file found by
# read_dir.  read_dir creates these entries.
#
# $self->{rpms}->{dirnames}->{$dirname}
# ...is a scalar corresponding to the path to look for RPMs
# (at rpm install time) for any rpms that list $dirname as their source
# directory.
#
# $self->{rpms}->{provides}->{$attr}->{$groupname}->{$rpmname}
# ...is an arrayref of hashrefs.  The hashes pointed to are the same ones
# in $self->{rpms}->{dirs}->{$groupname}->{$rpmname}->[].

# $self->{final}->{$pkgname}->{$rpmkey}->{ work =>, dirs => }
# Contains the final data.  The {work} hashref points to the
# $self->{work}->{$pkgname}->{rpms}->{$rpmname} hash, and the {dirs} hashref
# points to the $self->{rpms}->{dirs}->{$groupname}->{$rpmname}->[] hashref.

sub mkrpms {

  my $source = shift;
  my $masterfile = shift;

  my $self = bless {}, (ref($source) ? ref($source) : $source);

  if (!defined $masterfile) {
    $self->err ("No config file specified!!\n");
    return -1;
  }

  # Get my master configuration
  $self->mk_readmaster ($masterfile);

  # Get the Red Hat comps file
  $self->mk_readcomps;

  # Create the initial framework for the output rpms
  $self->mk_setup;

  # Expand the comps entries into rpm entries
  $self->mk_expandpckgs;

  # Deal with implicit dependencies
  $self->mk_implicitdeps;

  # Read the RPM directories and create the final config
  $self->mk_genlist;

  # Resolve lingering RPM provides/requires dependency issues
  $self->mk_rpm_requires;

  # Write the output files
  $self->mk_writefiles;

  return 0;

}


###############################################################################
sub mk_readmaster {
  my $self = shift;
  my $master = shift;

  eval {
    $self->{master} =   XMLin (
			       $master,
			       keyattr => {
					   dir => 'name',
					   preferred_arch => 'name',
					  },
			       forcearray => [
					      'rpms',
					      'comps',
					      'source',
					     ],
			      );
  };
  if ($@) {
    die "Failed to read master data file $master.\nReason follows:\n$@";
  }

  # print Dumper $config;
  exists ($self->{master}->{content}) and delete $self->{master}->{content};

}

###############################################################################
# Iterate through the $self->{master} data rpms and comps, creating
# $self->{work}->{$pkgname} data structures for every package
# found in the master data.

sub mk_setup {
  my $self = shift;

  my ($comp, $pkgname, $reqcomp, $rpm, $tcomp, $attr);

  # It's first-in-wins in addrpm, so prefer direct RPMs in the master
  # config to groups.
  foreach $rpm (@{$self->{master}->{rpms}}) {
    foreach $pkgname (split (/\s*,\s*/, $rpm->{pckgs})) {
      if (defined ($rpm->{action}) &&
	  ($rpm->{action} eq 'delete' || $rpm->{action} eq 'replace')) {
	defined ($self->{work}->{$pkgname}->{rpms}->{$rpm->{name}}) and
	  delete $self->{work}->{$pkgname}->{rpms}->{$rpm->{name}};
      }
      if (!defined ($rpm->{action}) || $rpm->{action} ne 'delete') {
	# Default is to add it
	$self->mk_addrpm ($pkgname, %$rpm);
      }
    }
  }

  foreach $comp (@{$self->{master}->{comps}}) {
    foreach $pkgname (split (/,/, $comp->{pckgs})) {
      if (defined ($self->{work}->{$pkgname}->{comps}->{$comp->{group}})) {
	$::opts{debug}>2 and print STDERR "Group $comp->{group} for package $pkgname specified multiple times!\n";
	next;
      }
      $tcomp = {};
      foreach $attr ('dirs', 'prior', 'use', 'nouse', 'nouseall', 'useall') {
	exists ($comp->{$attr}) and $tcomp->{$attr} = $comp->{$attr};
      }
      $self->{work}->{$pkgname}->{comps}->{$comp->{group}} = $tcomp;
    }
  }

  $::opts{debug}>4 and print Dumper ($self);
  return 1;
}


###############################################################################
# Add packages that are only listed in the <package> section
# of the comps file.

sub mk_implicitdeps {
  my $self = shift;

  my $comps  = $self->{comps};
  my $work = $self->{work};
  my ($packagename, $rpmname, $rpm);

  foreach $packagename (keys %$work) {
    foreach $rpmname (keys %{$work->{$packagename}->{rpms}}) {
      $rpm = $work->{$packagename}->{rpms}->{$rpmname}->[0];
      (exists ($rpm->{noimplicitdeps}) &&
       defined ($rpm->{noimplicitdeps}) &&
       $rpm->{noimplicitdeps}) and next;
      $self->mk_chkimplicit ($packagename, $rpmname);
    }
  }
}


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

sub mk_chkimplicit {
  my $self = shift;
  my $package = shift;
  my $rpmname = shift;

  my $comps  = $self->{comps};
  my $dep;

  if (!defined ($comps->{package}->{$rpmname})) {
    $::opts{debug}>3 and print STDERR "No comps dependencies found for $rpmname!\n";
    return;
  }

  foreach $dep (@{$comps->{package}->{$rpmname}->{dependencylist}->{dependency}}) {
    if (!defined ($self->{work}->{$package}->{rpms}->{$dep})) {
      $::opts{debug}>2 and print STDERR "Adding implicit dependency $dep required by $rpmname ($package).\n";
      $self->mk_addrpm ($package, name => $dep);
      $self->mk_chkimplicit ($package, $dep);
    }
  }
}


###############################################################################
# Ensure that every requires item of every RPM in each group is satisfied
# by another RPM in the group.  Search and add if necessary.

sub mk_rpm_requires {
  my $self = shift;

  my $final = $self->{final};
  my ($pkgname, $rpmkey, $workrpm, $dirsrpm, $reqname, $rpmname);

  foreach $pkgname (keys %$final) {
    foreach $rpmkey (keys %{$final->{$pkgname}}) {
      $self->mk_satisfy_requirements ($pkgname, $rpmkey);
    }
  }
}


########
# Satisfy the requirements of $rpmname in $package.  The requisites of
# any added RPM are resolved by calling mk_satisfy_requirements
# recursively when the requisite RPMs are added to {final}.

sub mk_satisfy_requirements {
  my $self = shift;
  my $pkgname = shift;
  my $rpmkey = shift;

  my $final = $self->{final};
  my ($workrpm, $dirsrpm, $reqname, $rpmname);
  my $ok = 1;

  # $workrpm is the one I requrested (from master)
  $workrpm = $final->{$pkgname}->{$rpmkey}->{work};
  # $dirsrpm is the one it found (from read_dir)
  $dirsrpm = $final->{$pkgname}->{$rpmkey}->{dirs};

  # Skip rpms that don't want dependency checking
  if ($workrpm->{noimplicitdeps}) {
    return 1;
  }

  foreach $reqname (keys %{$dirsrpm->{requires}}) {
    # See if this is already satisfied, or
    # find an rpm that satisfies it.
    if (defined ($rpmname = $self->mk_require_is_satisfied
		 (
		  $pkgname,
		  $reqname,
		  $dirsrpm->{requires}->{$reqname},
		 ))) {
      $final->{$pkgname}->{$rpmkey}->{reqrpms}->{$rpmname} = 1;
    } elsif (defined ($rpmname = $self->mk_provide_requirement
		      (
		       $pkgname,
		       $rpmkey,
		       $reqname,
		      ))) {
      $final->{$pkgname}->{$rpmkey}->{reqrpms}->{$rpmname} = 1;
    } else {
      $self->err ("Failed to satisfy $reqname for ($pkgname, $rpmkey).\n");
      $ok = 0;
    }
  }
  return $ok;
}




########
# Return true if the requirement ($reqname, $requirement) is
# already satisfied in package $pkgename.

sub mk_require_is_satisfied {
  my $self = shift;
  my $pkgname = shift;
  my $reqname = shift;
  my $requirement = shift;

  my ($key, $dirsrpm, $prokey, $provision);

  # short cut if never present
  exists ($self->{rpms}->{provides}->{$reqname}) or return undef;

  # Long search
  foreach $key (keys %{$self->{final}->{$pkgname}}) {
    $dirsrpm = $self->{final}->{$pkgname}->{$key}->{dirs};
    exists ($dirsrpm->{provides}->{$reqname}) or next;
    $provision = $dirsrpm->{provides}->{$reqname};
    if ($self->mk_check_provides ($provision, $requirement)) {
      return $dirsrpm->{name};
    }
  }
  return undef;
}



########
# Check version numbers and operators in requirements
# $provision is a single hash provided by an rpm.
# Return true if the provision meets the requirement.

sub mk_check_provides {
  my $self = shift;
  my $provision = shift;
  my $requirement = shift;

  my $res;

  # If the provision doesn't specify a version, it satisfies everything.
  defined ($provision) or return 1;

  # If the requirement doesn't specify a version, we're good to go.
  defined ($requirement) or return 1;

  # Possible operators are =, >=, <=
  if (!defined $provision->{op}) {
    print STDERR "provision->{op} undefined!\n";
  }
  if (!defined $requirement->{op}) {
    print STDERR "requirement->{op} undefined!\n";
  }

  if ($provision->{op} eq '=') {
    if ($requirement->{op} eq '=') {
        my @arg1 = split (/-/, $provision->{value});
	my @arg2 = split (/-/, $requirement->{value});
	while (@arg1 && @arg2) {
	  ($res = mk_isnewer ($arg1[0], $arg2[0])) and return 0;
	  shift @arg1;
	  shift @arg2;
	}
	# If the provision put in a release, and the requirement didn't,
	# they are still 'equal'.
	scalar (@arg1) and return 1;
	# If they both ran out at the same time, we're good.
	scalar (@arg2) or return 1;
	# Otherwise, no good.
	return 0;
    } elsif ($requirement->{op} eq '<=') {
      return (mk_isnewer ($provision->{value}, $requirement->{value}) < 1);
    } elsif ($requirement->{op} eq '>=') {
      return (mk_isnewer ($provision->{value}, $requirement->{value}) > -1);
    } elsif ($requirement->{op} eq '>') {
      return (mk_isnewer ($provision->{value}, $requirement->{value}) > 0);
    } elsif ($requirement->{op} eq '<') {
      return (mk_isnewer ($provision->{value}, $requirement->{value}) < 0);
    } else {
      $self->err ("Hold it, Jack! What's the req operator '$requirement->{op}'!\n");
    }
  } elsif ($provision->{op} eq '<=') {
    $self->err ("Hold it, Jack! What's the provision operator '$provision->{op}'!\n");
  } else {
    $self->err ("Hold it, Jack! What's the provision operator '$provision->{op}'!\n");
  }
  return 0;
}


########
# Provide the given requirement for the given package.  The requirement is
# $self->{final}->{$pkgname}->{$rpmkey}->{requires}->{$reqname}

sub mk_provide_requirement
{
  my $self = shift;
  my $pkgname = shift;
  my $rpmkey = shift;
  my $reqname = shift;

  # print STDERR "mk_provide_requirement: Called upon to provide $reqname for $pkgname:$rpmkey.\n";

  # See if it's defined _anywhere_
  if (!defined $self->{rpms}->{provides}->{$reqname}) {
    $self->err ("$reqname never provided for RPM $rpmkey, package $pkgname.\n");
    return undef;
  }

  # Search the group(s) the requirement rpm came from first
  my (@desiredgroups, $res);
  if (defined $self->{final}->{$pkgname}->{$rpmkey}->{work}->{dirs}) {
    @desiredgroups = split /\s*,\s*/, $self->{final}->{$pkgname}->{$rpmkey}->{work}->{dirs};
  }

  if (@desiredgroups) {
    $self->debug (3, "mk_provide_requirement: Checking " . join (',', @desiredgroups) . " for $reqname first...\n");
    if (defined ($res = $self->mk_provide_req_list ($pkgname, $rpmkey, $reqname, @desiredgroups))) {
      $self->debug (3, "mk_provide_requirement: found $res\n");
      return $res;
    }
  } else {
    @desiredgroups = split /\s*,\s*/, $self->{master}->{defaults}->{dirs};
    $self->err ("No dirs found ($pkgname: $rpmkey needs $reqname).  Trying default dirs " . join (',', @desiredgroups) . "...\n");
    if (defined ($res = $self->mk_provide_req_list ($pkgname, $rpmkey, $reqname, @desiredgroups))) {
      $self->debug (3, "mk_provide_requirement (defaults): found $res\n");
      return $res;
    }
  }


  # Last ditch effort, search _all_ the groups
  my @searchgroups = keys %{$self->{rpms}->{dirs}};
  # print STDERR "mk_provide_requirement: found last ditch, searching " . join (',', @searchgroups) . "\n";
  return $self->mk_provide_req_list ($pkgname, $rpmkey, $reqname, @searchgroups);

}

########
# For each directory, try to satisfy the requirement in $reqname.
# If more than on distinct RPM satisfies, warn the user and bail.
# If multiple versions are found of a single RPM, choose the latest.
sub mk_provide_req_list
{
  my $self = shift;
  my $pkgname = shift;
  my $rpmkey = shift;
  my $reqname = shift;
  my @searchgroups = @_;

  # my $dumpname = 'XFree86-base-fonts';
  my $dumpname = 'XXXXXXXXXX';

  $::opts{debug}>1 and print STDERR "$rpmkey needs $reqname.  Searching " . join (',', @searchgroups) . ".\n";

  my $requirement = $self->{final}->{$pkgname}->{$rpmkey}->{dirs}->{requires}->{$reqname};

  if ($reqname eq $dumpname) {
    print "Final data: " . Dumper $self->{final}->{$pkgname}->{$rpmkey};

  }

  my ($pgroup, $test, $rpm, $groupname, $rpmprovider, $providers, $foundgroup);
  my $provision = $self->{rpms}->{provides}->{$reqname};

  if ($reqname eq $dumpname) {
    print STDERR "Provision: " . join (',', keys %$provision) . "\n";
  }
  # Search the list
  foreach $groupname (@searchgroups) {
    # I don't know why $groupname is sometimes undefined.  It just is.
    defined ($groupname) or next;
    defined ($provision->{$groupname}) or next;

    $pgroup = $provision->{$groupname};
    foreach $rpmprovider (keys %$pgroup) {
      ($reqname eq $dumpname) and print STDERR "   Checking $rpmprovider...\n";
      foreach $test (@{$pgroup->{$rpmprovider}}) {
	if (!exists $test->{provides}->{$reqname}) {
	  print STDERR "$rpmprovider doesn't provide $reqname!!\n";
	}
	if ($reqname eq $dumpname) {
	  print STDERR "Test: " . Dumper $test;
	  print STDERR "Rpm: " . Dumper $rpm;
	}
	if ($self->mk_check_provides ($test->{provides}->{$reqname}, $requirement )) {
	  $::opts{debug}>1 and print STDERR "$test->{name} $test->{version} $test->{release} from $test->{groupname} satisfies $reqname of $rpmkey ($pkgname)\n";
	  # Count the distinct RPMs that satisfy the requirement
	  $providers->{$rpmprovider} = 1;
	  # Pick the newest one
	  if (!defined ($rpm) || ($self->mk_more_preferred ($test, $rpm) > 0)) {
	    $::opts{debug}>1 and print STDERR "Choosing $test->{name}-$test->{version}-$test->{release}.$test->{arch} from $test->{groupname} to satisfy $reqname of $rpmkey ($pkgname)\n";
	    $rpm = $test;
	  } else {
	    $::opts{debug}>1 and print STDERR "Skipping $test->{name}-$test->{version}-$test->{release}.$test->{arch} from $test->{groupname} to satisfy $reqname of $rpmkey ($pkgname)\n";
	  }
	}
      }
    }
  }
  if (keys (%$providers) > 1) {
    $self->err ("Multiple RPMs provide $reqname (" . join (',', keys (%$providers)) . ").\n");
    $self->err ("Please add one of them to the master file\n.");
    return undef;
  }
  if (defined $rpm) {
    $self->err ("Resolving RPM dependency for $reqname from $rpm->{name}-$rpm->{version}-$rpm->{release} ($rpm->{groupname}).\n");
    # There is no rpm from the work area (this is
    # an implicit dependency), so let the rpm from read_dir
    # take its place.
    my $newkey = $self->mk_add_to_final ($pkgname, $rpm, $rpm);
    $self->mk_satisfy_requirements ($pkgname, $newkey);
    return $rpm->{name};
  }

  return undef;
}


###############################################################################
# Write the final configs to a set of output files

sub mk_writefiles{
  my $self = shift;

  my ($pkgname, $rpmkey, $rpm, $workrpm, $fh, $date, $basename, %needdirs);
  $date = `date`;
  chomp $date;
  foreach $pkgname (keys %{$self->{final}}) {
    %needdirs = ();
    $fh = new FileHandle "$self->{master}->{outdir}/$pkgname.rpms.xml", "w";
    if (!defined ($fh)) {
      $::opts{debug}>0 and print STDERR "Failed to open output file $self->{master}->{outdir}/$pkgname.rpms!\n";
      next;
    }
    print $fh <<__Eof__
<!-- THIS FILE IS AUTOMATICALLY GENERATED -->
<!-- CHANGES MADE BY HAND WILL BE LOST -->
<!-- Last built $date by $0 -->

<what>

__Eof__
  ;

    # RPMs
    foreach $rpmkey (sort keys %{$self->{final}->{$pkgname}}) {
      $rpm = $self->{final}->{$pkgname}->{$rpmkey}->{dirs};
      $workrpm = $self->{final}->{$pkgname}->{$rpmkey}->{work};
      $needdirs{$rpm->{dirname}}=1;
      print $fh "  <node path=\"/Rpms/rpms/$rpm->{name}/$rpm->{version}-$rpm->{release}.$rpm->{arch}\" dir=\"$rpm->{dirname}\" ";

      $basename = "$rpm->{name}-$rpm->{version}-$rpm->{release}.$rpm->{arch}.rpm";
      ($rpm->{basename} ne $basename) and print $fh " file=\"$rpm->{basename}\" ";

      (defined $workrpm->{ifarch}) and print $fh " ifarch=\"$workrpm->{ifarch}\" ";

      # Remove self-dependencies now
      delete $self->{final}->{$pkgname}->{$rpmkey}->{reqrpms}->{$rpm->{name}};

      if (keys %{$self->{final}->{$pkgname}->{$rpmkey}->{reqrpms}}) {
	printf $fh " requires=%s%s%s ",
	  '"',
	    join (",", sort (keys %{$self->{final}->{$pkgname}->{$rpmkey}->{reqrpms}})),
	      '"';
      }

      print $fh " />\n";
    }

    print $fh "\n";

    # Directories
    my $dirname;
    foreach $dirname (sort keys %needdirs) {
      print $fh "  <node path=\"/Rpms/dirs/$dirname\" dir=\"$self->{rpms}->{dirnames}->{$dirname}\" />\n";
    }

    print $fh "</what>\n";
    undef $fh;
  }
}

###############################################################################
# Find the most up-to-date match for each rpm specified in $self->{work}

sub mk_genlist {
  my $self = shift;

  my $work = $self->{work};
  my ($pkgname, $rpmname, $workrpm, $groupname, $test, $dirsrpm);

  foreach $pkgname (keys %$work) {
    foreach $rpmname (keys %{$work->{$pkgname}->{rpms}}) {
      foreach $workrpm (@{$work->{$pkgname}->{rpms}->{$rpmname}}) {

	# look through the directories listed for the RPM
	# and find the best match for the RPM
	$dirsrpm = undef;
	foreach $groupname (split (/,/, $workrpm->{dirs})) {
	  $self->mk_read_dir ($groupname);
	  foreach $test (@{$self->{rpms}->{dirs}->{$groupname}->{$rpmname}}) {
	    ($workrpm->{version} ne 'any'
	     && $workrpm->{version} ne $test->{version}) and next;
	    ($workrpm->{release} ne 'any'
	     && $workrpm->{release} ne $test->{release}) and next;
	    ($workrpm->{arch}    ne 'any'
	     && $workrpm->{arch}    ne $test->{arch})    and next;
	    if (!defined $dirsrpm) {
	      $self->debug (2, "Trying $rpmname-$test->{version}-$test->{release}-$test->{arch} for $pkgname from $groupname!\n");
	      $dirsrpm = $test;
	    }
	    if ($self->mk_more_preferred ($test, $dirsrpm) > 0) {
	      $self->debug (2, "Updating $rpmname ($dirsrpm->{version}-$dirsrpm->{release}-$dirsrpm->{arch}) to $test->{version}-$test->{release}-$test->{arch} for $pkgname from $groupname!\n");
	      $dirsrpm = $test;
	    }
	  }
	}
	if (defined $dirsrpm) {
	  $self->debug (2, "Adding $rpmname-$dirsrpm->{version}-$dirsrpm->{release}-$dirsrpm->{arch} to final for $pkgname!\n");
	  $self->mk_add_to_final ($pkgname, $workrpm, $dirsrpm);
	} else {
	  $self->err ("Found no RPMs for $rpmname in $pkgname!\n");
	}
      }
    }
  }
  return;
}

sub mk_add_to_final {
  my $self = shift;
  my $pkgname = shift;
  my $workrpm = shift;
  my $dirsrpm = shift;

  my $key = "$dirsrpm->{name} $dirsrpm->{version} $dirsrpm->{release} $dirsrpm->{arch}";
  (defined $workrpm->{ifarch}) and $key .= $workrpm->{ifarch};
  $self->{final}->{$pkgname}->{$key}->{work} = $workrpm;
  $self->{final}->{$pkgname}->{$key}->{dirs} = $dirsrpm;
  return $key;
}

###############################################################################
# Like isnewer, but also include architecture preference

sub mk_more_preferred {
  my $self = shift;
  my $a = shift;
  my $b = shift;

  my $res;
  # Try to differentiate based on version or release
  return $res if ($res = mk_isnewer ($a->{version}, $b->{version}));
  return $res if ($res = mk_isnewer ($a->{release}, $b->{release}));


  # If versions and releases are the same,
  # try to differentiate based on architecture
  if (defined ($a->{arch}) && length ($a->{arch})) {
    return (1) unless (defined ($b->{arch}) && length ($b->{arch}));
  } else {
    return (-1) unless (defined ($b->{arch}) && length ($b->{arch}));
    return 0;
  }
  # Both architectures defined.....keep going with special cases
  my $preferred_arch = $self->{master}->{preferred_arch};
  return 0 unless defined $preferred_arch;
  if (defined $preferred_arch->{$a->{arch}}->{weight}) {
    return 1 unless defined $preferred_arch->{$b->{arch}}->{weight};
  } else {
    return -1 unless defined $preferred_arch->{$b->{arch}}->{weight};
  }

  # Now check and return
  return ($preferred_arch->{$a->{arch}}->{weight} <=>
	  $preferred_arch->{$b->{arch}}->{weight});
}

###############################################################################
# Compare the versions/releases passed as args
# use RPM::vercmp from Perl-RPM at http://search.cpan.org/dist/Perl-RPM/ to
# make the tough decisions.  Duplicate the same form that is previously used
# when mk_isnewer is called.
#     vercmp($verA, $relA, $verB, $relB)
# mk_isnewer only gets split versions passed in from above, so usage below has
# null values for verA, verB.

sub mk_isnewer {
  my ($new, $old) = @_;

  # Hack, hack, hack...if one of the args begins with /\d+:/ and the other
  # doesn't, just ignore it.  How stupid can this thing get?
  $old =~ /^\d+:/ or $new =~ s/^\d+://;
  $new =~ /^\d+:/ or $old =~ s/^\d+://;

  #ok to pass in a null version and just compare releases
  #return (RPM::vercmp("", $new, "", $old));
  return (RPM2::rpmvercmp($new, $old));
}



###############################################################################
# sub mk_isnewer_old
# Compare the versions/releases passed as args
# problem with this is that it makes less-than-optimal decisions when faced
# with choosing between certain RPMS.  As an example:
# bind_utils-9.3.4-6.0.2.P1.el5_2.i386.rpm
# bind_utils-9.3.4-6.P1.el5.i386.rpm
# or
# kernel-2.6.18-92.1.6el5.i386.rpm
# kernel-2.6.18-92el5.i386.rpm
#  -- in both cases the first is newer, but mk_isnewer unfortunately doesn't 
#     find that to be the case. 


sub mk_isnewer_old {
  my ($new, $old) = @_;

  my ($debug, $pnew, $pold);

  # Hack, hack, hack...if one of the args begins with /\d+:/ and the other
  # doesn't, just ignore it.  How stupid can this thing get?
  $old =~ /^\d+:/ or $new =~ s/^\d+://;
  $new =~ /^\d+:/ or $old =~ s/^\d+://;

  $debug=0;
  # Strip path components
  while (1) {
    $debug and print STDERR "Comparing $new with $old\n";
    # Get next element from version
    if ($new =~ /^(\d+)(.*)$/) {
      # Make next compare numeric
      ($pnew, $new) = ($1,$2);
      if (!($old =~ /^(\d+)(.*)$/)) {
        $debug && print STDERR "Numeric $pnew from new, nothing from old\n";
        return 1;
      }
      ($pold, $old) = ($1, $2);
      if ($pnew != $pold) {
        return ($pnew <=> $pold);
      }
      next;   # Get some more
    } elsif ($new =~ /^(\D+)(.*)$/) {
      # Make next compare alpha
      ($pnew, $new) = ($1, $2);
      if (!($old =~ /^(\D+)(.*)$/)) {
        $debug && print STDERR "Alpha $pnew from new, nothing from old\n";
        return 1;
      }
      ($pold, $old) = ($1,$2);
      if ($pnew ne $pold) {
        return ($pnew cmp $pold);
      }
      next;   # Get some more
    } else {
      $debug && print STDERR "I guess they are equal?\n";
      return ($new cmp $old);
    }
  }
}

###############################################################################
# Read a directory into the config structure

sub mk_read_dir {
  my $self = shift;
  my $groupname   = shift;

  defined ($self->{rpms}->{dirs}->{$groupname}) and return 1;

  my ($source, $dh, $de, $install, $fh);
  my ($name, $version, $release, $arch);
  my ($requires, $provides, $rpm, $attr, $op, $value, @des);
  my $mastergroup = $self->{master}->{dir}->{$groupname};
  my $skipdeps = $mastergroup->{skipdeps} || 0;

  my $group = $self->{rpms}->{dirs}->{$groupname} = {};

  my ($sourceidx, $dirname) = (0, undef);
  foreach $source (@{$mastergroup->{source}}) {
    if (!defined ($mastergroup->{install})) {
      if ($sourceidx) {
	$dirname = sprintf "%s-%d", $groupname, $sourceidx;
      } else {
	$dirname = $groupname;
      }
      $sourceidx++;
    } else {
      $dirname = $groupname;
    }
    $install = $source;
    $install =~ s:/$::;
    defined ($mastergroup->{install}) and $install = $mastergroup->{install};
    $self->{rpms}->{dirnames}->{$dirname} = $install;
    $dh = new DirHandle $source;
    if (!defined $dh) {
      $::opts{debug}>0 and print STDERR "Can't open directory $source for group $groupname!\n";
      next;
    }
    $::opts{debug}>0 and print STDERR "Reading $source\n";
    @des = ();
    while (defined ($de = $dh->read)) {
      ($de =~ /\.rpm$/) || next;
      push @des, $de;
    }
    foreach $de (sort @des) {
      ($name, $version, $release, $arch) = ($de =~ /^(.*)-([^-]+)-([^-]+)\.(i\d+|noarch|athlon|x86_64|ia32e|ia64|none).rpm$/);
      if (!defined $name) {
	$::opts{debug}>1 and print STDERR "Can't parse rpm $source/$de!\n";
	next;
      }

      # Include the name in the structure
      # so that I can just point to it in mk_genlist later.
      # Also, provide the group name for mk_provide_requirement
      $rpm = {
	      groupname=> $groupname,
	      name     => $name,
	      dirname  => $dirname,
	      basename => $de,
	      version  => $version,
	      release  => $release,
	      arch     => $arch,
	      provides => undef,
	      requires => undef,
	     };

      $self->read_deps ("$source/$de", $rpm) unless $skipdeps;

      # Add to the list for this $name.  
      exists ($group->{$name}) or $group->{$name} = [];
      push @{$group->{$name}}, $rpm;
    }
  }
}

###############################################################################
# Read the provides/requires for the rpm into the structure
sub read_deps {
  my $self = shift;
  my $file = shift;
  my $rpm = shift;

  my ($fh, $attr, $op, $value, $attr_provides, $groupname, $name);

  # Only read once
  return if defined ($rpm->{provides});

  $rpm->{provides} = {};
  $rpm->{requires} = {};

  # Read the RPM, and get the provides and requires information
  # Get --provides and -l in one step...
  $::opts{debug}>3 and print STDERR "Reading $file\r";
  $fh = new FileHandle "/s/what-0.1.31/depend/rpm -q --provides -l -p $file |";
  defined ($fh) or die "/s/what-0.1.31/depend/rpm -q --provides -p $file failed!!\n";
  while (<$fh>) {
    $::opts{debug}>3 and print STDERR "$file PROVIDES $_";
    chomp;
    if (/^\s*(\S+)\s+([\<\>\=]+)\s+(\S+)\s*$/) {
      ($attr, $op, $value) = ($1, $2, $3);
      ($op eq '=') or $self->err ("Uh-oh! $file provides $_!!\n");
      $rpm->{provides}->{$attr} = {
				   op => $op,
				   value => $value,
				  };
    } else {
      s/\s+$//;
      $attr = $_;
      $rpm->{provides}->{$attr} = undef;
    }
    $self->{rpms}->{provides}->{$attr} = {} unless $self->{rpms}->{provides}->{$attr};
    ($attr_provides, $groupname, $name) = 
      ($self->{rpms}->{provides}->{$attr}, $rpm->{groupname}, $rpm->{name});
    defined ($attr_provides->{$groupname}->{$name})
      or $attr_provides->{$groupname}->{$name} = [];
    push @{$attr_provides->{$groupname}->{$name}}, $rpm;
  }

  $fh = new FileHandle "/s/what-0.1.31/depend/rpm -q --requires -p $file |";
  defined ($fh) or die "/s/what-0.1.31/depend/rpm -q --requires -p $file failed!!\n";
    while (<$fh>) {
    $::opts{debug}>4 and print STDERR "$file REQUIRES $_";
    chomp;
    if (/^\s*(\S+)\s+([\<\>\=]+)\s+(\S+)\s*$/) {
      ($attr, $op, $value) = ($1, $2, $3);
      $rpm->{requires}->{$attr} = {op => $op, value => $value};
    } else {
      s/\s+$//;
      $attr = $_;
      $rpm->{requires}->{$attr} = undef;
    }
  }

  # Hack up the rpmlib dependencies
  delete $rpm->{requires}->{'rpmlib(CompressedFileNames)'};
  delete $rpm->{requires}->{'rpmlib(PartialHardlinkSets)'};
  delete $rpm->{requires}->{'rpmlib(PayloadFilesHavePrefix)'};
  delete $rpm->{requires}->{'rpmlib(VersionedDependencies)'};
  delete $rpm->{requires}->{'rpmlib(PayloadIsXz)'};
  delete $rpm->{requires}->{'rpmlib(FileDigests)'};
  delete $rpm->{requires}->{'rpmlib(BuiltinLuaScripts)'};
}

###############################################################################
# Expand the comp groups in the rpm entries and handle
# requisites and metapkgs

sub mk_expandpckgs {
  my $self = shift;

  my $comps = $self->{comps};
  my $work = $self->{work};

  my ($pkgname, $pkg, $needcomps, $donecomps, $workingcomps, $compname);

  foreach $pkgname (keys %$work) {
    $::opts{debug}>2 and print STDERR "\nExpanding package $pkgname\n";
    $pkg = $work->{$pkgname};

    # Make a list of comps to do
    foreach (keys %{$pkg->{comps}}) {
      $needcomps->{$_} = 1;
    }
    $donecomps = {};
    $workingcomps = {};

    # Careful -- the list may change in expandcomp
    while (defined ($compname = (keys %$needcomps)[0])) {
      $self->mk_expandcomp ($needcomps, $donecomps, $workingcomps, $pkgname, $compname, '');
    }
  }
}

###############################################################################
# Resolve (in this order): requisites, metapkgs, and the item requested.

sub mk_expandcomp {
  my $self = shift;
  my ($needcomps, $donecomps, $workingcomps, $pkgname, $compname, $indent) = @_;

  my $comps = $self->{comps};
  my ($req, $rpmname, $conf, %use, %nouse, $rpm);

  # Check for circular ref and housekeeping
  defined ($workingcomps->{$compname}) and die "Ieeee! Circular requisites for group $compname for package $pkgname: " . join (', ', keys %$workingcomps);
  delete $needcomps->{$compname};
  $workingcomps->{$compname} = 1;

  # Requisites
  $::opts{debug}>2 and print STDERR "${indent}Checking requisites for group $compname\n";
  if (defined ($comps->{group}->{$compname}->{grouplist}->{groupreq})) {
    foreach $req (@{$comps->{group}->{$compname}->{grouplist}->{groupreq}}) {
      defined ($donecomps->{$req}) and next;
      if (!defined ($needcomps->{$req})) {
	$::opts{debug}>2 and print STDERR "${indent}Adding implicit dependency $req ((comp $compname, package $pkgname)\n";
	$needcomps->{$req} = 1;
      }
      # Don't curse - recurse!
      $::opts{debug}>2 and print STDERR "${indent}Recursing requisite comp $req (comp $compname, package $pkgname)\n";
      $self->mk_expandcomp ($needcomps, $donecomps, $workingcomps, $pkgname, $req, $indent . '  ');
    }
  }
  $::opts{debug}>2 and print STDERR "${indent}Requisites satisfied for group $compname\n";


  $::opts{debug}>2 and print STDERR "${indent}Checking meta-packages for group $compname\n";
  if (defined ($comps->{group}->{$compname}->{grouplist}->{metapkg})) {
    foreach $req (@{$comps->{group}->{$compname}->{grouplist}->{metapkg}}) {
      $req = { content => $req } unless ref ($req);
      if ($req->{type} && $req->{type} eq 'optional') {
	$::opts{debug}>2 and print STDERR "${indent}Skipping optional metapkg $req->{content} for (comp $compname, package $pkgname)\n";
	next;
      }
      defined ($donecomps->{$req->{content}}) and next;
      if (!defined ($needcomps->{$req->{content}})) {
	$::opts{debug}>2 and print STDERR "${indent}Adding implicit metapkg $req->{content} for ((comp $compname, package $pkgname)\n";
	$needcomps->{$req} = 1;
      }
      # Don't curse - recurse!
      $::opts{debug}>2 and print STDERR "${indent}Recursing requisite comp $req->{content} (comp $compname, package $pkgname)\n";
      $self->mk_expandcomp ($needcomps, $donecomps, $workingcomps, $pkgname, $req->{content}, $indent . '  ');
    }
  }
  $::opts{debug}>2 and print STDERR "${indent}Meta-packages satisfied for group $compname\n";


  # Have something to satisfy, now do it
  $::opts{debug}>2 and print STDERR "${indent}Expanding group $compname\n";
  foreach $rpmname (keys %{$comps->{group}->{$compname}->{packagelist}->{packagereq}}) {
    $req = $comps->{group}->{$compname}->{packagelist}->{packagereq}->{$rpmname};
    $conf = $self->{work}->{$pkgname}->{comps}->{$compname};
    %use = ();
    %nouse = ();
    if (defined $conf->{use}  ) { foreach (split (/,/, $conf->{use}  )) { $use{$_} = 1;  }};
    if (defined $conf->{nouse}) { foreach (split (/,/, $conf->{nouse})) { $nouse{$_} = 1;}};
    defined ($conf->{useall}) or $conf->{useall} = 0;
    defined ($conf->{nouseall}) or $conf->{nouseall} = 0;
    # Use this package if:
    #  It's required  --or--
    #  It's default and it's not in the config nouse list and nouseall isn't set --or--
    #  It's optional and in the use list or (useall is set and the rpm isn't in the nouse list)
    #    I.e. nouse="rpm" applies even if useall="1" is specified
    #    Also, use="rpm" applies even if nouseall"1" is specified
    if (
	($req->{type} eq 'mandatory' && !exists ($nouse{$rpmname})) ||
	(($req->{type} eq 'default') && !exists ($nouse{$rpmname}) && !$conf->{nouseall}) ||
	(($req->{type} eq 'optional') && (exists ($use{$rpmname}))) ||
	($conf->{useall} && !exists ($nouse{$rpmname}))
       ) {
      $::opts{debug}>2 and print STDERR "Adding $rpmname\n";
      $self->mk_addrpm ($pkgname, %$conf, name => $rpmname);
    }
  }

  # Done -- mark it so...
  delete $workingcomps->{$compname};
  $donecomps->{$compname} = 1;
}


###############################################################################
# Add the passed rpm to the passed rpm data structure
sub mk_addrpm {
  my $self = shift;
  my $pkgname = shift;
  my $args = {@_};

  defined ($self->{master}) or $self->{master} = {};
  my $master = $self->{master};
  defined ($self->{work}) or $self->{work} = {};
  my $work   = $self->{work};

  defined ($args->{name}) or die "addrpm called and I can't determine the name of the rpm!\n";

  defined ($args->{version}) or $args->{version} = 'any';
  defined ($args->{release}) or $args->{release} = 'any';
  defined ($args->{arch})    or $args->{arch}    = 'any';
  defined ($args->{dirs})    or $args->{dirs}   = $master->{defaults}->{dirs};
  defined ($args->{prior})   or $args->{prior}  = $master->{defaults}->{prior};

  my ($list, $check, $attr, $new);
  (exists ($work->{$pkgname}->{rpms}->{$args->{name}})) or
    $work->{$pkgname}->{rpms}->{$args->{name}} = [];
  $list = $work->{$pkgname}->{rpms}->{$args->{name}};
  foreach $check (@$list) {
    # Keep the first one we found
    (($check->{version} eq $args->{version} || $args->{version} eq 'any') &&
     ($check->{release} eq $args->{release} || $args->{release} eq 'any') &&
     ($check->{arch}    eq $args->{arch}    || $args->{arch} eq 'any') &&
    !defined ($args->{ifarch})) and return 1;
  }

  foreach $attr ('name',
		 'version',
		 'release',
		 'arch',
		 'ifarch',
		 'groupname',
		 'dirname',
		 'dirs',
		 'prior',
		 'noimplicitdeps',
		) {
    defined ($args->{$attr}) and $new->{$attr} = $args->{$attr};
  }
  push @$list, $new;
  return 1;
}


###############################################################################
sub mk_readcomps {
  my $self = shift;
  my $compsfile = $self->{master}->{compsfile};

  my ($gkey, $newname, $name, $newdesc, $desc);

  # 10/24/03 DT -- parsing broke when 'name' was listed in both keyattr and
  # forcearray -- not sure what will break with 'name' out of forcearray
  # have to try it and find out...
  eval {
    $self->{comps} = XMLin
      (
       $compsfile,
       keyattr => {
		   packagereq => 'content',
		   group      => 'id',
		   package    => 'name',
		  },
       forcearray => [
		      'description',
		      'packagereq',
		      'dependency',
		      'groupreq',
		      'rpm',
		      #		    'name',
		      'metapkg',
		     ],
      );
  };

  if ($@) {
    die "Failed to read comps data file $compsfile.\nReason follows:\n$@";
  }

  # Clean up -- remove non-english names
  my $comps = $self->{comps};
  foreach $gkey (keys %{$comps->{group}}) {
    $newname = [];
    if (ref $comps->{group}->{$gkey}->{name}) {
      foreach $name (@{$comps->{group}->{$gkey}->{name}}) {
	# print "ref \$name is " . ref($name) . "\n";
	(ref ($name) eq 'HASH') or push @$newname, $name;
      }
    } else {
      push @$newname, $comps->{group}->{$gkey}->{name};
    }
    $comps->{group}->{$gkey}->{name} = $newname;
    $newdesc = [];
    if (defined $comps->{group}->{$gkey}->{description}) {
      foreach $desc (@{$comps->{group}->{$gkey}->{description}}) {
	(ref ($desc) eq 'HASH') or push @$newdesc, $desc;
      }
      $comps->{group}->{$gkey}->{description} = $newdesc;
    }
  }
}

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

=head1 NAME

What::Node::Rpms -- Create/manage RPM packages

=head1 DESCRIPTION

This package contains methods to maintain RPMs according to a
low-level description that can be expressed accoring to the standard
b<what> xml format.

It also contains methods to build low-level configurations from a
high-level description based on the Red Hat b<comps> file format.

=head1 MKRPMS

This module also contains the code to expand a high-level xml file
containing general rpm requirements for systems into specific F<.rpms>
files which can be imported into B<what>.  The master xml file
contains references to groups in the Red Hat F<comps.xml> file.
Individual RPMs can be added or removed to further customize the
generated lists.

=head1 RPM-MASTER FILE CONTENTS

The rpm-master file contains several sections.

=over 4

=item compsfile

This entry gives the file system location of the comps.xml file for
the Red Hat distribution.

=item outdir

This entry give the name of the directory where the output rpm xml
files will be created.

=item dir

There may be several b<dir> sections.  Each section describes one or
more directories that will be used to obtain RPMs for consideration.
In addition, each b<dir> section may contain information used to copy
RPMs from original directory(s) into alternate permanent directories.
This feature allows the copying of RPMs from mirror updates
directories (from which they will be removed at some point in the
future) into permanent private repositories.

The sub-entries for a b<dir> section are:

=over 4

=item name

The name of this b<dir>.  Should be unique within an rpm-master file.

=item source

Names a source directory for this b<dir> entry.  There may be multiple
source directories specified.  However, if multiple sources are
specified, a b<dest> tag must also be specified, and all RPMs actually
used by this b<dir> will be copied to the b<dest> by copyrpms.

=item dest

Names a directory from which RPMs corresponding to this b<dir> spec
should be found when it comes time to install them on the host.

=item prefix

Provides a method by which you can construct a --prefix argument for
the RPM in the event that the default RPM location is not what you want.

=item install

Specifies an alternate directory to b<dest> for copyrpms to copy RPMs
from multiple sources.  b<install> can be thought of as the place to
write RPMs to that will be read from b<dest>.  If b<dest> is
read/write instead of read/only, this attribute can be ommitted.

=back

=item rpms

These entries request the inclusion of a single rpm.  The pertinent
attributes are:

=over 4

=item name

The name of the RPM.

=item pckgs

A comma-separated list of the packages the RPM should be included in.

=item noimplicitdeps

Do not search for (or include) dependents of this RPM.

=item dirs

A comma-separated list of b<dir> node names to search for this RPM.

=item version

Request a specific version of this RPM.  Without this attribute, the
newest version found is used.

=item release

Request a specific release of this RPM.  Without this attribute, the
newest release found is used.

=item action

=back

=item comps

=over 4

=item group

Name a group from the Red Hat comps file.

=item pckgs

A comma-separated list of the packages the RPM should be included in.

=item useall, use, nouse, nouseall

The b<useall> and b<nouseall> attributes are boolean; the b<use> and b<nouse> attributes are a comma-separated list of RPM names.

The comps file lists the packages within groups as either
b<mandatory>, b<default>, or b<optional>.  The rpm-master attributes
b<useall>, b<use>, and b<nouse> interact with the comps priorities.
RPMs listed in the comps file at priorite b<mandatory> will be
included regardless of the rpm-master attribute values.  RPMs listed
with priority b<default> will be included unless excluded by the
b<nouseall> attribute or listed in a b<nouse> list.  RPMs listed with
priority b<optional> will be excluded unless included via b<useall> or
listed in the b<use> list. Thankfully, listing an RPM in b<use>
overrides b<nouseall>; likewise b<nouse> takes precidence over
b<useall>.  For other cases, the tendency is to include rather than
exclude.  Check the code if you're not sure.

=back

=back


=head1 GORY DETAILS

=over 4

=item *

The master configuration file is read by B<readconfig()>.  This
file gives the directories that contain the RPM files, the F<.rpms>
files to be generated, the location of the F<comps.xml> file, and the
names of groups and individual RPMs to add/remove from the list(s).

=item *

The B<setup()> function is called.  For each component group and
output package requested by a B<comps> entry in the config file, this
step creates a
B<$config-E<gt>{work}-E<gt>{$pckg}-E<gt>{comps}-E<gt>{$comp}> entry.
Then, for each rpm listed in the B<rpms> section of the input file, a
B<$config-E<gt>{work}-E<gt>{$pckg}-E<gt>{rpms}-E<gt>{$name}> entry is
created for the named RPM.

=item *

The Red Hat distribution F<comps.xml> file is read by B<readcomps()>.

=item *

The B<expandpckgs()> function is called.  For each package, each
component listed in
B<$config-E<gt>{work}-E<gt>{$pckg}-E<gt>{comps}-E<gt>{$comp}>, the
component is expanded, and its equivalent RPM set is inserted into the
corresponding
B<$config-E<gt>{work}-E<gt>{$pckg}-E<gt>{rpms}-E<gt>{$name}> area.
Specifically, prerequisites are satisfied, meta-packages are expanded,
and the component itself is expanded.  B<use>, B<nouse>, B<useall>,
and B<nouseall> directives in the original config file for the group
controll the inclusion of optional components.  This is a recursive
step.

=item *

The B<implicitdeps()> function is called next.  For each RPM now
listed in
B<$config-E<gt>{work}-E<gt>{$pckg}-E<gt>{rpms}-E<gt>{$name}>, a check
is made via the loaded <comps.xml> file for RPMs that are needed, and
these are added.

=item *

The B<genlist()> function reads the source directories, and finds the
newest RPMs in the source dirs that match the requirements of the
requested RPM.

=item *

Finally, the B<writefiles()> function writes the output files.

=back

=cut

=head1 XML FORMAT

TODO

=head1 EXAMPLES

TODO

=cut

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

1;
