openpkg-packages/openpkg-tool/openpkg-build.pl

##
##  openpkg-build.pl -- create build scripts from package index
##
##  Copyright (c) 2000-2003 Cable & Wireless Deutschland GmbH
##  Copyright (c) 2000-2003 The OpenPKG Project <http://www.openpkg.org/>
##  Copyright (c) 2000-2003 Ralf S. Engelschall <rse@engelschall.com>
##
##  Permission to use, copy, modify, and distribute this software for
##  any purpose with or without fee is hereby granted, provided that
##  the above copyright notice and this permission notice appear in all
##  copies.
##
##  THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
##  WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
##  MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
##  IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
##  CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
##  SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
##  LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
##  USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
##  ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
##  OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
##  OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
##  SUCH DAMAGE.
##

require 5;

$|=1; # autoflush

use strict;
use vars qw/
    $opt_R $opt_r $opt_f $opt_u $opt_U $opt_a $opt_A
    $opt_z $opt_Z $opt_P $opt_N $opt_E $opt_i $opt_D
    $opt_p $opt_q $opt_s $opt_S $opt_X $opt_M $opt_L
    $opt_W $opt_K $opt_e $opt_b $opt_B $opt_g/;
my $getopts = 'R:r:f:uUaAzZP:N:E:iD:p:qsSXMLWKebBg';
getopts($getopts);

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

sub getopts ($) {
    my($opts) = @_;
    my(%optf) = map { /(\w)/; $1 => $_ } $opts =~ /(\w:|\w)/g;
    my(%opts,@argv,$optarg);

    foreach (@ARGV) {
        if (@argv) {
            push @argv, $_;
        } elsif (defined $optarg) {
            if (exists $opts{$optarg}) {
                $opts{$optarg} .= " $_";
            } else {
                $opts{$optarg} = $_;
            }
            $optarg = undef;
        } elsif (!/^[-]/) {
            push @argv, $_;
        } else {
            while (/^\-(\w)(.*)/) {
                if (exists $optf{$1}) {
                    if (length($optf{$1}) > 1) {
                        if ($2 ne '') {
                            if (exists $opts{$1}) {
                                $opts{$1} .= " $2";
                            } else {
                                $opts{$1} = $2;
                            }
                        } else {
                            $optarg = $1;
                        }
                        last;
                    } else {
                        $opts{$1} = 1;
                    }
                } else {
                    warn "warning: unknown option $_\n";
                }
                $_ = "-$2";
            }
        }
    }
    if (defined $optarg) {
        warn "warning: option $optarg requires an argument\n";
    }

    foreach (keys %opts) {
        eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
    }

    @ARGV = @argv;
}

my(%env) = ( '' => { } );
if (open(FH, "< $ENV{'HOME'}/.openpkg/build")) {
    my($env) = $env{''};
    my($go) = $getopts;
    $go =~ s/[^a-zA-Z]//g;
    while (<FH>) {
        if (/^\s*\[([^\]]*)\]/) {
            $env{$1} = { } unless $env{$1};
            $env = $env{$1};
        } elsif (my($opt,$val) = /^\-([$go])\s*(.*?)\s*$/) {
            $val = 1 unless defined $val;
            if (exists $env->{$opt}) {
                $env->{$opt} .= " $val";
            } else {
                $env->{$opt} = $val;
            }
        }
    }
    close(FH);
}

die "openpkg:build:USAGE: $0 [-R rpm] [-r repository] [-f index.rdf] [-uUzZiqsSXMLWKebBg] [-P priv-cmd] [-N non-priv-cmd] [-p platform] [-Dwith ...] [-Ename ...] ( [-aA] | patternlist )\n"
    unless $#ARGV >= 0 || ($#ARGV == -1 && ($opt_a || $opt_A));

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

#
# evaluate a condition attribute from an option set
#
sub conditional ($$) {
    my($cond,$with) = @_;
    my(@s,$res);

    return 1 if $cond eq '' || !defined $with;

    foreach (split(/\s+/,$cond)) {
        if ($_ eq '+') {
            die "FATAL: stack underflow in: $cond\n" if scalar(@s)<2;
            my($a) = pop @s;
            my($b) = pop @s;
            push @s, $a && $b;
        } elsif ($_ eq '|') {
            die "FATAL: stack underflow in: $cond\n" if scalar(@s)<2;
            my($a) = pop @s;
            my($b) = pop @s;
            push @s, $a || $b;
        } elsif ($_ eq '!') {
            die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
            my($a) = pop @s;
            push @s, !$a;
        } else {
            push @s, ($with->{$_} eq 'yes') ? 1 : 0;
        }
    }
    die "FATAL: stack underflow in: $cond\n" if scalar(@s)<1;
    $res = pop @s;

    die "FATAL: stack not empty in: $cond\n" if scalar(@s)>0;
    return $res;
}

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

my($RPM,$CURL,$PROG);

$RPM = $opt_R || $env{''}->{'R'} || '@l_prefix@/bin/rpm';
$RPM = (`which $RPM` =~ m{^(/.*)})[0] if ($RPM !~ m|^/|);
die "FATAL: cannot locate rpm in path\n" unless $RPM =~ m{^/};

# augment command line parameters
foreach my $env (sort { $a cmp $b } grep { $RPM =~ /^\Q$_\E/ } keys %env) {
    while (my($opt,$val) = each %{$env{$env}}) {
        eval "\$opt_$opt = '$val' unless defined \$opt_$opt;";
    }
}

$CURL = $RPM;
$CURL =~ s/\/bin\/rpm$/\/lib\/openpkg\/curl/
    or die "FATAL: cannot deduce curl path from $RPM\n";

($PROG) = $0 =~ /(?:.*\/)?(.*)/;

sub cmd ($$) {
    my($w,$s) = @_;
    if (!defined $w) {
        return $s;
    } elsif ($w =~ /^-(.*)/) {
        return "$1 \"$s\"";
    } else {
        return "$w $s";
    }
}
sub priv  ($) { cmd($opt_P,$_[0]); }
sub npriv ($) { cmd($opt_N,$_[0]); }
sub run   ($) { my($c) = cmd($opt_N,$_[0]); `$c` }

sub version_cmp ($$) {
    my($a,$b) = @_;
    my(@a,@b,$c);
    my($ax,$bx);

    @a = split(/\./, $a);
    @b = split(/\./, $b);

    while (@a && @b) {
        if ($a[0] =~ /^\d+$/ && $b[0] =~ /^\d+$/) {
            $c = $a[0] <=> $b[0];
        } elsif ((($a,$ax) = $a[0] =~ /^(\d+)(.*)$/) &&
                 (($b,$bx) = $b[0] =~ /^(\d+)(.*)$/)) {
            $c = $a <=> $b;
            $c = $ax cmp $bx unless $c;
        } else {
            $c = $a[0] cmp $b[0];
        }
        return $c if $c;
        shift @a;
        shift @b;
    }

    $c = scalar(@a) <=> scalar(@b);

    return $c;
}

sub release_cmp ($$) {
    my($a,$b) = @_;

    return $a cmp $b;
}

sub vcmp ($$) {
    my($a,$b) = @_;

    return 0 if $a eq $b;

    my($av,$ar) = $a =~ /^(.*?)(?:\-([\d\.]+))?$/;
    my($bv,$br) = $b =~ /^(.*?)(?:\-([\d\.]+))?$/;
    my($c);

    if ((defined $ar) && (defined $br)) {
        $c = release_cmp($ar,$br);
        return $c if $c;
    }
    if ((defined $av) && (defined $bv)) {
        $c = version_cmp($av,$bv);
        return $c if $c;
    }
    return 0;
}

sub vs ($) {
    my($t) = @_;
    return defined $t->{release}
        ? "$t->{version}-$t->{release}"
        : $t->{version};
}

sub vsn ($) {
    my($t) = @_;
    return "$t->{name}-".vs($t);
}

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

sub get_config ()
{
    my($c,@q,@g);

    $c = run("$RPM --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu} %{_prefix}'");
    chomp($c);
    (@q) = split(/\s+/,$c);

    $q[1] =~ s/%{OS}/$q[2]/;
    $q[1] =~ s/%{ARCH}/$q[3]/;


    $c = run("$RPM --showrc");
    @g = $c =~ /\%\{l_tool_locate\s+([^\s\}]+)/g;

    return {
        rpmdir   => $q[0],
        template => $q[1],
        platform => '',
        prefix   => $q[4],
        optreg   => '(?:'.join('|', map { "\Quse_$_\E" } @g).')'
        };
}

sub get_release () {
    my($rel,$url);

    ($rel) = run("$RPM -qi openpkg") =~ /Version:\s*(\S+)/m;
    if ($rel =~ /^\d+$/) {
        print "# $PROG current($rel)\n";
        $url = "ftp://ftp.openpkg.org/current/";
    } elsif ($rel =~ /^(\d+\.\d+)/) {
        $rel = $1;
        print "# $PROG release($rel)\n";
        $url = "ftp://ftp.openpkg.org/release/$rel/";
    } else {
        die "FATAL: don't know how to handle this release\n";
    }

    return $url;
}

sub parse_provides ($) {
    my($s) = @_;
    my($nam,$val,$pre,$with,$pxy,$ver,$rel);

    ($nam,$val) = $s =~ /^(\S+)\s*(?:=\s*(\S*?))?$/;

    #
    # build options are encoded as a Requirement
    # <packagename>::<buildoption> = <value>
    #
    # since the value is interpreted as a version number
    # you can only do equality tests
    #
    if (($pre,$with) = $nam =~ /^(\S+?)::(\S*)$/) {
        $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg;
        ($ver,$rel,$pxy) = ($val, undef, undef);
    } else {
        ($ver,$rel,$pxy) = $val =~ /^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/;
    }

    return {
        name    => $nam,     # the full name of the resource
        version => $ver,     # the version (or value)
        release => $rel,     # and release number
        proxy   => $pxy,     # wether the resource is a PROXY resource
        prefix  => $pre,     # the packagename (if resource is an option)
        with    => $with     # the buildoption (if resource is an option)
    };
}

sub parse_depends ($) {
    my($dep) = @_;
    my($name, $op, $val);

    if (ref $dep) {
        #
        # dependency from new index stored as a node
        #
        # content of the node is the name
        # certain attributes denote the comparison operator
        # the value of such an attribute is the comparison operand
        #
        # the operator (and operand) are optional and there can
        # only be one
        #
        $name    = $dep->{content};
        $op = undef;
        $op = 'equ' if exists $dep->{equ};
        $op = 'geq' if exists $dep->{geq};
        $op = 'leq' if exists $dep->{leq};
        $op = 'gt'  if exists $dep->{gt};
        $op = 'lt'  if exists $dep->{lt};
        if (defined $op) {
            $val = $dep->{$op};
        }
    } elsif ($dep =~ /\S/) {
        #
        # dependency from old index stored as text string
        #
        # "name operator operand"
        # or
        # "name"
        #
        ($name,$op,$val) = $dep =~ /(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/;
        if (defined $op) {
            $op = {
                '=='  => 'equ', '='   => 'equ',
                '>='  => 'geq', '=>'  => 'geq',
                '<='  => 'leq', '=<'  => 'leq',
                '>'   => 'gt',  '<'   => 'lt'
            }->{$op};
            unless (defined $op) {
                print "# don't know how to handle dependency: $dep\n";
                return;
            }
        }
    }

    return {
        name => $name,
        op   => $op,
        val  => $val
    };
}

sub depends2provides ($) {
    my($dep) = @_;
    my($ver,$rel,$pxy,$pre,$with);

    ($ver,$rel,$pxy) = $dep->{val} =~ /^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/;
    ($pre,$with) = $dep->{name} =~ /^(\S+?)::(\S*)$/;

    return {
        name    => $dep->{name},
        version => (defined $ver ? $ver : $dep->{val}),
        release => $rel,
        proxy   => $pxy,
        prefix  => $pre,
        with    => $with
    }
}

#
# convert parser output to dependency records
#
sub depend_list ($) {
    my($dl) = @_;
    foreach (@$dl) {
        $_->{value} = parse_depends($_->{value});
    }
    return $dl;
}

#
# compute list of package names from dependency list
#
sub depends2pkglist ($) {
    my($t) = @_;
    my(%d) = unique_map($t->{depends}, $t->{keeps});
    return (keys %d);
}

#
# retrieve the local installed base
#
# for packages that provide option resources (packagename::buildoption)
# the options are parsed into the OPTIONS hash
#
# other packages will query options on demand
#
sub get_installed () {
    my(%map);
    my(@l) = run("$RPM --provides -qa");
    my($p);
    my($nam,$val,%options);

    foreach (@l) {
        $p = parse_provides($_);

        if (defined $p->{with}) {
            $options{$p->{prefix}}->{$p->{with}} = $p->{version}
        }

        push @{$map{$p->{name}}->{vs($p)}}, {
            name       => $p->{name},
            version    => (defined $p->{version} ? $p->{version} : '*'),
            release    => (defined $p->{release} ? $p->{release} : '*'),
            PROXY      => $p->{proxy}
        };
    }

    #
    # options are provided for a package
    # apply them to all instances of the package
    #
    foreach $nam (keys %options) {
        foreach $val (keys %{$map{$nam}}) {
            foreach (@{$map{$nam}->{$val}}) {
                $_->{OPTIONS} = $options{$nam};
            }
        }
    }

    return \%map;
}

#
# compute reverse dependency map
#
#
sub get_revdep ($$) {
    my($env, $i) = @_;
    my($r) = $env->{'repository'};
    my($pkg, %dep, %dlist, %rev);
    my(@vers,$t);

    print "# computing reverse dependencies\n";

    foreach $pkg (keys %$i) {

        unless ($r->{$pkg}) {
            print "# ATTENTION: $pkg has no upgrade path\n";
            next;
        }

        #
        # get list of package versions from repository
        #
        @vers = get_versions($r->{$pkg}, sub { 1; });

        #
        # get forward dependencies from repository packages
        #
        # dep{a}{b} is true if b depends directly on a
        # dlist{a}  is list of packages that depend on a
        #
        foreach (@vers) {
            foreach $t (@{$r->{$pkg}->{$_}}) {
                next unless $i->{$t->{name}};
                next unless $t->{depends} || $t->{keeps};
                foreach (depends2pkglist($t)) {
                    unless ($dep{$_}{$t->{name}}) {
                        $dep{$_}{$t->{name}} = 1;
                        push @{$dlist{$_}}, $t;
                    }
                }
            }
        }
    }

    #
    # sort reverse dependencies
    #
    foreach $pkg (keys %dep) {
        $rev{$pkg} = [
            sort {
                $dep{$b->{name}}{$a->{name}} ||
                -$dep{$a->{name}}{$b->{name}} ||
                $a->{name} cmp $b->{name}
            } @{$dlist{$pkg}}
        ];
    }

    return \%rev;
}

#
# parse option from rpm output
#
sub parse_options ($) {
    my($l) = @_;
    $l = join("\n", @$l) if ref $l;
    return {} if ($l !~ m/(--define|\%option\s+)/s);
    my $with = {};
    $l =~ s/--define\s*'(\S+)\s+(\S+?)'/$with->{$1} = $2, ''/sge; # before openpkg-20021230
    $l =~ s/\%option\s+(\S+)\s+(\S+)/$with->{$1} = $2, ''/sge;     # after  openpkg-20021230
    return $with;
}

#
# parse option from rpm provides list
#
sub parse_provideslist ($) {
    my($l) = @_;
    my($p);
    my($nam,$val,%opts);

    foreach (@$l) {
        $p = parse_provides($_);
        next unless defined $p->{with} && defined $p->{prefix};
        $opts{$p->{with}} = $p->{version}
    }

    return \%opts;
}

#
# copy options from new to old
# where option already exists in old or option key
# matches regular expression
#
sub override_options ($$$) {
    my($old, $new, $reg) = @_;

    foreach my $k (keys %$new) {
        if ((exists $old->{$k} && $old->{$k} ne $new->{$k}) || $k =~ /^$reg$/) {
            $old->{$k} = $new->{$k};
        }
    }
}

#
# pull in OPTIONS for a package or an RPM file
#
sub get_with ($;$) {
    my($t,$fn) = @_;
    my(@l,%with);
    my($optmap,$opt);

    if ($t->{OPTIONS}) {
        $opt = $t->{OPTIONS};
    } else {
        if (defined $fn) {
            @l = run("$RPM -q --provides -p $fn");
        } else {
            @l = run("$RPM -q --provides $t->{name}");
	    }
        $opt = parse_provideslist(\@l);
        if (scalar(keys %$opt) == 0) {
            if (defined $fn) {
                @l = run("$RPM -qi -p $fn");
            } else {
                @l = run("$RPM -qi $t->{name}");
            }
            $opt = parse_options(\@l);
        }

        $t->{OPTIONS} = $opt;
    }
    return $opt;
}

#
# compute absolute paths
#
# (url, fn) point to a base document
# the location is the file path fn if fn is
# defined, otherwise it is url.
#
# augment the pointer with suburl
#
# suburl can be an absolute url
# then the new pointer is (suburl, undef)
#
# suburl can be a absolute file path
# then the new pointer is (suburl, suburl)
#
# suburl can be a relative path
# then it augments url or fn accordingly
#
sub relurl ($$$) {
    my($url,$fn,$suburl) = @_;
    my($subfn);

    if ($suburl =~ /^\w+:\/\//) {
        # NOP
    } elsif ($suburl =~ /^\//) {
        $subfn = $suburl;
    } else {
        if (defined $fn) {
            $subfn = $fn;
            $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
            $suburl = $subfn;
        } else {
            $subfn = $url;
            $subfn =~ s/(\/)?\/*[^\/]*$/$1$suburl/;
            $suburl = $subfn;
            $subfn  = undef;
        }
    }

    return ($suburl, $subfn);
}

#
# return node value from XML parser
#
sub xel($) {
    my($a) = @_;
    my($l) = $a->[0];
    return '' if ref $l;
    return $l;
}

#
# convert conditional XML Bag into flat list
#
sub xwith ($) {
    my($bags) = @_;
    my($bag,$li,$el);
    my(@out);

    foreach $bag (@$bags) {
        foreach $li (@{$bag->{'rdf:bag'}}) {
            $el = $li->{'resource'} || $li->{'rdf:li'};
            foreach (@$el) {
                push @out, {
                    cond   => $bag->{'cond'},
                    value  => $_
                };
            }
        }
    }

    return \@out;
}

#
# convert simple parser Bag into flat list
#
sub swith ($$) {
    my($bags,$name) = @_;
    my($cond);
    my(@out);

    foreach $cond (keys %$bags) {
        foreach (@{$bags->{$cond}->{$name}}) {
            push @out, {
                cond  => $cond,
                value => $_
            };
        }
    }

    return \@out;
}

sub goodpf ($$) {
    my($l,$p) = @_;
    return 1 if $l eq '';
    return $l =~ /(?:^|\s)\Q$p\E(?:\s|$)/;
}

sub simple_text_parser ($$$$$) {
    my($fh,$url,$map,$pfmatch,$installed) = @_;
    my(@include);

    my($section);
    my($name,$version);
    my($href,$release,$desc,$bags);
    my(%options,@provides);
    my($platform,$prefix);
    my($rec);
    my($tag,$cond,$attrname,$attrval,$body);
    my($usecond);
    my($options);

    print "# using simple text parser\n";

    while (<$fh>) {

        s/&gt;/>/g;
        s/&lt;/</g;

        if (!(defined $href) && /<rdf:Description.*?href="([^"]*)"/) {
            $href      = $1;
            $section   = undef;
            $name      = undef;
            $release   = undef;
            $desc      = '';
            $platform  = undef;
            $prefix    = undef;
            $bags      = {};
            @provides  = ();
        }

        if (!(defined $href) &&
            /<Repository.*?href="([^"]*)"(?:\s*platform="([^"]*)")?/
            ) {
            if (goodpf($2,$pfmatch)) {
                push(@include, $1)
            }
            next;
        }

        next unless defined $href;

        ($tag,$cond,$attrname,$attrval,$body) = m{
            <
            (\/?[\w:]+)
            \s*
            (?:cond="([^"]+)")?
            (?:(\w+)="([^"]+)")?
            >
            (.*?)
            (?:<\/\1>)?
            $
            }mx;

        if ($tag eq 'Description') {
            $usecond = $cond;
            $section = 'description';
        } elsif ($tag eq '/Description') {
            $usecond = $cond;
            $section = undef;
        } elsif ($section eq 'description') {
            $desc .= $_;
        } elsif ($tag eq 'PreReq') {
            $usecond = $cond;
            $section = 'prereq';
        } elsif ($tag eq '/PreReq') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'BuildPreReq') {
            $usecond = $cond;
            $section = 'bprereq';
        } elsif ($tag eq '/BuildPreReq') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'Provides') {
            $usecond = $cond;
            $section = 'provides';
        } elsif ($tag eq '/Provides') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'Conflicts') {
            $usecond = $cond;
            $section = 'conflicts';
        } elsif ($tag eq '/Conflicts') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'NoSource') {
            $usecond = $cond;
            $section = 'nosource';
        } elsif ($tag eq '/NoSource') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'Source') {
            $usecond = $cond;
            $section = 'source';
        } elsif ($tag eq '/Source') {
            $usecond = undef;
            $section = undef;
        } elsif ($tag eq 'Name') {
            $name = $body;
        } elsif ($tag eq 'Version') {
            $version = $body;
        } elsif ($tag eq 'Release') {
            $release = $body;
        } elsif ($tag eq 'Platform') {
            $platform = $body;
        } elsif ($tag eq 'Prefixes') {
            $prefix = $body;
        } elsif ($tag eq 'rdf:li' || $tag eq 'resource') {
            if (defined $attrname) {
                $body = {
                    $attrname => $attrval,
                    content   => $body
                };
            }
            if ($section eq 'provides') {
                push @provides, $body;
            } elsif ($section ne '') {
                push @{$bags->{"$usecond"}->{$section}}, $body;
            }
        } elsif ($tag eq '/rdf:Description') {

            if (defined $href &&
                defined $name &&
                defined $version &&
                defined $release) {

                @provides = map {
                    depends2provides(parse_depends($_))
                } @provides;

                %options = map {
                    ( $_->{with} => $_->{version} )
                } grep {
                    defined $_->{with}
                } @provides;

                push(@provides, {
                    name    => $name,
                    version => $version,
                    release => $release
                });

                $options = %options
                    ? { %options }
                    : parse_options($desc);

                if ($options) {
                    my(@t) = get_targets($installed->{$name},sub { 1; });
                }

                eval {
                    $rec = {
                        href      => (relurl($url, undef, $href))[0],
                        name      => $name,
                        version   => $version,
                        release   => $release,
                        depends   => depend_list(swith($bags,'bprereq')),
                        keeps     => depend_list(swith($bags,'prereq')),
                        conflicts => swith($bags,'conflicts'),
                        source    => swith($bags,'source'),
                        nosource  => swith($bags,'nosource'),
                        desc      => $desc,
                        platform  => $platform,
                        prefix    => $prefix,
                        OPTIONS   => $options,
                        DEFOPTS   => { %$options }
                    };
                };
                if ($@) {
                    die "ERROR: when reading entry '$name'\n".$@;
                }

                foreach (@provides) {
                    push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
                }
            }

            $href = undef;
        }
    }

    return \@include;
}

sub xml_parser ($$$$$) {
    my($fh, $url, $map, $pfmatch, $installed) = @_;
    my(@include);

    my($xml,$rep,$sub);
    my($provides,@provides,%options,$rec);
    my($href,$name,$version,$release,$desc);
    my($options);

    print "# using XML parser\n";

    $xml = XML::Simple::XMLin($fh, forcearray => 1);
    $rep = $xml->{'Repository'}->[0]->{'rdf:Description'};
    $sub = $xml->{'Repository'}->[0]->{'Repository'};

    foreach (@$rep) {

        $href    = $_->{'href'};
        $name    = xel($_->{'Name'});
        $version = xel($_->{'Version'});
        $release = xel($_->{'Release'});

        next unless defined $href &&
                    defined $name &&
                    defined $version &&
                    defined $release;

        $provides = $_->{'Provides'}->[0]->{'rdf:bag'}->[0];
        if ($provides->{'rdf:li'}) {
            $provides = $provides->{'rdf:li'};
        } else {
            $provides = $provides->{'resource'};
        }
        @provides = map {
            depends2provides(parse_depends($_))
        } @$provides;

        %options = map {
            ( $_->{with} => $_->{version} )
        } grep {
            defined $_->{with}
        } @provides;

        push(@provides, {
            name    => $name,
            version => $version,
            release => $release
        });

        $desc = xel($_->{'Description'});
        $options = %options
            ? { %options }
            : parse_options($desc);

        if ($options) {
            my(@t) = get_targets($installed->{$name},sub { 1; });
        }

        eval {
            $rec = {
                href      => (relurl($url, undef, $href))[0],
                name      => $name,
                version   => $version,
                release   => $release,
                platform  => xel($_->{'Platform'}),
                prefix    => xel($_->{'Prefixes'}),
                depends   => depend_list(xwith($_->{'BuildPreReq'})),
                keeps     => depend_list(xwith($_->{'PreReq'})),
                conflicts => xwith($_->{'Conflicts'}),
                source    => xwith($_->{'Source'}),
                nosource  => xwith($_->{'NoSource'}),
                desc      => $desc,
                OPTIONS   => $options,
                DEFOPTS   => { %$options }
            };
        };
        if ($@) {
            die "ERROR: when reading entry '$name'\n".$@;
        }

        foreach (@provides) {
            push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
        }
    }

    if ($sub) {
        @include = map {
            goodpf($_->{platform},$pfmatch)
            ? ( $_->{href} )
            : ( )
        } @$sub;
    }

    return \@include;
}

sub open_index ($$) {
    my($url, $fn) = @_;
    my($fetch,$bzip2,$path);

    $fetch = defined $fn ? $fn : $url;

    $bzip2 = $RPM;
    $bzip2 =~ s/bin\/rpm$/lib\/openpkg\/bzip2/
        or die "FATAL: cannot deduce bzip2 path from $RPM\n";

    $fetch !~ /\.bz2$/ || -x $bzip2
        or die "FATAL: $bzip2 not found\n";

    if ($fetch =~ /^\w+:/) { # looks like URL scheme

        print "# curling index $fetch\n";
        if ($fetch =~ /\.bz2$/) {
            $path = "$CURL -q -s -o - \"$fetch\" | $bzip2 -dc |";
        } else {
            $path = "$CURL -q -s -o - \"$fetch\" |";
        }
    } else {
        print "# reading index file $fn\n";
        if ($fetch =~ /\.bz2$/) {
            $path = "$bzip2 -dc $fetch |";
        } else {
            $path = "< $fetch";
        }
    }

    open(RFH, $path) or
        die "FATAL: cannot open '$fetch' ($!)\n";
}

#
# fetch index from file or URL
# recursively fetch sub-indexes
#
sub get_index ($$$$$) {
    my($url,$fn,$noxml,$pfmatch,$installed) = @_;
    my(%map,$include);
    my($parser);

    open_index($url,$fn);

    unless ($noxml) {
        eval {
            require XML::Simple;
        };
        $noxml = 1 if $@;
    }

    $parser = $noxml ? \&simple_text_parser : \&xml_parser;
    $include = $parser->(\*RFH, $url, \%map, $pfmatch, $installed);

    close(RFH)
        or die "FATAL: an I/O error occured\n";

    #
    # cannot do real recursions on file handles, so we simply append
    # all sub-RDFs, the result is flattend into a big hash anyway
    #
    foreach (@$include) {
        my($submap);
        my($suburl,$subfn) = relurl($url,$fn,$_);
        $submap = get_index($suburl,$subfn,$noxml,$pfmatch,$installed);
        while (my($name,$vmap) = each %$submap) {
            while (my($vs,$recs) = each %$vmap) {
                push @{$map{$name}->{$vs}}, @$recs;
            }
        }
    }

    return \%map;
}

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

#
# grep all versions of a name that
# satisfy a condition
#
sub get_versions ($$) {
    my($relmap, $cond) = @_;
    return grep { $cond->($_); }
           sort { vcmp($a,$b); } keys %$relmap;
}

#
# fetch targets of a name that
# satisfies a condition
#
sub get_targets ($$) {
    my($relmap, $cond) = @_;
    return map {
            @{$relmap->{$_}}
        } get_versions($relmap, $cond);
}

#
# check if target record describes a source package
#
sub is_source ($) {
    my($t) = @_;
    return !(defined $t->{'prefix'});
}

#
# there can be multiple sources for a target release
#
sub chose_source ($$$$$) {
    my($env, $name, $select, $vmap, $cond) = @_;
    my(@vers,@recs,@nrecs,$rec,%nam);

    @vers = get_versions($vmap, sub { 1; });
    return unless @vers;

    @recs = map { $_->[1] } grep {
                my($v,$t) = @$_;
                is_source($t) ||
                ( !$env->{sourceonly} &&
                  $t->{'platform'} eq $env->{config}->{platform} &&
                  $t->{'prefix'} eq $env->{config}->{prefix} &&
                  $cond->($v)
                )
            } map {
                my($v) = $_;
                my($l) = $vmap->{$_};
                map { [ $v, $_ ] } @$l;
            } @vers;
    return unless @recs;

    if (defined $select) {
        @recs = grep {
            vsn($_) =~ /^\Q$select\E/
        } @recs;
    }

    if (scalar(@recs) > 1) {
        @nrecs = grep {
            $env->{built}->{$_->{name}} ||
            $env->{installed}->{$_->{name}}
            } @recs;
        @recs = @nrecs if @nrecs;
    }

    if (scalar(@recs) > 1) {
        @nrecs = grep {
            $name eq $_->{name}
        } @recs;
        @recs = @nrecs if @nrecs;
    }

    if (scalar(@recs) > 1 && !$env->{sourceonly}) {
        @nrecs = grep {
            defined $_->{'platform'}
        } @recs;
        @recs = @nrecs if @nrecs;
    }

    if (scalar(@recs) > 1) {
        %nam = map { $_->{name} => 1 } @recs;
        if (scalar(keys %nam) > 1) {
            print "# ambigous sources for $name\n";
            my($i) = 0;
            foreach (@recs) {
                print "# $i: ".vsn($_)." = $_->{href}\n";
                $i++;
            }
            return;
        }
    }
    
    if (scalar(@recs) == 0) {
        return;
    }

    $rec = $recs[-1];

    print "# source for $name is ".vsn($rec)."\n";

    return $rec;
}

#
# see wether target is in map
#
sub target_exists ($$) {
    my($target, $map) = @_;
    my($vmap) = $map->{$target->{name}};

    return unless $vmap;

    return !defined $target->{version} ||
            defined $vmap->{vs($target)};
}

#
# find target in map
#
sub find_target ($$) {
    my($name, $map) = @_;
    my($vmap) = $map->{$name};
    my(@vs);

    return unless $vmap;

    @vs = sort { vcmp($b,$a) } keys %$vmap;
    return $vmap->{$vs[0]}->[-1];
}

#
# lookup target in map
#
sub target_lookup ($$) {
    my($target, $map) = @_;
    my($vmap,$vers);

    $vmap = $map->{$target->{name}};
    return unless $vmap;
    $vers = $vmap->{vs($target)};
    return unless $vers && @$vers;
    return $vers->[0];
}

#
# retrieve conditional target attributes in map
#
sub target_attribute ($$$) {
    my($target, $env, $attr) = @_;
    my($with)   = $env->{with};
    my($optreg) = $env->{config}->{optreg};
    my($name)   = $target->{name};
    my(@out);

    return unless $target;

    my(%mywith) = %{$target->{OPTIONS}};
    override_options(\%mywith, name_with($name, $with), $optreg);

    foreach (@{$target->{$attr}}) {
        next unless conditional($_->{'cond'}, \%mywith);
        push @out, $_->{'value'};
    }
    return \@out;
}

#
# see wether target has conflicts
#
sub target_conflicts ($$) {
    my($target, $env) = @_;
    return target_attribute($target, $env, 'conflicts');
}

#
# retrieve build dependencies for target
#
sub target_depends ($$) {
    my($target, $env) = @_;
    return target_attribute($target, $env, 'depends');
}

#
# retrieve runtime dependencies for target
#
sub target_keeps ($$) {
    my($target, $env) = @_;
    return target_attribute($target, $env, 'keeps');
}

#
# retrieve source list for target
#
sub target_source ($$) {
    my($target, $env) = @_;
    return target_attribute($target, $env, 'source');
}

#
# retrieve nosource list for target
#
sub target_nosource ($$) {
    my($target, $env) = @_;
    return target_attribute($target, $env, 'nosource');
}

#
# check wether target conflicts against map
#
sub target_has_conflicts ($$$) {
    my($target, $map, $env) = @_;
    my($conflicts, $t);

    $conflicts = target_conflicts($target, $env);
    foreach (@$conflicts) {
        my($t) = find_target($_, $map);
        return $t if $t;
    }
    return;
}

#
# strip doubles from depend/keep lists
# and a return a map name => depend/keep
#
sub unique_map {
    my(%out);
    foreach (@_) {
        foreach (@$_) {
            $out{$_->{value}->{name}} = $_;
        }
    }
    return (%out);
}

#
# determine wether target should be rebuild
#
sub target_better ($$$) {
    my($env, $target, $map) = @_;
    my($vs) = vs($target);
    my($vmap) = $map->{$target->{name}};

    #
    # rebuild if target isn't installed
    #
    return 'new' unless $vmap;

    #
    # if -e then
    # always update if installed version is different from repository
    #
    if ($env->{exact} && !grep { vcmp($vs, $_) == 0; } keys %$vmap) {
        return 'exact';
    }
    #
    # if target is goal
    # always update if installed version is older than repository
    #
    if ($target->{GOAL} && !grep { vcmp($vs, $_) <= 0; } keys %$vmap) {
        return 'goal';
    }
    #
    # if -U then
    # always update if installed version is older than repository
    #
    if ($env->{upgrade} && !grep { vcmp($vs, $_) <= 0; } keys %$vmap) {
        return 'upgrade';
    }
    #
    # if -z/-Z then
    # always update if installed version is equal or older than repository
    if ($env->{zero} && grep { vcmp($vs, $_) >= 0; } keys %$vmap) {
        return 'zero';
    }

    # keep installed target
    return;
}

#
# filter package options
#
sub filter_name_with ($$$) {
    my($name, $with, $global) = @_;
    my(@keys);

    if ($global) {
        push(@keys, grep { !/::/ } keys %$with);
    }
    push(@keys, grep { /::/ } keys %$with);

    return {
        map {
            my($k) = $_;
            $k !~ /::/ || $k =~ s/^\Q$name\E:://
            ? ( $k => $with->{$_} )
            : ( )
        } @keys
    };
}

#
# filter out package relevant options
#
sub name_with ($$) {
    filter_name_with($_[0],$_[1],1);
}

#
# filter out package specific options
#
sub name_only_with ($$) {
    filter_name_with($_[0],$_[1],0);
}

#
# check wether installed package matches
# build options
#
sub target_suitable ($$) {
    my($target, $with) = @_;
    my($iwith);
    my($k,$v);

    if ($target->{GOAL}) {
        $with = name_with($target->{name}, $with);
    } else {
        $with = name_only_with($target->{name}, $with);
    }

    $iwith = $target->{OPTIONS};
    while (($k,$v) = each %$with) {
        if (exists $iwith->{$k}) {
            return 0 if $iwith->{$k} ne $with->{$k};
        }
    }

    return 1;
}

#
# record target status
#
sub target_setstatus ($$$) {
    my($target, $status, $pri) = @_;

    if ($pri > $target->{STATUSPRI}) {
        $target->{STATUSPRI} = $pri;
        $target->{STATUS}    = $status;
    }
}

#
# report options that are not used for 
#
sub warn_about_options ($$$) {
    my($target, $with, $c) = @_;
    my($iwith) = $target->{OPTIONS};
    my($k,$v);

    return unless defined $iwith;
    $with = name_with($target->{name}, $with);
    while (($k,$v) = each %$with) {
        unless ($k =~ /^$c->{optreg}$/ || exists $iwith->{$k}) {
            print "# ATTENTION: $target->{name} ignores option '$k'\n";
        }
    }
}

#
# add dependency as build option
#
sub depend_option ($$$) {
    my($target,$dep,$env) = @_;
    my($with,$opt,$relmap,@t,$t);
    my($pro) = depends2provides($dep);
    my($conflict) = 0;

    return 1 unless defined $pro->{with};

    my($val) = defined $pro->{version} ? $pro->{version} : 'yes';

    $with = $env->{with};
    $opt  = $pro->{prefix}.'::'.$pro->{with};
    if (defined $with->{$opt} && $with->{$opt} ne $val) {
        print "# ",vsn($target),
            " has conflicting requirement $opt = $with->{$opt} != $val\n";
        $conflict = 1;
    }

    $relmap = $env->{built}->{$pro->{prefix}} ||
              $env->{installed}->{$pro->{prefix}};
    @t = get_targets($relmap, sub { 1; });
    foreach $t (@t) {
        $with = $t->{OPTIONS};
        $opt  = $pro->{with};
        if (defined $with->{$opt} && $with->{$opt} ne $val) {
            print "# ",vsn($t),
                " has conflicting requirement $opt = $with->{$opt} != $val\n";
            $conflict = 1;
        }
    }

    return 0 if $conflict;
                  
    print "# ",vsn($target)," adds option $opt = $val\n";
    $with->{$opt} = $val;
    return 1;
}

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

#
# LOGIC
#

#
# locate target for a dependency
#
sub dep2target ($$) {
    my($dep, $env) = @_;
    my($name,$op,@vers);
    my($i,$r,$b,$cond,$version);
    my($t,$tdef,$why);

    ($name, $op, $version) = ($dep->{name}, $dep->{op}, $dep->{val});

    $i = $env->{installed}->{$name};
    $r = $env->{repository}->{$name};
    $b = $env->{built}->{$name};

    return unless $i || $r || $b;

    if (!defined $op) {
        $cond = sub { 1; };
    } elsif ($op eq 'geq') {
        $cond = sub { vcmp($_[0],$version) >= 0; };
    } elsif ($op eq 'leq') {
        $cond = sub { vcmp($_[0],$version) <= 0; };
    } elsif ($op eq 'gt') {
        $cond = sub { vcmp($_[0],$version) > 0; };
    } elsif ($op eq 'lt') {
        $cond = sub { vcmp($_[0],$version) < 0; };
    } elsif ($op eq 'equ') {
        $cond = sub { vcmp($_[0],$version) == 0; };
    } else {
        die "FATAL: internal error in dep2target\n";
    }

    $tdef = undef;

    #
    # search installed target that matches requirement
    # use it if we are not upgrading (no -U and no -z/-Z)
    #
    if ($i && (@vers = get_versions($i, $cond))) {
        foreach (@vers) {
            $t = $i->{$_}->[0];
            get_with($t);
            if (target_suitable($t, $env->{with})) {
                $tdef = $t;
                unless ($env->{upgrade} || $env->{zero}) {
                    return ($t, 1);
                }
            }
        }
    }

    #
    # search target in current build list that matches requirement
    # use it if it exists
    #
    if ($b && (@vers = get_versions($b, $cond))) {
        return ($b->{$vers[0]}->[0], 1);
    }

    #
    # search target in repository and install it, if it is newer
    # than corresponding installed versions
    # avoid repository packages that would install 'new' (i.e.
    # are not an upgrade of an existing package)
    #
    $t = chose_source($env, $name, undef, $r, $cond);
    if ($t) {
        if (!$tdef || (
            $why = target_better($env, $t, $env->{installed}) &&
            $why ne 'new'
            )) {
            return ($t, 0);
        }
    }

    #
    # if nothing is suitable in repository then fall back to
    # anything we already have installed but that we skipped
    # above to look for upgrades.
    #
    if ($tdef) {
        return ($tdef, 1);
    }

    return;
}

#
#
#
sub make_dep ($$$$$$$) {
    my($who,$target,$depth,$env,$list,$blist,$clist) = @_;
    my($d,$k,%d,%k,$t,$old);
    my(@deps,$conflict,$why);

    if (target_exists($target, $env->{built})) {
        print "# $target->{name} is already in list\n";
        return;
    }

    if ($t = target_has_conflicts($target, $env->{installed}, $env)) {
        target_setstatus($target,'CONFLICT',4);
        push(@$clist,$target);
        print "# $target->{name} conflicts with ",vsn($t),"\n";
        return;
    }

    if ($t = target_has_conflicts($target, $env->{built}, $env)) {
        target_setstatus($target,'CONFLICT',4);
        push(@$clist,$target);
        print "# $target->{name} conflicts with ",vsn($t),"\n";
        return;
    }

    #
    # see if a target is already installed and requires a rebuild
    #
    if ($t = find_target($target->{name}, $env->{installed})) {
        if (exists $env->{exclude}->{$target->{name}}) {
            print "# excluding $target->{name} (no upgrade allowed)\n";
            return;
        }
        # pull in options
        if ($target->{REBUILD}) {
            target_setstatus($target,'DEPEND',1);
            print "# rebuilding $target->{name} (dependency)\n";
        } elsif ($env->{zero}) {
            target_setstatus($target,'ZERO',1);
            print "# rebuilding $target->{name} (zero)\n";
        } elsif ($why = target_better($env, $target, $env->{installed})) {
            target_setstatus($target,'UPDATE',3);
            print "# rebuilding $target->{name} ($why)\n";
        } elsif (!target_suitable($t, $env->{with})) {
            target_setstatus($target,'MISMATCH',2);
            print "# rebuilding $target->{name} (parameter mismatch)\n";
        } elsif ($env->{goals} && $target->{GOAL}) {
            target_setstatus($target,'GOAL',3);
            print "# rebuilding $target->{name} (goal)\n";
        } else {
            print "# $target->{name} is already installed\n";
            return;
        }
        # use options from installed base
        override_options(get_with($target), get_with($t),
                         $env->{config}->{optreg});
        # remember this is a rebuild for a proxy package
        $target->{PROXY} = $t->{PROXY};
        $target->{REBUILD} = 1;
    } else {
        target_setstatus($target,'ADD',3);
    }

    if (exists $env->{exclude}->{$target->{name}}) {
        die "FATAL: target ".vsn($target)." is forbidden\n";
    }

    # mark this as a target before reverse dependencies trigger
    # it again
    push(@{$env->{built}->{$target->{name}}->{vs($target)}}, $target);
    $target->{LIMBO} = 1;

    $d = target_depends(target_lookup($target, $env->{repository}), $env);
    $k = target_keeps(target_lookup($target, $env->{repository}), $env);

    #
    # recurse over dependencies
    #
    if (@$d || @$k) {

        %d = unique_map($d, $k);
        %k = unique_map($k);

        @deps     = ();
        $conflict = 0;
        foreach (keys %d) {

            # old index misses a OpenPKG provider in the index... skip it
            next if $_ eq 'OpenPKG';

            ($t,$old) = dep2target($d{$_}, $env);
            if ($t) {
                if ($old) {
                    print "# $target->{name} uses ".vsn($t)." for $_\n";
                    if ($t->{LIMBO}) {
                        print "# ATTENTION: ".vsn($t)." is in LIMBO\n";
                    }
                }

                # record which targets to keep in blist
                if ($k{$_}) {
                    push @$blist,$t;
                    print "# $target->{name} installs ".vsn($t)." for $_\n";
                } else {
                    print "# $target->{name} requires ".vsn($t)." for $_\n";
                }

                unless (depend_option($t, $d{$_}, $env)) {
                    print "# $target->{name} has conflicting requirement\n";
                    push(@{$env->{fatal}},vsn($target));
                    target_setstatus($target,'UNDEF',4);
                    push @$clist, $target;
                    $conflict = 1;
                    next;
                }

                push @deps, $t;
            } else {
                print "# $target->{name} searches a frood called '$_'\n";
                push(@{$env->{fatal}},vsn($target));
                target_setstatus($target,'UNDEF',4);
                push @$clist, $target;
                $conflict = 1;
            }
        }

        unless ($conflict) {
            foreach $t (@deps) {
                make_dep($target,$t,$depth+1,$env,$list,$blist,$clist);
            }
        }
    }

    print "# adding ".vsn($target)." to list\n";
    $target->{WHO} = $who;
    $target->{WHY} = $target->{STATUS};
    push(@$list, $target);
    $target->{LIMBO} = 0;
     
    # remember new options
    override_options($target->{OPTIONS},
                     name_with($target->{name}, $env->{with}),
                     '');

    foreach (@{target_nosource($target,$env)}) {
        my($p) = target_source($target,$env)->[$_];
        $p =~ s/.*\///;
        print "# ATTENTION: unpackaged source $_: $p\n";
    }

    #
    # a dependency could not be resolved, don't bother with reverse
    # dependencies for this target
    #
    return if $conflict;

    if (!$env->{quick} &&
        $target->{name} ne 'openpkg' &&
        $target->{REBUILD}) {

        unless ($env->{revdep}) {
            $env->{revdep} = get_revdep($env, $env->{installed});
        }

        foreach $t (@{$env->{revdep}->{$target->{name}}}) {

            # this is a rebuild, triggering further revdeps
            $t->{REBUILD} = 1;

            # this is a rebuild, keep this installed
            push(@$blist, $t);

            print "# rebuilding revdep ".vsn($t)."\n";
            make_dep($target,$t,$depth+1,$env,$list,$blist,$clist);
        }
    }
}

#
# grep environment for packages that match a pattern
#
sub search_pattern ($$) {
    my($pattern, $env) = @_;
    my(@todo);

    #
    # handle various patterns
    #
    if (defined $pattern) {
        @todo = map {
            my($p) = $_;
            my($s);
            $s = $1 if $p =~ s/(,[^\s,]+)$//;
            if ($p =~ s/\*+$//) {
                $p = '^'.quotemeta($p).'';
            } else {
                $p = '^'.quotemeta($p).'$';
            }
            map {
                "$_$s"
            } grep {
                /$p/
            } keys %{$env->{repository}}
        } split(/\s+/,$pattern);
    } else {
        #
        # undefined pattern means -a option that selects
        # all packages from repository that are installed
        #
        @todo = grep {
                    my($n) = $_;
                    (ref $env->{installed}->{$n}) &&
                    grep { $_ ne '-' } keys %{$env->{installed}->{$n}}
                } keys %{$env->{repository}};
    }

    return \@todo;
}

#
# generate build lists for targets matched by pattern
#
# all input and output is passed in 'env' hash
#
sub build_list ($$) {
    my($pattern, $env) = @_;
    my(@goals,@targets,@keeps,@conflicts,@bonly,$t);
    my($name,$select,$r,$i);
    my($todo,%keep);

    $todo = search_pattern($pattern, $env);

    #
    # chose sources for goals from repository
    #
    foreach $name (@$todo) {
        $select = undef;
        $select = $1 if $name =~ s/,([^\s,]+)$//;
        $t = undef;

        #
        # keeping installed packages for goals is ugly
        # -> we currently do not support installed source RPMs
        # -> source RPMs might already have expired from repository
        #
        # consequence:
        # -> goals are always upgraded to repository versions
        #
        #unless ($env->{upgrade}) {
        #    $i = $env->{installed}->{$name};
        #    $t = chose_source($env, $name, $select, $i, sub { 1; });
        #}

        unless ($t) {
            $r = $env->{repository}->{$name};
            $t = chose_source($env, $name, $select, $r, sub { 1; });
        }

        if ($t) {
            warn_about_options($t, $env->{with}, $env->{config});
            $t->{GOAL} = 1;
            push(@goals, $t);
        } else {
            if ($env->{status}) {
                print "# dropping goal '$name'\n";
            } else {
                die "FATAL: cannot find source for '$name'\n";
            }
        }
    }
    return unless @goals;

    @targets = ();
    @keeps   = @goals;
    foreach $t (@goals) {
        print "# recursing over dependencies for ".vsn($t)."\n";
        make_dep(undef,$t,0,$env,\@targets,\@keeps,\@conflicts);
    }

    %keep = map { $_ => 1 } @keeps;
    @bonly = reverse grep {
        !$keep{$_} && !$env->{installed}->{$_->{name}}
    } @targets;

    return (\@targets, \@bonly, \@conflicts);
}

sub build_deps ($$) {
    my($pattern, $env) = @_;
    my($todo,@list,$list,@out);

    $todo = search_pattern($pattern, $env);

    #
    # unfold target names into real targets
    #
    @list = map {
            map {
                map {
                    $_->{name}
                } @$_
            } values %{$env->{repository}->{$_}}
        } @$todo;

    #
    # also add target name
    #
    push @list, @$todo;

    #
    # strip duplicates
    #
    @list = keys %{ { map { $_ => 1 } @list } };

    #
    # cache reverse dependencies
    #
    unless ($env->{revdep}) {
        $env->{revdep} = get_revdep($env, $env->{repository});
    }

    #
    # map targets into list of dependency names
    #
    @list = map { $env->{revdep}->{$_}
                ? ( @{$env->{revdep}->{$_}} )
                : ( )
            } @list;

    #
    # recurse over dependencies
    #
    foreach (@list) {

        # avoiding cycles
        next if $env->{builddeps}->{$_->{name}};
        $env->{builddeps}->{$_->{name}} = 1;

        push @out, $_;
        $list = build_deps($_->{name}, $env);
        push @out, @$list;
    }

    return \@out;
}

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

#
# OUTPUT
#

#
# compute path to binary RPM from rpm config and target data
#
sub target2rpm ($$) {
    my($target,$c) = @_;
    my($tmpl) = $c->{template};
    my($popt) = $target->{PROXY} ? '+PROXY' : '';

    $tmpl =~ s/%{NAME}/$target->{name}/;
    $tmpl =~ s/%{VERSION}/$target->{version}/;
    $tmpl =~ s/%{RELEASE}/$target->{release}$popt/;

    return $c->{rpmdir}.'/'.$tmpl;
}

#
# compute new target based on old target augmented with options from
# a binary RPM file
#
sub binary_target ($$) {
    my($t, $fn) = @_;
    my(%target) = %$t;

    # pull in options from binary RPM file
    delete $target{'OPTIONS'};
    get_with(\%target, $fn);

    return \%target;
}

#
# return path to master package for a proxy package
#
sub find_proxy ($$) {
    my($t,$bpkg) = @_;
    my(@l) = run("$RPM -ql $t->{name}");
    my($link) = (grep { $_ =~ /\/\.prefix-$t->{name}$/ } @l)[0];
    return unless defined $link;
    chomp $link;
    my($prefix) = readlink($link);
    return unless defined $prefix;
    $bpkg =~ s/.*\///;
    $bpkg =~ s/\+PROXY(\.[^-]+-[^-]+)-[^-]+\.rpm$/$1-*.rpm/;
    return (glob("$prefix/RPM/PKG/$bpkg"))[0];
}

#
# merge parameters from installed package
# with new parameter set and global parameters
# from configuration
#
# then map the result to --define command line arguments
# suitable for rpm
#
sub make_defines ($$$$) {
    my($old, $new, $def, $c) = @_;
    my($with);

    $old = {} unless $old;
    $def = {} unless $def;

    #
    # override old parameters with new parameters
    # drop new parameters that do not exist in old set
    #
    $old = { %$old };
    override_options($old, $new, $c->{optreg});

    #
    # convert parameters to --define command line options
    # skip parameter templates from index
    # skip parameters that are identical to defaults
    #
    $with = join(' ',map { "--define '$_ $old->{$_}'" }
                     sort grep {
                         $old->{$_} =~ /\S/ &&
                         $old->{$_} !~ /^%/ &&
                         $old->{$_} ne $def->{$_}
                     } keys %$old);

    $with = ' '.$with if $with ne '';

    return $with;
}

#
# print commands from package build list
#
# c      -> configuration to derive paths from
# uncond -> always do the --rebuild
# with   -> parameter set passed to build tool
# ignore -> generate script that does not stop on error
# usebin -> build-time check to skip rebuild when binary exists
# allbin -> usebin also for goals
#
sub print_list1 ($$$$$$$) {
    my($list,$c,$uncond,$with,$ignore,$usebin,$allbin) = @_;
    my($spkg,$bpkg,$ppkg);
    my($mywith, $opt);
    my($cmd1, $cmd2, $mark);

    $mark = '::::';

    foreach (@$list) {
        $spkg = $_->{href};
        $bpkg = target2rpm($_, $c);

	$mywith = 

        #
        # rebuild binary package IF
        #
        # 'unconditional' option
        # OR target is tagged as rebuilding
        # OR there is no binary package
        # OR dependency check found that installed package is not suitable
        # OR existing binary package doesn't satisfy wanted options
        #
        $cmd1 = undef;
        if ($uncond || $_->{REBUILD} || !-f $bpkg ||
            !target_suitable(binary_target($_, $bpkg), $with)) {

            $opt = make_defines($_->{OPTIONS}, $with,
                                $_->{DEFOPTS}, $c);

            #
            # proxy packages are rebuilt from their maste
            # hierachy
            #
            # someone preferred a binary from the repository
            # just copy it to the local store
            #
            if ($_->{PROXY}) {
                $ppkg = find_proxy($_,$bpkg) or
                die "FATAL: proxy package ",vsn($_)," does not exist\n";
                #
                # rpm doesn't support additional parameters to the
                # mkproxy script
                # $cmd1 = npriv("$RPM$opt --makeproxy $ppkg -- -o $bpkg");
                #
                $cmd1 = "( cd $c->{rpmdir} && ".
                        npriv("$RPM$opt --makeproxy $ppkg").
                        " )";
            } elsif (defined $_->{prefix}) {
                $cmd1 = npriv("$CURL -q -s -o $bpkg $spkg");
            } else {
                $cmd1 = npriv("$RPM$opt --rebuild $spkg");
            }
        }
        #
        # wrap build command with build-time check for existing
        # binary target
        #
        if (defined $cmd1 &&
            ( $allbin || ($usebin && !$_->{GOAL}) )
            ) {
            $cmd1 = "if test ! -f $bpkg ; then $cmd1 ; fi";
        }

        #
        # if package exist force rpm to copy over new files
        # better than erasing everything and losing configuration
        # files
        #
        $opt = $_->{REBUILD} ? ' --force' : '';
        $cmd2 = priv("$RPM$opt -Uvh $bpkg");

        if ($ignore) {
            $cmd2 = "$cmd1 && \\\n$cmd2" if defined $cmd1;
        } else {
            if (defined $cmd1) {
                $cmd2 = "$cmd1 || exit \$?\n$cmd2 || exit \$?"
            } else {
                $cmd2 = "$cmd2 || exit \$?";
            }
        }
        print "echo $mark $spkg $mark\n$cmd2\necho $mark $spkg = \$? $mark\n";
    }
}

#
# print commands for the temporary package list
#
# temporary packages are only used for building other packages
# and are removed when everything is done
#
sub print_list2 ($$) {
    my($list,$c) = @_;
    my($pkg);

    foreach (@$list) {
        $pkg = "$_->{name}-$_->{version}-$_->{release}";
        print priv("$RPM -e $pkg\n");
    }
}

#
# instead of printing a command list, print a status map
# that shows all packages and how the build process would
# change their status
#
sub print_status ($$$$$) {
    my($installed,$repository,$list,$bonly,$clist) = @_;
    my(%bonly) = map { $_ => 1 } @$bonly;
    my(%map,$n,@names,$t);
    my($old,$tag,$new);

    foreach (@$list, @$clist) {
        next unless defined $_->{release};
        $map{$_->{name}} = {
            rel    => "$_->{version}-$_->{release}",
            status => $_->{STATUS}
        };
    }
    
    foreach (@$bonly) {
        $map{$_->{name}} = {
            rel    => "$_->{version}-$_->{release}",
            status => 'TEMP'
        };
    }

    @names = keys %map;
    foreach $n (keys %$installed) {
        next if $n =~ /::/;
        next if exists $map{$n};
        next unless grep { $_ ne '-' } keys %{$installed->{$n}};
        $map{$n}->{'status'} = 'OK';
        push @names,$n;
    }

    foreach $n (keys %$repository) {
        next if $n =~ /::/;
        next if exists $map{$n};
        next unless grep { $_ ne '-' } keys %{$repository->{$n}};
        $t = find_target($n, $repository);
        $map{$n}->{'status'} = 'NEW';
        $map{$n}->{'rel'}    = vs($t);
        push @names,$n;
    }

    foreach $n (sort @names) {
        $old = join ',',
            map { "$n-$_" }
            sort
            grep { $_ ne '-' }
            keys %{$installed->{$n}};
        $old = $n if $old eq '';

        $tag = $map{$n}->{status};
        $new = defined $map{$n}->{rel} ? " $n-$map{$n}->{rel}" : '';

        printf "%-35s %-8s%s\n", $old, $tag, $new;
    }
}

#
# print dependency map
#
sub print_map ($$$$$) {
    my($installed,$repository,$list,$bonly,$clist) = @_;
    my(%dep);

    foreach (@$bonly) {
        $_->{status} = 'TEMP';
    }

    foreach (reverse @$list) {
        printf "%-35s %-8s %s\n",
            $_->{WHO} ? vsn($_->{WHO}) : "GOAL",
            $_->{WHY} ? $_->{WHY} : '???',
            vsn($_);
    }
}

#
# print dependency list
#
sub print_deps ($) {
    my($list) = @_;

    print join("\n", sort map { vsn($_) } @$list),"\n";
}

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

my($config,$url,$repository,$installed,$env,$list,$bonly,$clist);
my($pattern,%with,%exclude);

if ($opt_a) {
    $pattern = undef;
} else {
    $pattern = join(' ', @ARGV);
}

if ($opt_A) {
    $pattern = '*';
}

%with    = map {
    /([^\s=]+)(?:\=(\S+))?/
    ? ($1 => (defined $2 ? $2 : 'yes'))
    : ()
    } split(/\s+/, $opt_D);
%exclude = map { $_ => 1 } split(/\s+/, $opt_E);

$config         = get_config();

if (defined $opt_p) {
    $config->{platform} = $opt_p;
}

if (defined $opt_r) {
    $url = $opt_r;
    $url .= '/' unless $url =~ /\/$/;
} else {
    $url = get_release();
}

# if we read the index from a file we can no longer deduce
# repository paths from index paths. For now lets assume
# that everything is below SRC/ to be compatible with
# existing file indexes.
if (defined $opt_f && !defined $opt_r) {
    $url .= 'SRC/';
}

$installed      = $opt_Z ? {} : get_installed();
$repository     = get_index(
                    $url.'00INDEX.rdf',
                    $opt_f,
                    $opt_X,
                    $config->{platform},
                    $installed);

$env = {
    config     => $config,
    installed  => $installed,
    repository => $repository,
    built      => {},
    revdep     => undef,
    with       => \%with,
    exclude    => \%exclude,
    upgrade    => ($opt_a || $opt_U),
    zero       => ($opt_z || $opt_Z),
    exact      => $opt_e,
    quick      => $opt_q,
    status     => ($opt_s || $opt_S),
    fatal      => [],
    goals      => $opt_g,
    sourceonly => ($opt_u ||
                   $opt_U ||
                   $opt_z ||
                   $opt_Z)
};

if ($opt_L) {
    ($list) = build_deps($pattern, $env);
    print_deps($list);
} else {
    ($list,$bonly,$clist) = build_list($pattern, $env);
    die "FATAL: cannot find package\n" unless defined $list;

    if ($opt_M) {
        print_map($installed,$repository,$list,$bonly,$clist);
    } elsif ($opt_S) {
        print_status($installed,$repository,$list,$bonly,$clist);
    } elsif ($opt_s) {
        print_status($installed,{},$list,$bonly,$clist);
    } else {
        if (@{$env->{fatal}}) {
            die "FATAL: errors occured while building:\n",
                join (',', @{$env->{fatal}}),
                "\n";
        }

        print_list1($list,
                    $config,
                    $opt_a || $opt_u || $opt_U,
                    $env->{with},
                    $opt_i,
                    $opt_b,
                    $opt_B);
        print_list2($bonly,$config) unless $opt_K;
    }
}