Build.pm

package Build;

use strict;
use Digest::MD5;
use Build::Rpm;
use Data::Dumper;

our $expand_dbg;

our $do_rpm;
our $do_deb;
our $do_kiwi;
our $do_arch;

sub import {
  for (@_) {
    $do_rpm = 1 if $_ eq ':rpm';
    $do_deb = 1 if $_ eq ':deb';
    $do_kiwi = 1 if $_ eq ':kiwi';
    $do_arch = 1 if $_ eq ':arch';
  }
  $do_rpm = $do_deb = $do_kiwi = $do_arch = 1 if !$do_rpm && !$do_deb && !$do_kiwi && !$do_arch;
  if ($do_deb) {
    require Build::Deb;
  }
  if ($do_kiwi) {
    require Build::Kiwi;
  }
  if ($do_arch) {
    require Build::Arch;
  }
}

package Build::Features;
our $preinstallimage = 1;	# on sale now
package Build;

my $std_macros = q{
%define nil
%define ix86 i386 i486 i586 i686 athlon
%define arm armv4l armv5l armv6l armv7l armv4b armv5l armv5b armv5el armv5eb armv5tel armv5teb armv6el armv6eb armv7el armv7eb armv7hl armv7nhl armv8el
%define arml armv4l armv5l armv6l armv7l armv5tel armv5el armv6el armv7el armv7hl armv7nhl armv8el
%define armb armv4b armv5b armv5teb armv5eb armv6eb armv7eb
%define sparc sparc sparcv8 sparcv9 sparcv9v sparc64 sparc64v
};
my $extra_macros = '';

sub unify {
  my %h = map {$_ => 1} @_;
  return grep(delete($h{$_}), @_);
}

sub define($)
{
  my $def = shift;
  $extra_macros .= '%define '.$def."\n";
}

sub init_helper_hashes {
  my ($config) = @_;

  $config->{'preferh'} = { map {$_ => 1} @{$config->{'prefer'}} };

  my %ignore;
  for (@{$config->{'ignore'}}) {
    if (!/:/) {
      $ignore{$_} = 1;
      next;
    }
    my @s = split(/[,:]/, $_);
    my $s = shift @s;
    $ignore{"$s:$_"} = 1 for @s;
  }
  $config->{'ignoreh'} = \%ignore;

  my %conflicts;
  for (@{$config->{'conflict'}}) {
    my @s = split(/[,:]/, $_);
    my $s = shift @s;
    push @{$conflicts{$s}}, @s;
    push @{$conflicts{$_}}, $s for @s;
  }
  for (keys %conflicts) {
    $conflicts{$_} = [ unify(@{$conflicts{$_}}) ]
  }
  $config->{'conflicth'} = \%conflicts;
}

# 'canonicalize' dist string as found in rpm dist tags
sub dist_canon($$) {
  my ($rpmdist, $arch) = @_;
  $rpmdist = lc($rpmdist);
  $rpmdist =~ s/-/_/g;
  $rpmdist =~ s/opensuse/suse linux/;
  my $rpmdista;
  if ($rpmdist =~ /\(/) {
    $rpmdista = $rpmdist;
    $rpmdista =~ s/.*\(//;
    $rpmdista =~ s/\).*//;
  } else {
    $rpmdista = $arch;
  }
  $rpmdista =~ s/i[456]86/i386/;
  $rpmdist = '' unless $rpmdista =~ /^(i386|x86_64|ia64|ppc|ppc64|s390|s390x)$/;
  my $dist = 'default';
  if ($rpmdist =~ /unitedlinux 1\.0.*/) {
    $dist = "ul1-$rpmdista";
  } elsif ($rpmdist =~ /suse sles_(\d+)/) {
    $dist = "sles$1-$rpmdista";
  } elsif ($rpmdist =~ /suse linux enterprise (\d+)/) {
    $dist = "sles$1-$rpmdista";
  } elsif ($rpmdist =~ /suse linux (\d+)\.(\d+)\.[4-9]\d/) {
    # alpha version
    $dist = "$1.".($2 + 1)."-$rpmdista";
  } elsif ($rpmdist =~ /suse linux (\d+\.\d+)/) {
    $dist = "$1-$rpmdista";
  }
  return $dist;
}

sub read_config_dist {
  my ($dist, $archpath, $configdir) = @_;

  my $arch = $archpath;
  $arch = 'noarch' unless defined $arch;
  $arch =~ s/:.*//;
  $arch = 'noarch' if $arch eq '';
  die("Please specify a distribution!\n") unless defined $dist;
  if ($dist !~ /\//) {
    my $saved = $dist;
    $configdir = '.' unless defined $configdir;
    $dist =~ s/-.*//;
    $dist = "sl$dist" if $dist =~ /^\d/;
    $dist = "$configdir/$dist.conf";
    if (! -e $dist) {
      $dist =~ s/-.*//;
      $dist = "sl$dist" if $dist =~ /^\d/;
      $dist = "$configdir/$dist.conf";
    }
    if (! -e $dist) {
      warn "$saved.conf not found, using default.conf\n" unless $saved eq 'default';
      $dist = "$configdir/default.conf";
    }
  }
  die("$dist: $!\n") unless -e $dist;
  my $cf = read_config($arch, $dist);
  die("$dist: parse error\n") unless $cf;
  return $cf;
}

sub read_config {
  my ($arch, $cfile) = @_;
  my @macros = split("\n", $std_macros.$extra_macros);
  push @macros, "%define _target_cpu $arch";
  push @macros, "%define _target_os linux";
  my $config = {'macros' => \@macros, 'arch' => $arch};
  my @config;
  if (ref($cfile)) {
    @config = @$cfile;
  } elsif (defined($cfile)) {
    local *CONF;
    return undef unless open(CONF, '<', $cfile);
    @config = <CONF>;
    close CONF;
    chomp @config;
  }
  # create verbatim macro blobs
  my @newconfig;
  while (@config) {
    push @newconfig, shift @config;
    next unless $newconfig[-1] =~ /^\s*macros:\s*$/si;
    $newconfig[-1] = "macros:\n";
    while (@config) {
      my $l = shift @config;
      last if $l =~ /^\s*:macros\s*$/si;
      $newconfig[-1] .= "$l\n";
    }
  }
  my @spec;
  $config->{'save_expanded'} = 1;
  Build::Rpm::parse($config, \@newconfig, \@spec);
  delete $config->{'save_expanded'};
  $config->{'preinstall'} = [];
  $config->{'vminstall'} = [];
  $config->{'cbpreinstall'} = [];
  $config->{'cbinstall'} = [];
  $config->{'runscripts'} = [];
  $config->{'required'} = [];
  $config->{'support'} = [];
  $config->{'keep'} = [];
  $config->{'prefer'} = [];
  $config->{'ignore'} = [];
  $config->{'conflict'} = [];
  $config->{'substitute'} = {};
  $config->{'substitute_vers'} = {};
  $config->{'optflags'} = {};
  $config->{'order'} = {};
  $config->{'exportfilter'} = {};
  $config->{'publishfilter'} = [];
  $config->{'rawmacros'} = '';
  $config->{'release'} = '<CI_CNT>.<B_CNT>';
  $config->{'repotype'} = [];
  $config->{'patterntype'} = [];
  $config->{'fileprovides'} = {};
  $config->{'constraint'} = [];
  $config->{'expandflags'} = [];
  for my $l (@spec) {
    $l = $l->[1] if ref $l;
    next unless defined $l;
    my @l = split(' ', $l);
    next unless @l;
    my $ll = shift @l;
    my $l0 = lc($ll);
    if ($l0 eq 'macros:') {
      $l =~ s/.*?\n//s;
      if ($l =~ /^!\n/s) {
	$config->{'rawmacros'} = substr($l, 2);
      } else {
	$config->{'rawmacros'} .= $l;
      }
      next;
    }
    if ($l0 eq 'preinstall:' || $l0 eq 'vminstall:' || $l0 eq 'cbpreinstall:' || $l0 eq 'cbinstall:' || $l0 eq 'required:' || $l0 eq 'support:' || $l0 eq 'keep:' || $l0 eq 'prefer:' || $l0 eq 'ignore:' || $l0 eq 'conflict:' || $l0 eq 'runscripts:' || $l0 eq 'expandflags:') {
      my $t = substr($l0, 0, -1);
      for my $l (@l) {
	if ($l eq '!*') {
	  $config->{$t} = [];
	} elsif ($l =~ /^!/) {
	  $config->{$t} = [ grep {"!$_" ne $l} @{$config->{$t}} ];
	} else {
	  push @{$config->{$t}}, $l;
	}
      }
    } elsif ($l0 eq 'substitute:') {
      next unless @l;
      $ll = shift @l;
      if ($ll eq '!*') {
	$config->{'substitute'} = {};
      } elsif ($ll =~ /^!(.*)$/) {
	delete $config->{'substitute'}->{$1};
      } else {
	$config->{'substitute'}->{$ll} = [ @l ];
      }
    } elsif ($l0 eq 'fileprovides:') {
      next unless @l;
      $ll = shift @l;
      if ($ll eq '!*') {
	$config->{'fileprovides'} = {};
      } elsif ($ll =~ /^!(.*)$/) {
	delete $config->{'fileprovides'}->{$1};
      } else {
	$config->{'fileprovides'}->{$ll} = [ @l ];
      }
    } elsif ($l0 eq 'exportfilter:') {
      next unless @l;
      $ll = shift @l;
      $config->{'exportfilter'}->{$ll} = [ @l ];
    } elsif ($l0 eq 'publishfilter:') {
      $config->{'publishfilter'} = [ @l ];
    } elsif ($l0 eq 'optflags:') {
      next unless @l;
      $ll = shift @l;
      $config->{'optflags'}->{$ll} = join(' ', @l);
    } elsif ($l0 eq 'order:') {
      for my $l (@l) {
	if ($l eq '!*') {
	  $config->{'order'} = {};
	} elsif ($l =~ /^!(.*)$/) {
	  delete $config->{'order'}->{$1};
	} else {
	  $config->{'order'}->{$l} = 1;
	}
      }
    } elsif ($l0 eq 'repotype:') { #type of generated repository data
      $config->{'repotype'} = [ @l ];
    } elsif ($l0 eq 'type:') { #kind of packaging system (spec,dsc,arch,kiwi,...)
      $config->{'type'} = $l[0];
    } elsif ($l0 eq 'binarytype:') { #rpm,deb,arch,...
      $config->{'binarytype'} = $l[0];
    } elsif ($l0 eq 'patterntype:') { #kind of generated patterns in repository
      $config->{'patterntype'} = [ @l ];
    } elsif ($l0 eq 'release:') {
      $config->{'release'} = $l[0];
    } elsif ($l0 eq 'cicntstart:') {
      $config->{'cicntstart'} = $l[0];
    } elsif ($l0 eq 'releaseprg:') {
      $config->{'releaseprg'} = $l[0];
    } elsif ($l0 eq 'changetarget:' || $l0 eq 'target:') {
      $config->{'target'} = join(' ', @l);
      push @macros, "%define _target_cpu ".(split('-', $config->{'target'}))[0] if $config->{'target'};
    } elsif ($l0 eq 'hostarch:') {
      $config->{'hostarch'} = join(' ', @l);
    } elsif ($l0 eq 'constraint:') {
      my $l = join(' ', @l);
      if ($l eq '!*') {
	$config->{'constraint'} = [];
      } else {
	push @{$config->{'constraint'}}, $l;
      }
    } elsif ($l0 !~ /^[#%]/) {
      warn("unknown keyword in config: $l0\n");
    }
  }
  for my $l (qw{preinstall vminstall cbpreinstall cbinstall required support keep runscripts repotype patterntype}) {
    $config->{$l} = [ unify(@{$config->{$l}}) ];
  }
  for my $l (keys %{$config->{'substitute'}}) {
    $config->{'substitute_vers'}->{$l} = [ map {/^(.*?)(=)?$/g} unify(@{$config->{'substitute'}->{$l}}) ];
    $config->{'substitute'}->{$l} = [ unify(@{$config->{'substitute'}->{$l}}) ];
    s/=$// for @{$config->{'substitute'}->{$l}};
  }
  init_helper_hashes($config);
  if (!$config->{'type'}) {
    # Fallback to old guessing method if no type (spec, dsc or kiwi) is defined
    if (grep {$_ eq 'rpm'} @{$config->{'preinstall'} || []}) {
      $config->{'type'} = 'spec';
    } elsif (grep {$_ eq 'debianutils'} @{$config->{'preinstall'} || []}) {
      $config->{'type'} = 'dsc';
    } elsif (grep {$_ eq 'pacman'} @{$config->{'preinstall'} || []}) {
      $config->{'type'} = 'arch';
    } else {
      $config->{'type'} = 'UNDEFINED';
    }
  }
  if (!$config->{'binarytype'}) {
    $config->{'binarytype'} = 'rpm' if $config->{'type'} eq 'spec' || $config->{'type'} eq 'kiwi';
    $config->{'binarytype'} = 'deb' if $config->{'type'} eq 'dsc';
    $config->{'binarytype'} = 'arch' if $config->{'type'} eq 'arch';
    $config->{'binarytype'} ||= 'UNDEFINED';
  }
  # add rawmacros to our macro list
  if ($config->{'rawmacros'} ne '') {
    for my $rm (split("\n", $config->{'rawmacros'})) {
      if (@macros && $macros[-1] =~ /\\$/) {
	if ($rm =~ /\\$/) {
	  push @macros, '...\\';
	} else {
	  push @macros, '...';
	}
      } elsif ($rm !~ /^%/) {
	push @macros, $rm;
      } else {
	push @macros, "%define ".substr($rm, 1);
      }
    }
  }
  for (@{$config->{'expandflags'} || []}) {
    if (/^([^:]+):(.*)$/s) {
      $config->{"expandflags:$1"} = $2;
    } else {
      $config->{"expandflags:$_"} = 1;
    }
  }
  return $config;
}

sub do_subst {
  my ($config, @deps) = @_;
  my @res;
  my %done;
  my $subst = $config->{'substitute'};
  while (@deps) {
    my $d = shift @deps;
    next if $done{$d};
    my $ds = $d;
    $ds =~ s/\s*[<=>].*$//s;
    if ($subst->{$ds}) {
      unshift @deps, @{$subst->{$ds}};
      push @res, $d if grep {$_ eq $ds} @{$subst->{$ds}};
    } else {
      push @res, $d;
    }
    $done{$d} = 1;
  }
  return @res;
}

sub do_subst_vers {
  my ($config, @deps) = @_;
  my @res;
  my %done;
  my $subst = $config->{'substitute_vers'};
  while (@deps) {
    my ($d, $dv) = splice(@deps, 0, 2);
    next if $done{$d};
    if ($subst->{$d}) {
      unshift @deps, map {defined($_) && $_ eq '=' ? $dv : $_} @{$subst->{$d}};
      push @res, $d, $dv if grep {defined($_) && $_ eq $d} @{$subst->{$d}};
    } else {
      push @res, $d, $dv;
    }
    $done{$d} = 1;
  }
  return @res;
}

# Delivers all packages which get used for building
sub get_build {
  my ($config, $subpacks, @deps) = @_;
  my @ndeps = grep {/^-/} @deps;
  my @extra = (@{$config->{'required'}}, @{$config->{'support'}});
  if (@{$config->{'keep'} || []}) {
    my %keep = map {$_ => 1} (@deps, @{$config->{'keep'} || []}, @{$config->{'preinstall'}});
    for (@{$subpacks || []}) {
      push @ndeps, "-$_" unless $keep{$_};
    }
  } else {
    # new "empty keep" mode, filter subpacks from required/support
    my %subpacks = map {$_ => 1} @{$subpacks || []};
    @extra = grep {!$subpacks{$_}} @extra;
  }
  my %ndeps = map {$_ => 1} @ndeps;
  @deps = grep {!$ndeps{$_}} @deps;
  push @deps, @{$config->{'preinstall'}};
  push @deps, @extra;
  @deps = grep {!$ndeps{"-$_"}} @deps;
  @deps = do_subst($config, @deps);
  @deps = grep {!$ndeps{"-$_"}} @deps;
  @deps = expand($config, @deps, @ndeps);
  return @deps;
}

# Delivers all packages which shall have an influence to other package builds (get_build reduced by support packages)
sub get_deps {
  my ($config, $subpacks, @deps) = @_;
  my @ndeps = grep {/^-/} @deps;
  my @extra = @{$config->{'required'}};
  if (@{$config->{'keep'} || []}) {
    my %keep = map {$_ => 1} (@deps, @{$config->{'keep'} || []}, @{$config->{'preinstall'}});
    for (@{$subpacks || []}) {
      push @ndeps, "-$_" unless $keep{$_};
    }
  } else {
    # new "empty keep" mode, filter subpacks from required
    my %subpacks = map {$_ => 1} @{$subpacks || []};
    @extra = grep {!$subpacks{$_}} @extra;
  }
  my %ndeps = map {$_ => 1} @ndeps;
  @deps = grep {!$ndeps{$_}} @deps;
  push @deps, @extra;
  @deps = grep {!$ndeps{"-$_"}} @deps;
  @deps = do_subst($config, @deps);
  @deps = grep {!$ndeps{"-$_"}} @deps;
  my %bdeps = map {$_ => 1} (@{$config->{'preinstall'}}, @{$config->{'support'}});
  delete $bdeps{$_} for @deps;
  @deps = expand($config, @deps, @ndeps);
  if (@deps && $deps[0]) {
    my $r = shift @deps;
    @deps = grep {!$bdeps{$_}} @deps;
    unshift @deps, $r;
  }
  return @deps;
}

sub get_preinstalls {
  my ($config) = @_;
  return @{$config->{'preinstall'}};
}

sub get_vminstalls {
  my ($config) = @_;
  return @{$config->{'vminstall'}};
}

sub get_cbpreinstalls {
  my ($config) = @_;
  return @{$config->{'cbpreinstall'}};
}

sub get_cbinstalls {
  my ($config) = @_;
  return @{$config->{'cbinstall'}};
}

sub get_runscripts {
  my ($config) = @_;
  return @{$config->{'runscripts'}};
}

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

sub readdeps {
  my ($config, $pkginfo, @depfiles) = @_;

  my %requires = ();
  local *F;
  my %provides;
  my $dofileprovides = %{$config->{'fileprovides'}};
  for my $depfile (@depfiles) {
    if (ref($depfile) eq 'HASH') {
      for my $rr (keys %$depfile) {
	$provides{$rr} = $depfile->{$rr}->{'provides'};
	$requires{$rr} = $depfile->{$rr}->{'requires'};
      }
      next;
    }
    # XXX: we don't support different architectures per file
    open(F, "<$depfile") || die("$depfile: $!\n");
    while(<F>) {
      my @s = split(' ', $_);
      my $s = shift @s;
      my @ss;
      while (@s) {
	if (!$dofileprovides && $s[0] =~ /^\//) {
	  shift @s;
	  next;
	}
	if ($s[0] =~ /^rpmlib\(/) {
	    splice(@s, 0, 3);
	    next;
	}
	push @ss, shift @s;
	while (@s) {
	  if ($s[0] =~ /^[\(<=>|]/) {
	    $ss[-1] .= " $s[0] $s[1]";
	    $ss[-1] =~ s/ \((.*)\)/ $1/;
	    $ss[-1] =~ s/(<|>){2}/$1/;
	    splice(@s, 0, 2);
	  } else {
	    last;
	  }
	}
      }
      my %ss;
      @ss = grep {!$ss{$_}++} @ss;
      if ($s =~ /^(P|R):(.*)\.(.*)-\d+\/\d+\/\d+:$/) {
	my $pkgid = $2;
	my $arch = $3;
	if ($1 eq "R") {
	  $requires{$pkgid} = \@ss;
	  $pkginfo->{$pkgid}->{'requires'} = \@ss if $pkginfo;
	  next;
	}
	# handle provides
	$provides{$pkgid} = \@ss;
	if ($pkginfo) {
	  # extract ver and rel from self provides
	  my ($v, $r) = map { /\Q$pkgid\E = ([^-]+)(?:-(.+))?$/ } @ss;
	  die("$pkgid: no self provides\n") unless $v;
	  $pkginfo->{$pkgid}->{'name'} = $pkgid;
	  $pkginfo->{$pkgid}->{'version'} = $v;
	  $pkginfo->{$pkgid}->{'release'} = $r if defined($r);
	  $pkginfo->{$pkgid}->{'arch'} = $arch;
	  $pkginfo->{$pkgid}->{'provides'} = \@ss;
	}
      }
    }
    close F;
  }
  $config->{'providesh'} = \%provides;
  $config->{'requiresh'} = \%requires;
  makewhatprovidesh($config);
}

sub makewhatprovidesh {
  my ($config) = @_;

  my %whatprovides;
  my $provides = $config->{'providesh'};

  for my $p (keys %$provides) {
    my @pp = @{$provides->{$p}};
    s/[ <=>].*// for @pp;
    push @{$whatprovides{$_}}, $p for unify(@pp);
  }
  for my $p (keys %{$config->{'fileprovides'}}) {
    my @pp = map {@{$whatprovides{$_} || []}} @{$config->{'fileprovides'}->{$p}};
    @{$whatprovides{$p}} = unify(@{$whatprovides{$p} || []}, @pp) if @pp;
  }
  $config->{'whatprovidesh'} = \%whatprovides;
}

sub setdeps {
  my ($config, $provides, $whatprovides, $requires) = @_;
  $config->{'providesh'} = $provides;
  $config->{'whatprovidesh'} = $whatprovides;
  $config->{'requiresh'} = $requires;
}

sub forgetdeps {
  my ($config) = @_;
  delete $config->{'providesh'};
  delete $config->{'whatprovidesh'};
  delete $config->{'requiresh'};
}

my %addproviders_fm = (
  '>'  => 1,
  '='  => 2,
  '>=' => 3,
  '<'  => 4,
  '<=' => 6,
);

sub addproviders {
  my ($config, $r) = @_;

  my @p;
  my $whatprovides = $config->{'whatprovidesh'};
  $whatprovides->{$r} = \@p;
  if ($r =~ /\|/) {
    for my $or (split(/\s*\|\s*/, $r)) {
      push @p, @{$whatprovides->{$or} || addproviders($config, $or)};
    }
    @p = unify(@p) if @p > 1;
    return \@p;
  }
  return \@p if $r !~ /^(.*?)\s*([<=>]{1,2})\s*(.*?)$/;
  my $rn = $1;
  my $rv = $3;
  my $rf = $addproviders_fm{$2};
  return \@p unless $rf;
  my $provides = $config->{'providesh'};
  my @rp = @{$whatprovides->{$rn} || []};
  for my $rp (@rp) {
    for my $pp (@{$provides->{$rp} || []}) {
      if ($pp eq $rn) {
	# debian: unversioned provides do not match
	# kiwi: supports only rpm, so we need to hand it like it
	next if $config->{'binarytype'} eq 'deb';
	push @p, $rp;
	last;
      }
      next unless $pp =~ /^\Q$rn\E\s*([<=>]{1,2})\s*(.*?)$/;
      my $pv = $2;
      my $pf = $addproviders_fm{$1};
      next unless $pf;
      if ($pf & $rf & 5) {
	push @p, $rp;
	last;
      }
      if ($pv eq $rv) {
	next unless $pf & $rf & 2;
	push @p, $rp;
	last;
      }
      my $rr = $rf == 2 ? $pf : ($rf ^ 5);
      $rr &= 5 unless $pf & 2;
      # verscmp for spec and kiwi types
      my $vv;
      if ($config->{'binarytype'} eq 'deb') {
	$vv = Build::Deb::verscmp($pv, $rv, 1);
      } else {
	$vv = Build::Rpm::verscmp($pv, $rv, 1);
      }
      if ($rr & (1 << ($vv + 1))) {
	push @p, $rp;
	last;
      }
    }
  }
  @p = unify(@p) if @p > 1;
  return \@p;
}

sub expand {
  my ($config, @p) = @_;

  my $conflicts = $config->{'conflicth'};
  my $prefer = $config->{'preferh'};
  my $ignore = $config->{'ignoreh'};

  my $whatprovides = $config->{'whatprovidesh'};
  my $requires = $config->{'requiresh'};

  my %xignore = map {substr($_, 1) => 1} grep {/^-/} @p;
  @p = grep {!/^-/} @p;

  my %p;		# expanded packages
  my %aconflicts;	# packages we are conflicting with

  # add direct dependency packages. this is different from below,
  # because we add packages even if to dep is already provided and
  # we break ambiguities if the name is an exact match.
  for my $p (splice @p) {
    my @q = @{$whatprovides->{$p} || addproviders($config, $p)};
    if (@q > 1) {
      my $pn = $p;
      $pn =~ s/ .*//;
      @q = grep {$_ eq $pn} @q;
    }
    if (@q != 1) {
      push @p, $p;
      next;
    }
    print "added $q[0] because of $p (direct dep)\n" if $expand_dbg;
    push @p, $q[0];
    $p{$q[0]} = 1;
    $aconflicts{$_} = 1 for @{$conflicts->{$q[0]} || []};
  }

  my @pamb = ();
  my $doamb = 0;
  while (@p) {
    my @error = ();
    my @rerror = ();
    for my $p (splice @p) {
      for my $r (@{$requires->{$p} || [$p]}) {
	my $ri = (split(/[ <=>]/, $r, 2))[0];
	next if $ignore->{"$p:$ri"} || $xignore{"$p:$ri"};
	next if $ignore->{$ri} || $xignore{$ri};
	my @q = @{$whatprovides->{$r} || addproviders($config, $r)};
	next if grep {$p{$_}} @q;
	next if grep {$xignore{$_}} @q;
	next if grep {$ignore->{"$p:$_"} || $xignore{"$p:$_"}} @q;
	@q = grep {!$aconflicts{$_}} @q;
	if (!@q) {
	  if ($r eq $p) {
	    push @rerror, "nothing provides $r";
	  } else {
	    next if $r =~ /^\//;
	    push @rerror, "nothing provides $r needed by $p";
	  }
	  next;
	}
	if (@q > 1 && !$doamb) {
	  push @pamb, $p unless @pamb && $pamb[-1] eq $p;
	  print "undecided about $p:$r: @q\n" if $expand_dbg;
	  next;
	}
	if (@q > 1) {
	  my @pq = grep {!$prefer->{"-$_"} && !$prefer->{"-$p:$_"}} @q;
	  @q = @pq if @pq;
	  @pq = grep {$prefer->{$_} || $prefer->{"$p:$_"}} @q;
	  if (@pq > 1) {
	    my %pq = map {$_ => 1} @pq;
	    @q = (grep {$pq{$_}} @{$config->{'prefer'}})[0];
	  } elsif (@pq == 1) {
	    @q = @pq;
	  }
	}
	if (@q > 1 && $r =~ /\|/) {
	    # choice op, implicit prefer of first match...
	    my %pq = map {$_ => 1} @q;
	    for my $rr (split(/\s*\|\s*/, $r)) {
		next unless $whatprovides->{$rr};
		my @pq = grep {$pq{$_}} @{$whatprovides->{$rr}};
		next unless @pq;
		@q = @pq;
		last;
	    }
	}
	if (@q > 1) {
	  if ($r ne $p) {
	    push @error, "have choice for $r needed by $p: @q";
	  } else {
	    push @error, "have choice for $r: @q";
	  }
	  push @pamb, $p unless @pamb && $pamb[-1] eq $p;
	  next;
	}
	push @p, $q[0];
	print "added $q[0] because of $p:$r\n" if $expand_dbg;
	$p{$q[0]} = 1;
	$aconflicts{$_} = 1 for @{$conflicts->{$q[0]} || []};
	@error = ();
	$doamb = 0;
      }
    }
    return undef, @rerror if @rerror;
    next if @p;		# still work to do

    # only ambig stuff left
    if (@pamb && !$doamb) {
      @p = @pamb;
      @pamb = ();
      $doamb = 1;
      print "now doing undecided dependencies\n" if $expand_dbg;
      next;
    }
    return undef, @error if @error;
  }
  return 1, (sort keys %p);
}

sub order {
  my ($config, @p) = @_;

  my $requires = $config->{'requiresh'};
  my $whatprovides = $config->{'whatprovidesh'};
  my %deps;
  my %rdeps;
  my %needed;
  my %p = map {$_ => 1} @p;
  for my $p (@p) {
    my @r;
    for my $r (@{$requires->{$p} || []}) {
      my @q = @{$whatprovides->{$r} || addproviders($config, $r)};
      push @r, grep {$_ ne $p && $p{$_}} @q;
    }
    if (%{$config->{'order'} || {}}) {
      push @r, grep {$_ ne $p && $config->{'order'}->{"$_:$p"}} @p;
    }
    @r = unify(@r);
    $deps{$p} = \@r;
    $needed{$p} = @r;
    push @{$rdeps{$_}}, $p for @r;
  }
  @p = sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @p;
  my @good;
  my @res;
  # the big sort loop
  while (@p) {
    @good = grep {$needed{$_} == 0} @p;
    if (@good) {
      @p = grep {$needed{$_}} @p;
      push @res, @good;
      for my $p (@good) {
	$needed{$_}-- for @{$rdeps{$p}};
      }
      next;
    }
    # uh oh, cycle alert. find and remove all cycles.
    my %notdone = map {$_ => 1} @p;
    $notdone{$_} = 0 for @res;  # already did those
    my @todo = @p;
    while (@todo) {
      my $v = shift @todo;
      if (ref($v)) {
	$notdone{$$v} = 0;      # finished this one
	next;
      }
      my $s = $notdone{$v};
      next unless $s;
      my @e = grep {$notdone{$_}} @{$deps{$v}};
      if (!@e) {
	$notdone{$v} = 0;       # all deps done, mark as finished
	next;
      }
      if ($s == 1) {
	$notdone{$v} = 2;       # now under investigation
	unshift @todo, @e, \$v;
	next;
      }
      # reached visited package, found a cycle!
      my @cyc = ();
      my $cycv = $v;
      # go back till $v is reached again
      while(1) {
	die unless @todo;
	$v = shift @todo;
	next unless ref($v);
	$v = $$v;
	$notdone{$v} = 1 if $notdone{$v} == 2;
	unshift @cyc, $v;
	last if $v eq $cycv;
      }
      unshift @todo, $cycv;
      print STDERR "cycle: ".join(' -> ', @cyc)."\n";
      my $breakv;
      my @breakv = (@cyc, $cyc[0]);
      while (@breakv > 1) {
	last if $config->{'order'}->{"$breakv[0]:$breakv[1]"};
	shift @breakv;
      }
      if (@breakv > 1) {
	$breakv = $breakv[0];
      } else {
	$breakv = (sort {$needed{$a} <=> $needed{$b} || $a cmp $b} @cyc)[-1];
      }
      push @cyc, $cyc[0];	# make it loop
      shift @cyc while $cyc[0] ne $breakv;
      $v = $cyc[1];
      print STDERR "  breaking dependency $breakv -> $v\n";
      $deps{$breakv} = [ grep {$_ ne $v} @{$deps{$breakv}} ];
      $rdeps{$v} = [ grep {$_ ne $breakv} @{$rdeps{$v}} ];
      $needed{$breakv}--;
    }
  }
  return @res;
}

sub add_all_providers {
  my ($config, @p) = @_;
  my $whatprovides = $config->{'whatprovidesh'};
  my $requires = $config->{'requiresh'};
  my %a;
  for my $p (@p) {
    for my $r (@{$requires->{$p} || [$p]}) {
      my $rn = (split(' ', $r, 2))[0];
      $a{$_} = 1 for @{$whatprovides->{$rn} || []};
    }
  }
  push @p, keys %a;
  return unify(@p);
}

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

sub show {
  my ($conffile, $fn, $field, $arch) = @ARGV;
  my $cf = read_config($arch, $conffile);
  die unless $cf;
  my $d = Build::parse($cf, $fn);
  die("$d->{'error'}\n") if $d->{'error'};
  $d->{'sources'} = [ map {ref($d->{$_}) ? @{$d->{$_}} : $d->{$_}} grep {/^source/} sort keys %$d ];
  my $x = $d->{$field};
  $x = [ $x ] unless ref $x;
  print "$_\n" for @$x;
}

sub parse_preinstallimage {
  return undef unless $do_rpm;
  my $d = Build::Rpm::parse(@_);
  $d->{'name'} ||= 'preinstallimage';
  return $d;
}

sub parse {
  my ($cf, $fn, @args) = @_;
  return Build::Rpm::parse($cf, $fn, @args) if $do_rpm && $fn =~ /\.spec$/;
  return Build::Deb::parse($cf, $fn, @args) if $do_deb && $fn =~ /\.dsc$/;
  return Build::Kiwi::parse($cf, $fn, @args) if $do_kiwi && $fn =~ /config\.xml$/;
  return Build::Kiwi::parse($cf, $fn, @args) if $do_kiwi && $fn =~ /\.kiwi$/;
  return Build::Arch::parse($cf, $fn, @args) if $do_arch && $fn =~ /(^|\/|-)PKGBUILD$/;
  return parse_preinstallimage($cf, $fn, @args) if $fn =~ /(^|\/|-)_preinstallimage$/;
  return undef;
}

sub query {
  my ($binname, %opts) = @_;
  my $handle = $binname;
  if (ref($binname) eq 'ARRAY') {
    $handle = $binname->[1];
    $binname = $binname->[0];
  }
  return Build::Rpm::query($handle, %opts) if $do_rpm && $binname =~ /\.rpm$/;
  return Build::Deb::query($handle, %opts) if $do_deb && $binname =~ /\.deb$/;
  return Build::Kiwi::queryiso($handle, %opts) if $do_kiwi && $binname =~ /\.iso$/;
  return Build::Arch::query($handle, %opts) if $do_arch && $binname =~ /\.pkg\.tar(?:\.gz|\.xz)?$/;
  return Build::Arch::query($handle, %opts) if $do_arch && $binname =~ /\.arch$/;
  return undef;
}

sub queryhdrmd5 {
  my ($binname) = @_;
  return Build::Rpm::queryhdrmd5(@_) if $do_rpm && $binname =~ /\.rpm$/;
  return Build::Deb::queryhdrmd5(@_) if $do_deb && $binname =~ /\.deb$/;
  return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.iso$/;
  return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.raw$/;
  return Build::Kiwi::queryhdrmd5(@_) if $do_kiwi && $binname =~ /\.raw.install$/;
  return Build::Arch::queryhdrmd5(@_) if $do_arch && $binname =~ /\.pkg\.tar(?:\.gz|\.xz)?$/;
  return Build::Arch::queryhdrmd5(@_) if $do_arch && $binname =~ /\.arch$/;
  return undef;
}

1;