OpenPKG Specs: openpkg/build.pl@a2c6460cfb16 (annotated)

openpkg/build.pl@a2c6460cfb16 (annotated)

openpkg/build.pl

Mon, 28 Jan 2013 17:37:18 +0100

author: Michael Schloh von Bennewitz <michael@schloh.com>
date: Mon, 28 Jan 2013 17:37:18 +0100
changeset 758: a2c6460cfb16
permissions: -rw-r--r--

Correct socket error reporting improvement with IPv6 portable code,
after helpful recommendation by Saúl Ibarra Corretgé on OSips devlist.

 ##
 ##  build.pl -- OpenPKG Package Building and Installing
 ##  Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
 ##
 ##  This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
 ##  All rights reserved. Licenses which grant limited permission to use,
 ##  copy, modify and distribute this software are available from the
 ##  OpenPKG GmbH.
 ##
 ##  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.
 ##
 #############################################################################
 ##
 ##  MAIN PROCEDURE
 ##
 #############################################################################
 require 5;
 #use strict;
 my (
    $opt_h,
    $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_H, $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,
    $opt_k
 );
 #   global context variables
 my $prg = "openpkg build";
 my %env = ('' => {});
 ##
 ##  OPTION PARSING
 ##
 #   parse command line options
 my $getopts = 'hR:r:f:uUaAzZP:N:E:H:iD:p:qsSXMLWKebBgk';
 getopts($getopts);
 #   parse configuration script options
 if (open(FH, "<$ENV{'HOME'}/.openpkg/build")) {
     my ($env) = $env{''};
     my ($go) = $getopts;
     $go =~ s/[^a-zA-Z]//g;
     while (my $line = <FH>) {
         if ($line =~ m/^\s*\[([^\]]*)\]/) {
             $env{$1} = {} unless ($env{$1});
             $env = $env{$1};
         } elsif (my ($opt, $val) = ($line =~ m/^\-([$go])\s*(.*?)\s*$/)) {
             $val = 1 unless (defined($val));
             if (exists($env->{$opt})) {
                 $env->{$opt} .= " " . $val;
             } else {
                 $env->{$opt} = $val;
             }
         }
     }
     close(FH);
 }
 #   usage sanity check and usage help
 sub usage {
     my ($rc) = @_;
     my $usage =
         "openpkg:build:USAGE: $prg [options] [pattern ...]\n" .
         " -a                operate on all installed packages\n" .
         " -A                operate on all repository packages\n" .
         " -R <rpm>          path to \"openpkg rpm\" command\n" .
         " -r <repository>   URL to package repository directory\n" .
         " -f <index.rdf>    URL to package repository index file\n" .
         " -u                ignore local binary RPMs\n" .
         " -U                upgrade all selected packages including dependencies\n" .
         " -z                rebuild from zero all selected installed packages\n" .
         " -Z                rebuild from zero all selected available packages\n" .
         " -i                ignore errors in the generated script\n" .
         " -q                ignore all reverse dependencies\n" .
         " -s                generate status map instead of shell script\n" .
         " -S                generate status map instead of shell script (including new)\n" .
         " -X                use external XML/RDF parser instead of internal one\n" .
         " -M                generate short dependency map instead of shell script\n" .
         " -L                generate list of packages in repository depending on target\n" .
         " -W                include dependencies as if all build options are enabled\n" .
         " -K                keep temporarily installed packages\n" .
         " -k                keep temporarily downloaded packages\n" .
         " -e                rebuild exact version of a package from repository\n" .
         " -b                build-time check existing binaries for dependencies only\n" .
         " -B                build-time check existing binaries for dependencies and target\n" .
         " -g                rebuild packages even when most recent version is installed\n" .
         " -P <priv-cmd>     command prefix for privileged commands\n" .
         " -N <non-priv-cmd> command prefix for non-privileged commands\n" .
         " -p <platform>     match platform against repository index for binary packages\n" .
         " -E <name>         exclude package\n" .
         " -H <name>         hint about packages to resolve ambiquity\n" .
         " -D <name>[=<val>] set build option for packages\n";
     if ($rc == 0) {
         print STDOUT $usage;
     }
     else {
         print STDERR $usage;
     }
     exit($rc);
 }
 if ($opt_h) {
     usage(0);
 }
 if (not (   ($#ARGV >= 0  && !($opt_a || $opt_A))
          || ($#ARGV == -1 &&  ($opt_a || $opt_A)))) {
     usage(1);
 };
 #   determine RPM run-time information
 my $config = rpm_runtime_info();
 #   override command line options with configuration script options
 #   now that the effectively used OpenPKG RPM command is known
 foreach my $env (sort { $a cmp $b } grep {
        $config->{"rpm"}    =~ m/^\Q$_\E/ # compatibility
     or $config->{"prefix"} =~ m/^\Q$_\E/ # regular
 } keys %env) {
     while (my ($opt, $val) = each(%{$env{$env}})) {
         eval "\$opt_$opt = '$val' unless defined \$opt_$opt;";
     }
 }
 ##
 ##  OPTION POST-PROCESSING
 ##
 my ($url, $repository, $installed, $env, $list, $bonly, $clist);
 my ($pattern, %with, %exclude, %hint);
 #   determine package goal pattern
 if ($opt_a) {
     $pattern = undef;
 } else {
     $pattern = join(' ', @ARGV);
 }
 if ($opt_A) {
     $pattern = '*';
 }
 #   parse build options
 %with = map {
       m/([^\s=]+)(?:\=(\S+))?/
     ? ($1 => (defined($2) ? $2 : 'yes'))
     : ()
 } split(/\s+/, $opt_D);
 #   split accumulated option values
 %exclude = map { $_ => 1 } split(/\s+/, $opt_E);
 %hint    = map { $_ => 1 } split(/\s+/, $opt_H);
 if (defined($opt_p)) {
     $config->{platform} = $opt_p;
 }
 #   determine RPM package repository information
 if (defined $opt_r) {
     $url = $opt_r;
     $url .= '/' unless $url =~ m/\/$/;
 } else {
     $url = rpm_release_url();
 }
 #   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) and not defined($opt_r)) {
     $url .= 'SRC/';
 }
 #   determine information about INSTALLED packages (virtual and regular),
 #   including their options, provides and requirements
 my $installed = get_installed();
 #   SPECIAL CASE post-processing for
 #   -Z (ignore installed packages)
 #   -a (operate for all installed packages)
 if ($opt_a and $opt_Z) {
     #   This allows one to correctly upgrade an existing OpenPKG
     #   instance to a newer major version by querying all installed
     #   packages and their options (-a) but then ignore them (-Z) during
     #   the later processing and instead perform more or less a fresh
     #   rebuild from scratch. This ensures that during the process the
     #   installed packages are effectively picked up as dependencies
     #   only after they in turn were already updated.
     foreach my $package (keys(%{$installed})) {
         next if ($package =~ m/::/);
         if (exists($installed->{$package}->{""})) {
             #   virtual package
             $hint{$installed->{$package}->{""}->[0]->{"name"}} = 1
                 if (exists($installed->{$package}->{""}->[0]->{"name"}));
         }
         else {
             #   regular package
             $pattern .= " $package";
             foreach my $version (keys(%{$installed->{$package}})) {
                 foreach my $rec (@{$installed->{$package}->{$version}}) {
                     if (defined($rec->{"OPTIONS"})) {
                         my $options = $rec->{"OPTIONS"};
                         foreach my $option (keys(%{$options})) {
                             $with{$package."::".$option} = $options->{$option};
                         }
                     }
                 }
             }
         }
     }
 }
 if ($opt_Z) {
     $installed = {};
 }
 #   determine information about AVAILABLE packages
 #   by fetching and parsing a package repository XML/RDF index
 $repository = get_index(
     $url . '00INDEX.rdf',
     $opt_f,
     $opt_X,
     $config->{platform},
     $installed
 );
 #   assemble together all determined environment information
 $env = {
     config     => $config,
     installed  => $installed,
     repository => $repository,
     built      => {},
     revdep     => undef,
     with       => \%with,
     exclude    => \%exclude,
     hint       => \%hint,
     upgrade    => ($opt_a || $opt_U),
     zero       => ($opt_z || $opt_Z),
     exact      => $opt_e,
     quick      => ($opt_q || $opt_z || $opt_Z),
     status     => ($opt_s || $opt_S),
     fatal      => [],
     goals      => $opt_g,
     sourceonly => ($opt_u || $opt_U || $opt_z || $opt_Z)
 };
 ##
 ##  PERFORM REQUESTED OPERATION
 ##
 if ($opt_L) {
     #   case 1: calculate dependencies only and
     #           print packages depending on target
     ($list) = build_deps($pattern, $env);
     print_deps($list);
 } else {
     #   case 2: calculate build commands and
     #           print results in different formats
     ($list, $bonly, $clist) = build_list($pattern, $env);
     die "openpkg:build:FATAL: cannot find package\n" if (not 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 "openpkg:build:FATAL: errors occured while building:\n", @{$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) if (not $opt_K);
     }
 }
 #   die gracefully
 exit(0);
 #############################################################################
 ##
 ##  FUNCTIONS: PARSING & RUN-TIME INFORMATION
 ##
 #############################################################################
 #   home-brewn getopt(3) style option parser
 sub getopts ($) {
     my ($opts) = @_;
     my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\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 "openpkg:build:WARNING: unknown option $_\n";
                 }
                 $_ = "-$2";
             }
         }
     }
     if (defined $optarg) {
         warn "openpkg:build:WARNING: option $optarg requires an argument\n";
     }
     foreach (keys %opts) {
         eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
     }
     @ARGV = @argv;
 }
 #   determine RPM run-time information
 sub rpm_runtime_info () {
     #   determine OpenPKG instance prefix via
     #   1. the environment of the "openpkg build" framework
     #   2. the installation path of the script
     #   3. the installation path of the Perl interpreter
     #   4. the path of the "openpkg" command in $PATH
     my $l_prefix = $ENV{'OPENPKG_PREFIX'};
     if (not $l_prefix) {
         ($l_prefix) = ($0 =~ m/^(.+)\/lib(exec)?\/openpkg(-tools)?\/build(\.pl)?$/);
     }
     if (not $l_prefix) {
         ($l_prefix) = ($^X =~ m/^(.+)\/bin\/perl.*$/);
     }
     if (not $l_prefix) {
         $l_prefix = (`(which openpkg) 2>/dev/null` =~ m/^(.+)\/bin\/openpkg$/);
     }
     if (not -x "$l_prefix/bin/openpkg") {
         die "openpkg:build:FATAL: cannot determine OpenPKG instance prefix";
     }
     print "# operating with OpenPKG instance $l_prefix\n";
     #   determine OpenPKG RPM command
     my $rpm = $opt_R || $env{''}->{'R'} ||
         ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm") ?
         "$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
     $rpm = (`(which $rpm) 2>/dev/null` =~ m{^(/.*)})[0] if ($rpm !~ m|^/|);
     die "openpkg:build:FATAL: cannot locate OpenPKG RPM in path" unless ($rpm =~ m{^/});
     print "# operating with OpenPKG RPM $rpm\n";
     #   determine additional tools
     my $mkp = "$l_prefix/bin/openpkg makeproxy";
     my $rel = "$l_prefix/bin/openpkg release";
     my $bzip2 = $rpm;
     $bzip2 =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/bzip2/;
     my $curl = $rpm;
     $curl =~ s/\/bin\/openpkg rpm$/\/lib\/openpkg\/curl/;
     $curl = "$l_prefix/bin/openpkg curl" if (system("$l_prefix/bin/openpkg curl file://$l_prefix/etc/openpkg/platform >/dev/null 2>&1") == 0);
     #   expand RPM macros holding information
     my $c = run("$rpm --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu} %{_srcrpmdir}'");
     #   parse and post-process information
     chomp($c);
     my (@q) = split(/\s+/, $c);
     $q[1] =~ s/%{OS}/$q[2]/;
     $q[1] =~ s/%{ARCH}/$q[3]/;
     #   expand RPM rc information about tools
     $c = run("$rpm --showrc");
     my @g = ($c =~ m/\%\{l_tool_locate\s+([^\s\}]+)/g);
     #   return accumulated information
     return {
         rpm      => $rpm,
         mkp      => $mkp,
         rel      => $rel,
         bzip2    => $bzip2,
         curl     => $curl,
         rpmdir   => $q[0],
         srcrpmdir=> $q[4],
         template => $q[1],
         platform => '',
         prefix   => $l_prefix,
         optreg   => '(?:'. join('|', map { "\Quse_$_\E" } @g) .')'
     };
 }
 #   determine RPM release URL
 sub rpm_release_url ($$) {
     my ($rel, $url);
     #   determine the release URL the newer way
     $url = run("(".$config->{"rel"}." --fmt='%u') 2>/dev/null || true") || "";
     $url =~ s/^\s+//s;
     $url =~ s/\s+$//s;
     #   use a local jumpstart RDF
     if (-f $config->{"prefix"}."/etc/openpkg/build.rdf") {
         $url = "file://".$config->{"prefix"}."/etc/openpkg/build.rdf"
     }
     return $url;
 }
 #############################################################################
 ##
 ##  FUNCTIONS: VERSION STRING HANDLING
 ##
 #############################################################################
 #   compare two package versions
 #   - "openpkg rpm":
 #     splits according to !isalnum(3) ([a-zA-Z0-9])
 #     and between isdigit(3) ([0-9]) and isalpha(3) ([a-zA-Z])
 #   - "openpkg build" (this):
 #     splits on "." characters
 sub vcmp_version ($$) {
     my ($a, $b) = @_;
     my (@a, @b, $c);
     my ($ax, $bx);
     #   split according to dots
     @a = split(/\./, $a);
     @b = split(/\./, $b);
     #   compare as long as components exist
     while (@a && @b) {
         if ($a[0] =~ m/^\d+$/ && $b[0] =~ m/^\d+$/) {
             #   numerical comparison
             $c = $a[0] <=> $b[0];
         } elsif ((($a, $ax) = $a[0] =~ m/^(\d+)(.*)$/) &&
                  (($b, $bx) = $b[0] =~ m/^(\d+)(.*)$/)) {
             #   numerical comparison for prefix,
             #   string comparison for remainder
             $c = $a <=> $b;
             $c = $ax cmp $bx unless ($c);
         } else {
             #   string comparison
             $c = $a[0] cmp $b[0];
         }
         #   stop comparison if components already mismatched
         return $c if ($c != 0);
         #   else reduce by one component level
         shift(@a);
         shift(@b);
     }
     #   finally compare number of remaining components
     #   (in case one is more specific)
     $c = (scalar(@a) <=> scalar(@b));
     return $c;
 }
 #   compare two package releases
 #   - "openpkg rpm":
 #     uses "vcmp_version" semantics 1:1 again
 #   - "openpkg build" (this):
 #     uses "vcmp_version" semantics 1:1 again (>= 20060719)
 #     trivial string comparison               (<= 20060719)
 sub vcmp_release ($$) {
     my ($a, $b) = @_;
     return vcmp_version($a, $b);
 }
 #   compare two package "version" or "version-release" strings
 #   - "openpkg rpm":
 #     compares "epoch", "version", "release" (in this order)
 #   - "openpkg build" (this):
 #     compares "release", "version", (in this order)
 sub vcmp ($$) {
     my ($a, $b) = @_;
     my ($c);
     #   short-circuit comparison for simple case
     return 0 if ($a eq $b);
     #   split into "version" and "release"
     my ($av, $ar) = ($a =~ m/^(.*?)(?:\-([\d\.]+))?$/);
     my ($bv, $br) = ($b =~ m/^(.*?)(?:\-([\d\.]+))?$/);
     #   compare "release"
     if (defined($ar) and defined($br)) {
         $c = vcmp_release($ar, $br);
         return $c if ($c); # short-circuit
     }
     #   compare "version"
     if (defined($av) && defined($bv)) {
         $c = vcmp_version($av, $bv);
         return $c if ($c); # short-circuit
     }
     #   equality
     return 0;
 }
 #   create "version" or "version-release" string
 #   from a provide object (see parse_provides)
 sub vs ($) {
     my ($t) = @_;
     return (
           defined($t->{release})
         ? "$t->{version}-$t->{release}"
         : $t->{version}
     );
 }
 #   create "name-version" or "name-version-release" string
 #   from a provide object (see parse_provides)
 sub vsn ($) {
     my ($t) = @_;
     return "$t->{name}-".vs($t);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: INSTALLATION INFORMATION
 ##
 #############################################################################
 #   parse OpenPKG RPM 'provide' string
 #   "<virtual-name>"               (virtual package)
 #   "<name> = <version>-<release>" (regular package)
 #   "<name>::<option> = <value>"   (regular package build option)
 sub parse_provides ($) {
     my ($s) = @_;
     my ($nam, $val, $pre, $with, $pxy, $ver, $rel);
     ($nam, $val) = ($s =~ m/^([^\s\(]+(?:\([^\)]*\))?)\s*(?:=\s*(\S*?))?$/);
     if (($pre, $with) = ($nam =~ m/^(\S+?)::(\S*)$/)) {
         #   build option
         $val =~ s/(?:\%([0-9a-fA-F][0-9a-fA-F]))/chr(hex($1))/eg; # hex decode
         ($ver, $rel, $pxy) = ($val, undef, undef);
     } else {
         #   virtual or real package
         ($ver, $rel, $pxy) = ($val =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
     }
     #   return accumulated information
     return {
         name    => $nam,     # the full name of the resource
         version => $ver,     # the version        (or value)
         release => $rel,     # and release number (or undef)
         proxy   => $pxy,     # whether the resource is a PROXY resource (or undef)
         prefix  => $pre,     # the packagename (if resource is an option)
         with    => $with     # the buildoption (if resource is an option)
     };
 }
 #   parse option from RPM 'provides' list
 sub parse_provideslist ($) {
     my ($l) = @_;
     my ($p);
     my ($nam, $val, %opts);
     foreach (@$l) {
         $p = parse_provides($_);
         next if (not (defined $p->{with} && defined $p->{prefix}));
         $opts{$p->{with}} = $p->{version};
     }
     return \%opts;
 }
 #   translate dependency object into provides object
 sub depends2provides ($) {
     my ($dep) = @_;
     my ($ver, $rel, $pxy, $pre, $with);
     ($ver, $rel, $pxy) = ($dep->{val} =~ m/^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/);
     ($pre, $with) = ($dep->{name} =~ m/^(\S+?)::(\S*)$/);
     return {
         name    => $dep->{name},
         version => (defined $ver ? $ver : $dep->{val}),
         release => $rel,
         proxy   => $pxy,
         prefix  => $pre,
         with    => $with
     }
 }
 #   parse OpenPKG RPM 'require' string
 #   "<virtual-name>"                              (virtual package)
 #   "<name> =|<|<=|>|>= <version>[-<release>]"    (regular package)
 #   "<name>::<option> =|<|<=|>|>= <value>"        (regular package build 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 =~ m/\S/) {
         #   dependency from old index stored as text string
         #   "name operator operand" or "name"
         ($name, $op, $val) = ($dep =~ m/(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/);
         if (defined($op)) {
             $op = {
                 '=='  => 'equ', '='   => 'equ',
                 '>='  => 'geq', '=>'  => 'geq',
                 '<='  => 'leq', '=<'  => 'leq',
                 '>'   => 'gt',  '<'   => 'lt'
             }->{$op};
             if (not defined($op)) {
                 print "# don't know how to handle dependency: $dep (invalid operator)\n";
                 return;
             }
         }
     }
     return {
         name => $name,
         op   => $op,
         val  => $val
     };
 }
 #   retrieve the local installed package 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, $p);
     my ($nam, $val, %options);
     my ($vs, $rec, @list);
     my ($name, $version, $release);
     my ($req);
     #   generated total result:
     #   $map = {
     #       #   regular package
     #       "<package-name>" <foo> => {
     #            "<version>-<release>" <1.2.3-20060622> => [
     #                <<1>{
     #                    "name"    => $name,
     #                    "version" => $version,
     #                    "release" => $release,
     #                    "PROXY"   => $proxy,
     #                    "depends" => [
     #                          <<3>>{
     #                              "cond"  => '',
     #                              "value" => {
     #                                  name => $name,
     #                                  op   => $op,
     #                                  val  => $val
     #                              },
     #                          },
     #                          ...
     #                    ],
     #                    "keeps" => [
     #                          \<<3>
     #                          ...
     #                    ],
     #                    "OPTIONS" => {
     #                        "<option>" => "<value>",
     #                        "<option>" => "<value>",
     #                        ...
     #                    },
     #                },
     #                ...
     #            ],
     #       },
     #       #   build option
     #       "<package-name>::<option>" <foo::with_baz> => {
     #            "<value>" <yes> => [
     #                \<<1>>
     #                ...
     #            ],
     #       },
     #       #   virtual package
     #       "<package-name>" <BAR> => {
     #            "" => [
     #                \<<1>>,
     #                ...
     #            ],
     #       },
     #       ...
     #   };
     #   query and parse all provides of all packages
     #   HINT: We assume(!) that OpenPKG RPM outputs "provides" in order:
     #         1. virtual package & build option
     #         2. regular package
     #   FIXME: The better long-term solution for all this fiddling would be something like:
     #          "openpkg rpm -qa -qf '%{NAME} %{VERSION} %{RELEASE}[ .%{PROVIDENAME} .%{PROVIDEFLAGS:depflags} .%{PROVIDEVERSION}]\\n'"
     @l = run($config->{"rpm"}. " --provides -qa");
     @list = ();
     foreach (@l) {
         #   parse into provide object
         $p = parse_provides($_) or next;
         #   short-circuit processing for RPM special case
         next if ($p->{name} =~ m/^gpg\(/);
         #   is this an option?
         if (defined($p->{with})) {
             $options{$p->{prefix}}->{$p->{with}} = $p->{version};
             push(@list, $p);
             next;
         }
         #   is this a virtual target?
         $vs = vs($p);
         if ($vs eq '') {
             push(@list, $p);
             next;
         }
         #   assemble package details
         $name    = $p->{name};
         $version = defined($p->{version}) ? $p->{version} : '*';
         $release = defined($p->{release}) ? $p->{release} : '*';
         push(@list, {
             name    => $name,
             version => $version,
             release => $release
         });
         #   create target record
         $rec = {
             name       => $name,
             version    => $version,
             release    => $release,
             PROXY      => $p->{proxy},
             depends    => [],
             keeps      => []
         };
         foreach (@list) {
             push(@{$map{$_->{name}}->{vs($_)}}, $rec);
         }
         #   remove assembled details
         @list = ();
     }
     if (@list) {
         print "# ATTENTION: ", scalar(@list), " froods (unassignable RPM 'provides') left\n";
     }
     #   options are provided for a package,
     #   apply them to all instances of the package
     #   FIXME: duplicate copying because record exists multiple times (but harmless)
     #   FIXME: merges all "provides" of all package instances together -- which might be wrong
     foreach $nam (keys(%options)) {
         foreach $val (keys(%{$map{$nam}})) {
             foreach (@{$map{$nam}->{$val}}) {
                 $_->{OPTIONS} = $options{$nam};
             }
         }
     }
     #   query all 'requires' of all installed packages
     #   to determine the package dependencies
     @l = run($config->{"rpm"} . " --qf '%{NAME}:::%{VERSION}:::%{RELEASE}[ :::%{REQUIRENAME}:::%{REQUIREFLAGS:depflags}:::%{REQUIREVERSION}:::]\\n' -qa");
     @list = ();
     foreach (@l) {
         ($name, $version, $release, $req) = m/^([^:]+):::([^:]+):::([^:]+)(.*?)$/;
         next if ($name eq 'gpg-pubkey');
         $release =~ s/\+PROXY$//;
         #   for each requirement triple...
         while ($req =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
             $p = parse_depends("$1 $2 $3");
             next if ($p->{name} =~ m/^(rpmlib|gpg)\(/);
             $vs = vs({ version => $version, release => $release });
             $p = { cond => '', value => $p };
             foreach $rec (@{$map{$name}->{$vs}}) {
                 push(@{$rec->{depends}}, $p);
                 push(@{$rec->{keeps}},   $p);
             }
         }
     }
     if (@list) {
         print "# ATTENTION: ",scalar(@list)," fnords (unassignable RPM 'requires') left\n";
     }
     #   return final result
     return \%map;
 }
 #############################################################################
 ##
 ##  FUNCTIONS: REPOSITORY INDEX INFORMATION
 ##
 #############################################################################
 #   fetch XML/RDF index from file or URL
 #   (recursively fetches sub-indexes, too)
 sub get_index ($$$$$) {
     my ($url, $fn, $xml, $pfmatch, $installed) = @_;
     my (%map, $include);
     my ($fetch, $bzip2, $path);
     my ($parser);
     #   determine command/path to fetch/open index
     $bzip2 = $config->{"bzip2"};
     $fetch = defined($fn) ? $fn : $url;
     $fetch !~ m/\.bz2$/ || -x $bzip2
         or die "openpkg:build:FATAL: $bzip2 not found\n";
     if ($fetch =~ m/^\w+:/) {
         #   looks like URL scheme
         print "# fetching XML/RDF index from URL $fetch\n";
         $path = $config->{"curl"} . " -s -o - \"$fetch\" |";
         $path .= "$bzip2 -dc |" if ($fetch =~ m/\.bz2$/);
     } else {
         print "# reading XML/RDF index from file $fetch\n";
         if ($fetch =~ m/\.bz2$/) {
             $path = "$bzip2 -dc $fetch |";
         } else {
             $path = "<$fetch";
         }
     }
     #   open index
     open(RFH, $path) or
         die "openpkg:build:FATAL: cannot open '$fetch' ($!)\n";
     #   if XML parser can be used, try to lazy-load it
     if ($xml) {
         eval { require XML::Simple; };
         $xml = 0 if ($@);
     }
     #   determine and run XML parser
     #   (returns contained index includes)
     $parser = ($xml ? \&xml_parser : \&simple_text_parser);
     $include = $parser->(\*RFH, $url, \%map, $pfmatch, $installed);
     #   close index
     close(RFH)
         or die "openpkg:build:FATAL: an I/O error occured\n";
     #   cannot do real recursions on file handles, so we simply append
     #   (instead of inserting at the correct position) all sub-RDFs, as
     #   the result is flattend into a big hash anyway
     foreach (@$include) {
         my ($submap);
         my ($suburl, $subfn) = relurl($url, $fn, $_);
         $submap = get_index($suburl, $subfn, $xml, $pfmatch, $installed); # RECURSION
         while (my ($name, $vmap) = each(%$submap)) {
             while (my ($vs, $recs) = each(%$vmap)) {
                 push(@{$map{$name}->{$vs}}, @$recs);
             }
         }
     }
     #   return final result
     #   $map = {
     #       <package-name> => {
     #           "<version>-<release>" => {
     #                href      => ...,
     #                name      => ...,
     #                version   => ...,
     #                release   => ...,
     #                platform  => ...,
     #                prefix    => ...,
     #                depends   => [ ... ],
     #                keeps     => [ ... ],
     #                conflicts => [ ... ],
     #                source    => ...,
     #                nosource  => ...,
     #                desc      => $desc,
     #                OPTIONS   => $options,
     #                DEFOPTS   => { %$options },
     #           };
     #       };
     #   };
     return \%map;
 }
 #   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 =~ m/^\w+:\/\//) {
         # NOP
     } elsif ($suburl =~ m/^\//) {
         $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;
         }
     }
 while ($suburl =~ s/\/\.\//\//s);
 while ($suburl =~ s/\/[^\/]+\/\.\.\//\//s);
     return ($suburl, $subfn);
 }
 #   XML/RDF parser (simple way)
 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 internal XML/RDF parser\n";
     #   read XML/RDF line-wise as we know that our
     #   OpenPKG XML/RDF indices follow a strict formatting
     while (<$fh>) {
         #   unescape some XML entities
         s/&gt;/>/g;
         s/&lt;/</g;
         if (!(defined($href)) && m/<rdf:Description.*?href="([^"]*)"/) {
             #   start of new package description
             $href      = $1;
             $section   = undef;
             $name      = undef;
             $release   = undef;
             $desc      = '';
             $platform  = undef;
             $prefix    = undef;
             $bags      = {};
             @provides  = ();
         }
         if (!(defined($href)) && m/<Repository.*?href="([^"]*)"(?:\s*platform="([^"]*)")?/) {
             #   external XML/RDF index reference for particular binary platform
             if (goodpf($2, $pfmatch)) {
                 push(@include, $1);
             }
             next;
         }
         #   skip content unless referenced piece was found
         next if (not defined($href));
         #   parse XML/RDF element into components
         ($tag, $cond, $attrname, $attrval, $body) = m{
             <                      # start delimiter
             (\/?[\w:]+)            # begin element name
             \s*                    # optional space before attributes
             (?:cond="([^"]+)")?    # known attribute
             (?:(\w+)="([^"]+)")?   # unknown attribute
             >                      # end delimiter
             (.*?)                  # optional element body
             (?:<\/\1>)?            # optional end tag
             $                      # end of string
         }mx;
         #   recognize the various XML/RDF elements
         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) if (!defined($usecond));
             } elsif ($section ne '') {
                 push(@{$bags->{"$usecond"}->{$section}}, $body);
             }
         } elsif ($tag eq '/rdf:Description') {
             if (   defined($href)
                 && defined($name)
                 && defined($version)
                 && defined($release)) {
                 #   process the accumulated package information
                 @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; });
                 }
                 #   store accumulated package information
                 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 "openpkg:build:FATAL: when reading entry '$name':\n" . $@;
                 }
                 foreach (@provides) {
                     push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
                 }
             }
             #   prepare to recognize next package
             $href = undef;
         }
     }
     #   return contained XML/RDF indices
     return \@include;
 }
 #   XML/RDF parser (usual way)
 sub xml_parser ($$$$$) {
     my ($fh, $url, $map, $pfmatch, $installed) = @_;
     my (@include);
     my ($xml, $rep, $sub);
     my (@provides, %options, $rec);
     my ($href, $name, $version, $release, $desc);
     my ($options);
     print "# using external XML/RDF parser\n";
     #   parse XML/RDF with XML::Simple parser
     $xml = XML::Simple::XMLin($fh, forcearray => 1);
     $rep = $xml->{'Repository'}->[0]->{'rdf:Description'};
     $sub = $xml->{'Repository'}->[0]->{'Repository'};
     #   iterate over all package descriptions
     foreach (@$rep) {
         #   fetch package information
         $href    = $_->{'href'};
         $name    = xel($_->{'Name'});
         $version = xel($_->{'Version'});
         $release = xel($_->{'Release'});
         next if (not (
                defined($href)
             && defined($name)
             && defined($version)
             && defined($release)
         ));
         #   determine package "provides"
         @provides = ();
         if ($_->{'Provides'}) {
             @provides = map {
                 $_ = $_->{'rdf:bag'}->[0];
                 $_ = $_->{'rdf:li'} ? $_->{'rdf:li'} : $_->{'resource'};
                 @$_;
             } grep {
                 !exists $_->{'cond'}
             } @{$_->{'Provides'}};
         }
         @provides = map {
             depends2provides(parse_depends($_))
         } @provides;
         %options = map {
             ($_->{with} => $_->{version})
         } grep {
             defined $_->{with}
         } @provides;
         push(@provides, {
             name    => $name,
             version => $version,
             release => $release
         });
         #   determine targets
         $desc = xel($_->{'Description'});
         $options =
               %options
             ? { %options }
             : parse_options($desc);
         if ($options) {
             my (@t) = get_targets($installed->{$name}, sub { 1; });
         }
         #   store accumulated package information
         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 "openpkg:build:FATAL: when reading entry '$name'\n".$@;
         }
         foreach (@provides) {
             push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
         }
     }
     #   determine contained XML/RDF indices
     if ($sub) {
         @include = map {
             goodpf($_->{platform}, $pfmatch)
             ? ( $_->{href} )
             : ( )
         } @$sub;
     }
     #   return contained XML/RDF indices
     return \@include;
 }
 #   convert XML parser output to dependency records
 sub depend_list ($) {
     my ($dl) = @_;
     foreach (@$dl) {
         $_->{value} = parse_depends($_->{value});
     }
     return $dl;
 }
 #   convert simple XML 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;
 }
 #   convert (conditional) XML/RDF 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;
 }
 #   return node value from XML parser
 sub xel($) {
     my ($a) = @_;
     my ($l) = $a->[0];
     return '' if ref($l);
     return $l;
 }
 #   is the platform a good one?
 sub goodpf ($$) {
     my ($l, $p) = @_;
     return 1 if $l eq '';
     return ($l =~ m/(?:^|\s)\Q$p\E(?:\s|$)/);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: HELPER FUNCTIONS FOR XML PARSING & DEPENDENCY PROCESSING
 ##
 #############################################################################
 #   parse option from RPM output
 #   < "%option with_foo bar"
 #   > $with{"with_foo"} = "bar"
 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;
 }
 #   fetch targets of a name that satisfy a condition and sort by target
 #   version. Input is a hash of versions(?) on which the condition has
 #   to be true and which points to an array of records with package
 #   version information. Output is the list of version sorted package
 #   version information records.
 sub get_targets ($$) {
     my ($relmap, $cond) = @_;
     return (
         sort {
             vcmp(vs($a), vs($b));
         } map {
             @{$relmap->{$_}}
         } grep {
             $cond->($_);
         } keys %$relmap
    );
 }
 #############################################################################
 ##
 ##  FUNCTIONS: DEPENDENCY PROCESSING
 ##
 #############################################################################
 #   search environment for packages that match a pattern
 sub search_pattern ($$) {
     my ($pattern, $env) = @_;
     my (@todo);
     if (defined($pattern)) {
         #   explicitly given package pattern
         @todo = map {
             my ($p) = $_;
             my ($s, $iswildcard);
             $s = $1 if ($p =~ s/(,[^\s,]+)$//);
             if ($p =~ s/\*+$//) {
                 $p = '^'.quotemeta($p).'';
                 $iswildcard = 1;
             } else {
                 $p = '^'.quotemeta($p).'$';
             }
             map { "$_$s" }
                 grep { m/$p/ && !($iswildcard && exists($env->{exclude}->{$_})) }
                     keys %{$env->{repository}}
         } split(/\s+/, $pattern);
     } else {
         #   undefined pattern means "-a" option that selects
         #   all packages from repository that are installed
         #   and not explicitly excluded on command line
         @todo = grep {
             my ($n) = $_;
                (ref($env->{installed}->{$n}))
             && !exists($env->{exclude}->{$n})
             && grep { $_ ne '-' } keys %{$env->{installed}->{$n}}
         } keys(%{$env->{repository}});
     }
     return \@todo;
 }
 #   pull in OPTIONS for a package or an RPM file
 my $get_with_cache = {};
 sub get_with ($;$) {
     my ($t, $fn) = @_;
     my (@l, %with);
     my ($optmap, $opt);
     if ($t->{OPTIONS}) {
         $opt = $t->{OPTIONS};
     } else {
         if (defined($fn)) {
             @l = run($config->{"rpm"} . " -q --provides -p $fn");
         } else {
             if (not exists($get_with_cache->{-provides})) {
                 #   pre-cache the "provides" query for all(!) packages at once for speedup
                 my @c = run($config->{"rpm"} . " -qa --qf " .
                     '\'%{NAME}[ :::%{PROVIDENAME}:::%{PROVIDEFLAGS:depflags}:::%{PROVIDEVERSION}:::]\n\'');
                 $get_with_cache->{-provides} = {};
                 foreach my $c (@c) {
                     if ($c =~ m/^(\S+)(.*)$/s) {
                         my ($name, $provides) = ($1, $2);
                         while ($provides =~ m/\s+:::(.+?):::\s*(.*?)\s*:::(.*?):::/g) {
                             $get_with_cache->{-provides}->{$name} = [] if (not exists($get_with_cache->{-provides}->{$name}));
                             push(@{$get_with_cache->{-provides}->{$name}}, "$1 $2 $3");
                         }
                     }
                 }
             }
             @l = $get_with_cache->{-provides}->{$t->{name}};
             if (not @l) {
                 #   (should not happen in practice, but anyway)
                 @l = run($config->{"rpm"} . " -q --provides $t->{name}");
                 $get_with_cache->{-provides}->{$t->{name}} = [ @l ];
             }
         }
         $opt = parse_provideslist(\@l);
         if (scalar(keys(%$opt)) == 0) {
             if (defined($fn)) {
                 @l = run($config->{"rpm"} . " -qi -p $fn");
             } else {
                 if (not exists($get_with_cache->{-infos})) {
                     #   pre-cache the "infos" query for all(!) packages at once for speedup
                     my @c = run($config->{"rpm"} . " -qi -a");
                     my $p = "";
                     $get_with_cache->{-infos} = {};
                     foreach my $c (@c) {
                         $p = $1 if ($c =~ m/^Name:\s+(\S+)/s);
                         $get_with_cache->{-infos}->{$p} = [] if (not exists($get_with_cache->{-infos}->{$p}));
                         push(@{$get_with_cache->{-infos}->{$p}}, $c);
                     }
                 }
                 @l = $get_with_cache->{-infos}->{$t->{name}};
                 if (not @l) {
                     #   (should not happen in practice, but anyway)
                     @l = run($config->{"rpm"} . " -qi $t->{name}");
                     $get_with_cache->{-infos}->{$t->{name}} = [ @l ];
                 }
             }
             $opt = parse_options(\@l);
         }
         $t->{OPTIONS} = $opt;
     }
     return $opt;
 }
 #   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) = @_;
     my ($k);
     foreach $k (keys(%$new)) {
         if ((exists($old->{$k}) && $old->{$k} ne $new->{$k}) || $k =~ m/^$reg$/) {
             $old->{$k} = $new->{$k};
         }
     }
 }
 #   filter package options
 sub filter_name_with ($$$) {
     my ($name, $with, $global) = @_;
     my (@keys);
     if ($global) {
         push(@keys, grep { !/::/ } keys %$with);
     }
     push(@keys, grep { m/::/ } keys %$with);
     return {
         map {
             my ($k) = $_;
               $k !~ m/::/ || $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);
 }
 #   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 "openpkg:build: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 "openpkg:build: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 "openpkg:build: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 "openpkg:build:FATAL: stack underflow in: $cond\n" if scalar(@s) < 1;
     $res = pop(@s);
     die "openpkg:build:FATAL: stack not empty in: $cond\n" if scalar(@s) > 0;
     return $res;
 }
 #   retrieve conditional target attributes in map
 sub target_attribute ($$$;$) {
     my ($target, $env, $attr, $with) = @_;
     my ($optreg) = $env->{config}->{optreg};
     my ($name, @out);
     return if (not $target);
     $name = $target->{name};
     my ($mywith) = ($with ? $with : get_with($target));
     override_options($mywith, name_with($name, $env->{with}), $optreg);
     foreach (@{$target->{$attr}}) {
         next if (not conditional($_->{'cond'}, $mywith));
         push(@out, $_->{'value'});
     }
     return \@out;
 }
 #   see whether target is in map
 sub target_exists ($$) {
     my ($target, $map) = @_;
     my ($vmap) = $map->{$target->{name}};
     return if (not $vmap);
     return (
            !defined $target->{version}
         || defined $vmap->{vs($target)}
     );
 }
 #   see whether 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 whether 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, 0);
         return $t if $t;
     }
     return;
 }
 #   record target status
 sub target_setstatus ($$$) {
     my ($target, $status, $pri) = @_;
     if ($pri > $target->{STATUSPRI}) {
         $target->{STATUSPRI} = $pri;
         $target->{STATUS}    = $status;
     }
 }
 #   strip doubles from depend/keep lists
 #   and return a map name => depend/keep
 sub unique_map {
     my (%out);
     foreach (@_) {
         foreach (@$_) {
             $out{$_->{name}} = $_;
         }
     }
     return %out;
 }
 #   check whether installed package matches build options. If default
 #   = 1 then options which are not required must be identical to the
 #   DEFOPTS.
 sub target_suitable ($$$) {
     my ($target, $with, $default) = @_;
     my ($iwith, $dwith);
     my ($k, $v);
     if ($target->{GOAL}) {
         $with = name_with($target->{name}, $with);
     } else {
         $with = name_only_with($target->{name}, $with);
     }
     $iwith = $target->{OPTIONS};
     $dwith = $target->{DEFOPTS};
     while (($k,$v) = each(%$iwith)) {
         if (exists($with->{$k})) {
             return 0 if ($iwith->{$k} ne $with->{$k});
         } elsif ($default) {
             return 0 if ($iwith->{$k} ne $dwith->{$k});
         }
     }
     return 1;
 }
 #   determine whether 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;
 }
 #   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 (@targ, @recs, @nrecs, $rec, %nam);
     #   resolve name into a list of versions
     #   for virtual targets this resolves to a list
     #   of real targets that provide the virtual target
     @targ = get_targets($vmap, sub { 1; });
     return unless @targ;
     #   find usable binary targets add all source targets
     @recs = (
         ( grep {
                !$env->{sourceonly}
             && !is_source($_)
             && $_->{'platform'} eq $env->{config}->{platform}
             && $_->{'prefix'} eq $env->{config}->{prefix}
         } get_targets($vmap, $cond) ),
         ( grep {
             is_source($_)
         } @targ )
     );
     return if (not @recs);
     #   limit list to exact matches if provided by "-e"
     if (defined($select)) {
         @recs = grep {
             vsn($_) =~ m/^\Q$select\E/
         } @recs;
     }
     #   try to resolve ambiguity against installed targets
     #   and targets previously selected
     if (scalar(@recs) > 1) {
         @nrecs = grep {
                $env->{built}->{$_->{name}}
             || $env->{installed}->{$_->{name}}
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity against hints
     if ($env->{hint}) {
         @nrecs = grep {
             exists($env->{hint}->{$_->{name}})
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity against targets that match
     #   the exact name
     if (scalar(@recs) > 1) {
         @nrecs = grep {
             $name eq $_->{name}
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   try to resolve ambiguity by preferring binaries
     if (scalar(@recs) > 1 && !$env->{sourceonly}) {
         @nrecs = grep {
             defined($_->{'platform'})
         } @recs;
         @recs = @nrecs if (@nrecs);
     }
     #   if we still have non-unique targets, complain
     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;
         }
     }
     #   prefer full-source packages
     if (scalar(@recs) > 1) {
         @nrecs = grep {
                ! $_->{nosource}
             || ! @{$_->{nosource}}
         } @recs;
         unless (@nrecs) {
             @nrecs = grep {
                 $_->{href} !~ m/\.nosrc.rpm$/
             } @recs;
         }
         @recs = @nrecs if (@nrecs);
     }
     #   nothing left -> exit
     return if (scalar(@recs) == 0);
     #   chose last (= max version) in list of targets
     $rec = $recs[-1];
     print "# source for $name is ".vsn($rec)."\n";
     return $rec;
 }
 #   locate target for a dependency
 sub dep2target ($$$) {
     my ($dep, $env, $source) = @_;
     my ($name, $op, @targ);
     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 if (not ($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 "openpkg:build: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 && (@targ = get_targets($i, $cond))) {
         foreach $t (@targ) {
             get_with($t);
             if (target_suitable($t, $env->{with}, 0)) {
                 $tdef = $t;
                 if (not ($env->{upgrade} || $env->{zero} || $source)) {
                     return ($t, 1);
                 }
             }
         }
     }
     #   search target in current build list that matches requirement
     #   use it if it exists
     if ($b && (@targ = get_targets($b, $cond))) {
         $t = $targ[0];
         return ($t, 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'
             ) || $source) {
             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;
 }
 #   compute reverse dependency map
 sub get_revdep ($) {
     my ($env) = @_;
     my ($i) = $env->{'installed'};
     my ($r) = $env->{'repository'};
     my ($pkg, %dep, %dlist, %rev);
     my (@targ, $t, $t1, $t2, $with, $name, $vmap);
     my ($d, $k, %d, $old, %name, %pkg);
     print "# computing reverse dependencies\n";
     #   iterate over all installed packages
     foreach $pkg (keys(%$i)) {
         $vmap = $r->{$pkg};
         if (not $vmap) {
             print "# ATTENTION: $pkg has no upgrade path (installed package not found in repository)\n";
             next;
         }
         #   get forward dependencies from installed packages
         #   dep{a}{b} is true if b depends directly on a
         #   dlist{a}  is list of packages that depend on a
         @targ = get_targets($i->{$pkg}, sub { 1; });
         foreach $t (@targ) {
             $with = get_with($t);
             $d = target_attribute($t, $env, 'depends', $with);
             $k = target_attribute($t, $env, 'keeps', $with);
             next if (not (@$d || @$k));
             %d = unique_map($d,$k);
             #   resolve package
             if (not exists($pkg{$pkg})) {
                 ($t2, $old) = dep2target({ name => $pkg }, $env, 1);
                 $t2 = undef if ($old);
                 $pkg{$pkg} = $t2;
             }
             $t2 = $pkg{$pkg};
             next if (not $t2);
             foreach (keys(%d)) {
                 next if ($_ eq 'OpenPKG');
                 #   resolve target
                 unless (exists($name{$_})) {
                     ($t1, $old) = dep2target($d{$_}, $env, 0);
                     $name{$_} = ($t1 ? $t1->{name} : $_);
                 }
                 $name = $name{$_};
                 if (not $dep{$name}{$t->{name}}) {
                     $dep{$name}{$t->{name}} = 1;
                     push(@{$dlist{$name}}, $t2);
                 }
             }
         }
     }
     #   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 hash of package reverse dependencies
     return \%rev;
 }
 #   build package dependencies
 #   (all input and output is passed in 'env' hash)
 sub build_deps ($$) {
     my ($pattern, $env) = @_;
     my ($todo, @list, $list, @out);
     #   determine all packages which match the pattern
     $todo = search_pattern($pattern, $env);
     #   unfold target names into all(!) real targets names
     @list =
     map {
         map {
             map {
                 $_->{name}
             } @$_
         } values(%{$env->{repository}->{$_}})
     } @$todo;
     #   also add target name
     push @list, @$todo;
     #   strip duplicate names
     @list = keys %{ { map { $_ => 1 } @list } };
     #   cache reverse dependencies
     if (not $env->{revdep}) {
         $env->{revdep} = get_revdep($env);
     }
     #   map targets into list of dependency names
     @list = map {
           $env->{revdep}->{$_}
         ? (@{$env->{revdep}->{$_}})
         : ()
     } @list;
     #   iterate over dependencies
     foreach (@list) {
         #   avoiding cycles
         next if ($env->{builddeps}->{$_->{name}});
         $env->{builddeps}->{$_->{name}} = 1;
         #   generate result
         push(@out, $_);
         #   generate result recursively
         $list = build_deps($_->{name}, $env); # RECURSION
         push(@out, @$list);
     }
     #   return final results
     return \@out;
 }
 #   report options that are not used for
 sub warn_about_options ($$$) {
     my ($target, $with, $c) = @_;
     my ($iwith) = $target->{OPTIONS};
     my ($k, $v);
     return if (not defined($iwith));
     $with = name_with($target->{name}, $with);
     while (($k,$v) = each %$with) {
         if (not ($k =~ m/^$c->{optreg}$/ || exists $iwith->{$k})) {
             print "# ATTENTION: $target->{name} ignores option '$k'\n";
         }
     }
 }
 #   find target in map
 sub find_target ($$$) {
     my ($name, $map, $pos) = @_;
     my ($vmap) = $map->{$name};
     my (@vs);
     return if (not $vmap);
     @vs = sort { vcmp($b,$a) } keys(%$vmap);
     return $vmap->{$vs[$pos]}->[-1];
 }
 #   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 if (not 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}};
     @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;
 }
 #   remember fatal error
 sub pusherr ($$$) {
     my ($env, $target, $mess) = @_;
     print "# $mess\n";
     push(@{$env->{fatal}}, vsn($target).": $mess\n");
 }
 #   generate dependencies
 sub make_dep ($$$$$$$) {
     my ($who, $target, $depth, $env, $list, $blist, $clist) = @_;
     my ($d, $k, %d, %k, $t, $old);
     my (@deps, $conflict, $why);
     #   check whether target is already in list of to be build packages
     if (target_exists($target, $env->{built})) {
         print "# $target->{name} is already in list\n";
         return;
     }
     #   check whether target is in conflict with already installed package
     if ($t = target_has_conflicts($target, $env->{installed}, $env)) {
         target_setstatus($target, 'CONFLICT', 4);
         push(@$clist, $target);
         pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
         return;
     }
     #   check whether target is in conflict with to be build package
     if ($t = target_has_conflicts($target, $env->{built}, $env)) {
         target_setstatus($target, 'CONFLICT', 4);
         push(@$clist, $target);
         pusherr($env, $target, "$target->{name} conflicts with ".vsn($t));
         return;
     }
     #   see if a target is already installed and requires a rebuild
     if ($t = find_target($target->{name}, $env->{installed}, -1)) {
         if (exists($env->{exclude}->{$target->{name}})) {
             print "# excluding $target->{name} (no upgrade allowed)\n";
             return;
         }
         #   pull in options (for status report)
         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 (vs($target) ne vs($t)) {
             target_setstatus($target, 'UPDATE', 3);
             print "# rebuilding $target->{name} (update)\n";
         } elsif (!target_suitable($t, $env->{with}, 0)) {
             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 {
         print "# creating $target->{name}\n";
         target_setstatus($target, 'ADD', 3);
     }
     if (exists($env->{exclude}->{$target->{name}})) {
         die "openpkg:build: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;
     #   recurse over dependencies
     $d = target_depends($target, $env);
     $k = target_keeps($target, $env);
     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, 0);
             if ($t) {
                 if ($old) {
                     print "# $target->{name} uses ".vsn($t)." for $_\n";
                     if ($t->{LIMBO}) {
                         print "# ATTENTION: ".vsn($t)." is in LIMBO\n";
                     }
                     next;
                 }
                 if (not depend_option($t, $d{$_}, $env)) {
                     push(@$clist, $target);
                     pusherr($env, $target, "$target->{name} has conflicting requirement");
                     target_setstatus($target, 'UNDEF', 4);
                     $conflict = 1;
                     next;
                 }
                 if ($k{$_}) {
                     push(@$blist, $t);
                     print "# $target->{name} installs ".vsn($t)." for $_\n";
                 } else {
                     print "# $target->{name} requires ".vsn($t)." for $_\n";
                 }
                 push(@deps, $t);
             } else {
                 push(@$clist, $target);
                 pusherr($env, $target, "$target->{name} searches a frood called '$_'");
                 target_setstatus($target, 'UNDEF', 4);
                 $conflict = 1;
             }
         }
         if (not $conflict) {
             foreach $t (@deps) {
                 make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
             }
         }
     }
     print "# adding ".vsn($target)." to list\n";
     $target->{WHO} = $who;
     $target->{WHY} = $target->{STATUS};
     push(@$list, $target);
     #   remember new options
     override_options(get_with($target), name_with($target->{name}, $env->{with}), '');
     #   moan about non-source packages
     foreach (@{target_nosource($target, $env)}) {
         my ($p) = target_source($target, $env)->[$_];
         $p =~ s/.*\///;
         print "# ATTENTION: unpackaged source $_: $p\n";
     }
     #   cleanup limbo
     $target->{LIMBO} = 0;
     #   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' ) {
         if (not $env->{revdep}) {
             $env->{revdep} = get_revdep($env);
         }
         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 reverse dependency ".vsn($t)."\n";
             make_dep($target, $t, $depth+1, $env, $list, $blist, $clist); # RECURSION
         }
     }
 }
 #   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);
     #   determine all packages which match the pattern
     $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
         #if (not $env->{upgrade}) {
         #    $i = $env->{installed}->{$name};
         #    $t = chose_source($env, $name, $select, $i, sub { 1; });
         #}
         if (not $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 {
             #   error
             if ($env->{status}) {
                 print "# dropping goal '$name'\n";
             } else {
                 die "openpkg:build:FATAL: cannot find source for '$name'\n";
             }
         }
     }
     return if (not @goals);
     #   recurse over dependencies
     @targets = ();
     @keeps   = @goals;
     foreach $t (@goals) {
         print "# recursing over dependencies for ".vsn($t)."\n";
         make_dep(undef, $t, 0, $env, \@targets, \@keeps, \@conflicts);
     }
     #   determine "binary only" packages which should be not kept
     #   as they were not installed and are used temporarily only.
     %keep = map { $_ => 1 } @keeps;
     @bonly = reverse grep {
         !$keep{$_} && !$env->{installed}->{$_->{name}}
     } @targets;
     #   return results
     return (\@targets, \@bonly, \@conflicts);
 }
 #############################################################################
 ##
 ##  FUNCTIONS: RESULT PRINTING
 ##
 #############################################################################
 #   determine execution command
 sub cmd ($$) {
     my ($w,$s) = @_;
     if (!defined($w)) {
         return $s;
     } elsif ($w =~ m/^-(.*)/) {
         return "$1 \"$s\"";
     } else {
         return "$w $s";
     }
 }
 sub priv  ($) { cmd($opt_P, $_[0]); }
 sub npriv ($) { cmd($opt_N, $_[0]); }
 #   execute a command
 my $run_cache = {};
 sub run ($) {
     my $cmd = cmd($opt_N, $_[0]);
     my $out = $run_cache->{$cmd};
     if (not defined($out)) {
         my @out = `$cmd`;
         $out = [ @out ];
         $run_cache->{$cmd} = $out;
     }
     return (wantarray ? @{$out} : join(//, @{$out}));
 }
 #   print dependency list
 sub print_deps ($) {
     my ($list) = @_;
     print join("\n", sort map { vsn($_) } @$list), "\n";
 }
 #   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($_)
         );
     }
 }
 #   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);
     #   augment map with additional information
     #   about conflicting and binary only (temporary) packages
     foreach (@$list, @$clist) {
         next if (not $_->{release} =~ m/\S/);
         $map{$_->{name}} = {
             rel    => "$_->{version}-$_->{release}",
             status => $_->{STATUS}
         };
     }
     foreach (@$bonly) {
         next if (not $_->{release} =~ m/\S/);
         $map{$_->{name}} = {
             rel    => "$_->{version}-$_->{release}",
             status => 'TEMP'
         };
     }
     #   augment map with additional information
     #   about up-to-date and new packages
     @names = keys(%map);
     foreach $n (keys(%$installed)) {
         next if ($n =~ m/::/);
         next if (exists($map{$n}));
         next if (not (grep { $_ ne '' } keys(%{$installed->{$n}})));
         $map{$n}->{'status'} = 'OK';
         push(@names, $n);
     }
     foreach $n (keys(%$repository)) {
         next if ($n =~ m/::/);
         next if (exists($map{$n}));
         next if (not (grep { $_ ne '' } keys(%{$repository->{$n}})));
         $t = find_target($n, $repository, 0);
         $map{$n}->{'status'} = 'NEW';
         $map{$n}->{'rel'}    = vs($t);
         push(@names, $n);
     }
     #   generate status output
     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);
     }
 }
 #   compute path to source RPM from rpm config and target data
 sub target2srcrpm ($$) {
     my ($target, $c) = @_;
     return $c->{srcrpmdir}.'/'.$target->{name}.'-'.$target->{version}.'-'.$target->{release}.'.src.rpm';
 }
 #   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;
 }
 #   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->{$_} =~ m/\S/ &&
             $old->{$_} !~ m/^%/ &&
             $old->{$_} ne $def->{$_}
         } keys %$old
     );
     $with = ' '.$with if ($with ne '');
     return $with;
 }
 #   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($config->{"rpm"} . " -ql $t->{name}");
     my ($link) = (grep { $_ =~ m/\/\.prefix-$t->{name}$/ } @l)[0];
     return if (not defined($link));
     chomp $link;
     my ($prefix) = readlink($link);
     return if (not defined($prefix));
     $bpkg =~ s/.*\///;
     $bpkg =~ s/\+PROXY(\.[^-]+-[^-]+)-[^-]+\.rpm$/$1-*.rpm/;
     return (glob("$prefix/RPM/PKG/$bpkg"))[0];
 }
 #   indent text to form a block
 sub indent ($) {
     my ($txt) = @_;
     $txt =~ s/^/    /gm;
     return $txt;
 }
 #   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 ($pkg, $spkg, $bpkg, $uvhpkg, $ppkg);
     my ($opt);
     my ($cmd1, $cmd2, $mark);
     my ($cmd3, $srcpkg);
     $mark = '::::';
     my $err;
     if ($ignore) { $err = "|| true" } else { $err = "|| exit \$?" };
     foreach (@$list) {
         $pkg = $_->{name};
         $spkg = $_->{href};
         unless ($spkg =~ m/\S/) {
             die "openpkg:build:FATAL: internal error, ",vsn($_)," without source URL\n";
         }
         $bpkg = target2rpm($_, $c); $uvhpkg = $bpkg;
         $srcpkg = target2srcrpm($_, $c);
         $cmd3 = '';
         #   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
             || !-f $bpkg
             || !target_suitable(binary_target($_, $bpkg), $with, 1)) {
             $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 "openpkg:build:FATAL: proxy package ",vsn($_)," does not exist\n";
                 #   rpm doesn't support additional parameters to the
                 #   mkproxy script
                 #   $cmd1 = npriv($config->{"mkp"} . " $ppkg -- -o $bpkg");
                 $cmd1 = "( cd $c->{rpmdir} && ".
                         npriv($config->{"mkp"} . " $ppkg").
                         " )";
             } elsif (defined $_->{prefix}) {
                 $cmd1 = '';
                 if ($spkg =~ m|^\.?/|) {
                     $uvhpkg = $spkg;
                 }
                 else {
                     $cmd1 .= npriv($config->{"curl"} . " -# -o $bpkg $spkg $err\n");
                     $cmd3 = npriv("rm -f $bpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
                 }
             } else {
                 $cmd1 = '';
                 if ($spkg =~ m|^\.?/|) {
                     $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $spkg $err\n");
                 }
                 else {
                     $cmd1 .= "if test ! -f $srcpkg; then\n";
                     $cmd1 .= indent(npriv($config->{"curl"} . " -# -o $srcpkg $spkg $err\n"));
                     $cmd1 .= "fi\n";
                     $cmd1 .= npriv($config->{"rpm"} . "$opt --rebuild $srcpkg $err\n");
                     $cmd1 .= npriv("rm -f $srcpkg >/dev/null 2>&1 $err\n") unless ($opt_k);
                 }
             }
         }
         #   wrap build command with build-time check for existing
         #   binary target
         if (defined($cmd1) && ($allbin || ($usebin && !$_->{GOAL}))) {
             $cmd1 = "if test ! -f $uvhpkg; then\n".indent($cmd1)."fi\n";
         }
         #   if package exist force rpm to copy over new files
         #   better than erasing everything and losing configuration
         #   files
         $opt = ($_->{REBUILD} || ($allbin || ($usebin && !$_->{GOAL}))) ? ' --force' : '';
         $cmd2 = '';
         $cmd2 .= priv($config->{"rpm"} . "$opt -Uvh $uvhpkg $err\n");
         if ($allbin || ($usebin && !$_->{GOAL})) {
             $cmd2 = "if test \".`".$config->{"rpm"}." -q --qf '\%{SIGMD5}' $pkg`\" != \".`".$config->{"rpm"}." -qp --qf '\%{SIGMD5}' $uvhpkg`\"; then\n".indent($cmd2)."fi\n";
         }
         $cmd2 = $cmd1.$cmd2 if ($cmd1);
         $cmd2 = $cmd2.$cmd3 if ($cmd3);
         print "echo $mark $spkg $mark\n".$cmd2."echo $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($config->{"rpm"} . " -e $pkg\n");
     }
 }

OpenPKG Specs / annotate

openpkg/build.pl@a2c6460cfb16 (annotated)

openpkg/build.pl