1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/openpkg/index.pl Tue Jul 31 12:23:42 2012 +0200
1.3 @@ -0,0 +1,1173 @@
1.4 +##
1.5 +## index.pl -- OpenPKG Maintenance Tool (backend for indexing)
1.6 +## Copyright (c) 2000-2012 OpenPKG GmbH <http://openpkg.com/>
1.7 +##
1.8 +## This software is property of the OpenPKG GmbH, DE MUC HRB 160208.
1.9 +## All rights reserved. Licenses which grant limited permission to use,
1.10 +## copy, modify and distribute this software are available from the
1.11 +## OpenPKG GmbH.
1.12 +##
1.13 +## THIS SOFTWARE IS PROVIDED "AS IS" AND ANY EXPRESSED OR IMPLIED
1.14 +## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
1.15 +## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
1.16 +## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
1.17 +## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
1.18 +## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
1.19 +## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
1.20 +## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
1.21 +## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
1.22 +## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
1.23 +## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
1.24 +## SUCH DAMAGE.
1.25 +##
1.26 +
1.27 +#############################################################################
1.28 +##
1.29 +## MAIN PROCEDURE
1.30 +##
1.31 +#############################################################################
1.32 +
1.33 +require 5;
1.34 +#use strict;
1.35 +
1.36 +# determine OpenPKG instance prefix via
1.37 +# 1. the environment of the "openpkg build" framework
1.38 +# 2. the installation path of the script
1.39 +# 3. the installation path of the Perl interpreter
1.40 +# 4. the path of the "openpkg" command in $PATH
1.41 +my $l_prefix = $ENV{'OPENPKG_PREFIX'};
1.42 +if (not $l_prefix) {
1.43 + ($l_prefix) = ($0 =~ m/^(.+)\/lib(exec)?\/openpkg(-tools)?\/build(\.pl)?$/);
1.44 +}
1.45 +if (not $l_prefix) {
1.46 + ($l_prefix) = ($^X =~ m/^(.+)\/bin\/perl.*$/);
1.47 +}
1.48 +if (not $l_prefix) {
1.49 + $l_prefix = (`(which openpkg) 2>/dev/null` =~ m/^(.+)\/bin\/openpkg$/);
1.50 +}
1.51 +if (not -x "$l_prefix/bin/openpkg") {
1.52 + die "openpkg:index:FATAL: cannot determine OpenPKG instance prefix";
1.53 +}
1.54 +
1.55 +# determine tools
1.56 +my $RPM = ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm") ?
1.57 + "$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
1.58 +my $R2C = ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/openpkg/rpm2cpio") ?
1.59 + "$l_prefix/bin/openpkg rpm2cpio" : "$l_prefix/bin/rpm2cpio");
1.60 +my $BZ = "$l_prefix/lib/openpkg/bzip2 -9";
1.61 +my $OPENSSL = "$l_prefix/lib/openpkg/openssl";
1.62 +
1.63 +# parse command line
1.64 +our ($opt_r, $opt_p, $opt_S, $opt_T, $opt_D, $opt_C, $opt_o, $opt_c, $opt_i);
1.65 +my $getopts = 'r:p:STDC:o:ci';
1.66 +getopts($getopts);
1.67 +if ($#ARGV < 0) {
1.68 + print "openpkg:index:USAGE: openpkg index [-r resource] [-p platform] [-S] [-T] [-D] [-C cache.db] [-o index.rdf] [-c] [-i] dir ...\n";
1.69 + exit(1);
1.70 +}
1.71 +
1.72 +# optionally open cache file
1.73 +my %cache;
1.74 +if ($opt_C) {
1.75 + eval {
1.76 + require DB_File;
1.77 + };
1.78 + if ($@) {
1.79 + die "openpkg:index:FATAL: The -C option requires an installed DB_File perl module.";
1.80 + }
1.81 + eval {
1.82 + require Fcntl;
1.83 + };
1.84 + if ($@) {
1.85 + die "openpkg:index:FATAL: The -C option requires an installed Fcntl perl module.";
1.86 + }
1.87 + tie %cache, 'DB_File', $opt_C, Fcntl::O_CREAT()|Fcntl::O_RDWR(), 0666, $DB_File::DB_HASH
1.88 + or die "openpkg:index:FATAL: cannot tie cache '$opt_C' ($!)";
1.89 +}
1.90 +
1.91 +# provide default for repository path
1.92 +$opt_r = 'OpenPKG-CURRENT/Source/' if (not defined($opt_r));
1.93 +
1.94 +# create make_resource function closure
1.95 +my $make_resource = gen_make_resource();
1.96 +
1.97 +# determine output channel
1.98 +my $fh;
1.99 +my $tmpo;
1.100 +if (defined($opt_o)) {
1.101 + $tmpo = $opt_o . '.tmp';
1.102 + if ($opt_c) {
1.103 + open(FH, "| $BZ -c > '$tmpo'")
1.104 + or die "openpkg:index:FATAL: cannot write '$tmpo' ($!)";
1.105 + } else {
1.106 + open(FH, "> $tmpo")
1.107 + or die "openpkg:index:FATAL: cannot write '$tmpo' ($!)";
1.108 + }
1.109 +} else {
1.110 + if ($opt_c) {
1.111 + open(FH, "| $BZ -c")
1.112 + or die "openpkg:index:FATAL: cannot write to stdout ($!)";
1.113 + } else {
1.114 + open(FH, ">&=1")
1.115 + or die "openpkg:index:FATAL: cannot write to stdout ($!)";
1.116 + }
1.117 +}
1.118 +$fh = \*FH;
1.119 +
1.120 +# generate XML/RDF output
1.121 +xml_head($fh, $opt_r);
1.122 +foreach my $prefix (@ARGV) {
1.123 + my $list;
1.124 + if (-d $prefix) {
1.125 + if ($opt_i) {
1.126 + $list = list_rpmdir($prefix);
1.127 + } else {
1.128 + $list = list_specdir($prefix);
1.129 + }
1.130 + } else {
1.131 + $list = [ $prefix ];
1.132 + $prefix = dirname($prefix);
1.133 + }
1.134 + write_index($fh, $prefix, $opt_r, $opt_p, $list, $opt_C ? \%cache : undef);
1.135 +}
1.136 +xml_foot($fh);
1.137 +
1.138 +# close output channel
1.139 +close($fh)
1.140 + or die "openpkg:index:FATAL: write error on output ($!)";
1.141 +
1.142 +# post-process output
1.143 +if (defined($tmpo)) {
1.144 + rename($tmpo, $opt_o)
1.145 + or die "openpkg:index:FATAL: cannot rename $tmpo to $opt_o ($!)";
1.146 +}
1.147 +
1.148 +# die gracefully
1.149 +exit(0);
1.150 +
1.151 +#############################################################################
1.152 +##
1.153 +## FUNCTIONS: PARSING
1.154 +##
1.155 +#############################################################################
1.156 +
1.157 +# home-brewn getopt(3) style option parser
1.158 +sub getopts ($) {
1.159 + my ($opts) = @_;
1.160 + my (%optf) = map { m/(\w)/; $1 => $_ } $opts =~ m/(\w:|\w)/g;
1.161 + my (%opts, @argv, $optarg);
1.162 +
1.163 + foreach (@ARGV) {
1.164 + if (@argv) {
1.165 + push @argv, $_;
1.166 + } elsif (defined $optarg) {
1.167 + if (exists $opts{$optarg}) {
1.168 + $opts{$optarg} .= " $_";
1.169 + } else {
1.170 + $opts{$optarg} = $_;
1.171 + }
1.172 + $optarg = undef;
1.173 + } elsif (!/^[-]/) {
1.174 + push @argv, $_;
1.175 + } else {
1.176 + while (/^\-(\w)(.*)/) {
1.177 + if (exists $optf{$1}) {
1.178 + if (length($optf{$1}) > 1) {
1.179 + if ($2 ne '') {
1.180 + if (exists $opts{$1}) {
1.181 + $opts{$1} .= " $2";
1.182 + } else {
1.183 + $opts{$1} = $2;
1.184 + }
1.185 + } else {
1.186 + $optarg = $1;
1.187 + }
1.188 + last;
1.189 + } else {
1.190 + $opts{$1} = 1;
1.191 + }
1.192 + } else {
1.193 + warn "openpkg:index:WARNING: unknown option $_\n";
1.194 + }
1.195 + $_ = "-$2";
1.196 + }
1.197 + }
1.198 + }
1.199 + if (defined $optarg) {
1.200 + warn "openpkg:index:WARNING: option $optarg requires an argument\n";
1.201 + }
1.202 + foreach (keys %opts) {
1.203 + eval '$opt_'.$_.' = "'.quotemeta($opts{$_}).'";';
1.204 + }
1.205 + @ARGV = @argv;
1.206 +}
1.207 +
1.208 +#############################################################################
1.209 +##
1.210 +## OpenPKG RPM Package Specification Parsing
1.211 +##
1.212 +#############################################################################
1.213 +
1.214 +# escape XML for output in RDF file
1.215 +sub e ($) {
1.216 + my ($s) = @_;
1.217 + my ($i);
1.218 +
1.219 + # remove trailing whitespace
1.220 + $s =~ s/\n+$//sg;
1.221 + $s =~ s/[^\S\n]+$//mg;
1.222 +
1.223 + # remove common leading whitespace
1.224 + $i = undef;
1.225 + while ($s =~ m/^([^\S\n]+)/mg) {
1.226 + $i = $1 if (!defined($i) || (length($1) < length($i)));
1.227 + }
1.228 + $s =~ s/^\Q$i\E//mg if (defined($i));
1.229 +
1.230 + # escape XML special characters
1.231 + $s =~ s/&/&/sg;
1.232 + $s =~ s/</</sg;
1.233 + $s =~ s/>/>/sg;
1.234 +
1.235 + return $s;
1.236 +}
1.237 +
1.238 +# make_resource closure
1.239 +sub gen_make_resource {
1.240 + # generate operator regular expression
1.241 + # (used in make_resource below)
1.242 + my %attrname = (
1.243 + '==' => 'equ',
1.244 + '=' => 'equ',
1.245 + '>=' => 'geq',
1.246 + '=>' => 'geq',
1.247 + '<=' => 'leq',
1.248 + '=<' => 'leq',
1.249 + '>' => 'gt',
1.250 + '<' => 'lt'
1.251 + );
1.252 + my ($opreg) =
1.253 + join '|',
1.254 + map {
1.255 + "\Q$_\E"
1.256 + } sort {
1.257 + length($b) <=> length($a)
1.258 + || $b cmp $a
1.259 + } keys(%attrname);
1.260 +
1.261 + # return function which makes resource object
1.262 + return sub ($) {
1.263 + my ($s) = @_;
1.264 +
1.265 + if ($s =~ m/(\S+)\s*($opreg)\s*(.*?)\s*$/o) {
1.266 + return {
1.267 + resource => $1,
1.268 + attrname => $attrname{$2},
1.269 + attrval => $3
1.270 + }
1.271 + }
1.272 + else {
1.273 + return {
1.274 + resource => $s
1.275 + }
1.276 + }
1.277 + };
1.278 +};
1.279 +
1.280 +# split string into array at comma seperator
1.281 +# (optioanlly map resource operators into resource objects)
1.282 +sub commasep ($$) {
1.283 + my ($k, $v) = @_;
1.284 +
1.285 + if ($k =~ m/^(NoSource)$/) {
1.286 + return split(/\s*,\s*/, $v);
1.287 + } elsif ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts)$/) {
1.288 + return map { &$make_resource($_) }
1.289 + split(/\s*,\s*/, $v);
1.290 + }
1.291 + return $v;
1.292 +}
1.293 +
1.294 +# escape option string
1.295 +sub optesc ($) {
1.296 + my ($s) = @_;
1.297 +
1.298 + $s =~ s/([\x00-\x1f\x80-\xbf\s\%])/sprintf("%%%02x", ord($1))/eg;
1.299 + return $s;
1.300 +}
1.301 +
1.302 +# variable substitution
1.303 +sub vsub ($$) {
1.304 + my ($var, $v) = @_;
1.305 +
1.306 + $v =~ s/\%\{([^}]+)\}/
1.307 + exists $var->{$1} ? $var->{$1} : '%{'.$1.'}'/emg;
1.308 + return $v;
1.309 +}
1.310 +
1.311 +# Umgekehrte Polnische Notation (UPN)
1.312 +# Reverse Polish Notation (RPN)
1.313 +# << ( %{foo} == "yes" ) && ( ! %{bar} == "no" ) || ( %{baz} == "yes" )
1.314 +# >> %{foo} %{bar} ! && %{baz} ||
1.315 +sub upn ($) {
1.316 + my ($t) = @_;
1.317 + my (@tok);
1.318 + my (@out, $op, $o);
1.319 + my (@save);
1.320 +
1.321 + # split string into tokens
1.322 + @tok = ($t =~ m/(\(|\)|\&\&|\|\||\!|\S+)/g);
1.323 +
1.324 + # iterate over all tokens
1.325 + $op = [];
1.326 + foreach (@tok) {
1.327 + if ($_ eq '(') {
1.328 + push(@save, $op);
1.329 + $op = [];
1.330 + } elsif ($_ eq ')') {
1.331 + die "openpkg:index:FATAL: unresolved operators in: @tok\n" if (@$op);
1.332 + $op = pop(@save)
1.333 + or die "openpkg:index:FATAL: unmatched closing parenthesis in: @tok\n";
1.334 + while ($o = pop(@$op)) {
1.335 + push(@out, $o->[0]);
1.336 + last if ($o->[1]);
1.337 + }
1.338 + } elsif ($_ eq '&&') {
1.339 + push(@$op, [ '+', 1 ]);
1.340 + } elsif ($_ eq '||') {
1.341 + push(@$op, [ '|', 1 ]);
1.342 + } elsif ($_ eq '!') {
1.343 + push(@$op, [ '!', 0 ]);
1.344 + } elsif (m/^\%\{(\S*?)\}$/) {
1.345 + push(@out, $1);
1.346 + while ($o = pop(@$op)) {
1.347 + push(@out, $o->[0]);
1.348 + last if ($o->[1]); # binary operator
1.349 + }
1.350 + }
1.351 + }
1.352 + return join (' ', @out);
1.353 +}
1.354 +
1.355 +# deduce external variables from description
1.356 +# (backward compatibility for times before openpkg-20021230)
1.357 +sub find_options ($) {
1.358 + my ($descr) = @_;
1.359 + my $evar = {};
1.360 + $descr =~ s/--define\s*'(\S+)\s*\%\{\1\}'/$evar->{$1} = '%{'.$1.'}', ''/sge;
1.361 + return $evar;
1.362 +}
1.363 +
1.364 +# translate default section from spec-file into a hash
1.365 +# - %if/%ifdef/%define... are translated to #/#ifdef/#define
1.366 +# - #defines are interpolated (correct ?)
1.367 +# - #if/#ifdef/... sections are stripped
1.368 +# result is the same as if all conditions evaluate false (!)
1.369 +# - all attributes are of the form key: value
1.370 +# - repeated attributes are coalesced into a list
1.371 +# hint: evar = expansion variables, ovar = option variables
1.372 +sub package2data ($$) {
1.373 + my ($s, $ovar) = @_;
1.374 + my (%evar, %var);
1.375 + my (@term, $term);
1.376 + my (%attr, %avar);
1.377 + my ($l, $v, $cond, $d, $p);
1.378 + my ($re, @defs);
1.379 +
1.380 + # combine multilines (line continuation!)
1.381 + $s =~ s/\\\n/ /sg;
1.382 +
1.383 + # map syntax of conditional variable macros
1.384 + $s =~ s/^#\{\!\?([^:]*):\s*%(.*?)\s*\}\s*$/#ifndef $1\n#$2\n#endif/mg;
1.385 + $s =~ s/^#\{\!\?([^:]*):\s*(.*?)\s*\}\s*$/#ifndef $1\n$2\n#endif/mg;
1.386 +
1.387 + # map syntax of option macro
1.388 + $s =~ s/^#option\s+(\S+)\s*(.*?)\s*$/#ifndef $1\n#define $1 $2\n#endif\n#provides $1 $2/mg;
1.389 +
1.390 + # use option variables for expansion
1.391 + %evar = %$ovar;
1.392 +
1.393 + # guess more external parameters by scanning for (and removing) "set option default" sections
1.394 + $re = '^\#ifndef\s+[\w\_]+\s*\n((?:\#define\s+[\w\_]+\s.*\n)+)\#endif\n';
1.395 + @defs = ($s =~ m/$re/gm);
1.396 + foreach (@defs) {
1.397 + while (m/^\#define\s+([\w\_]+)\s(.*?)\s*$/mg) {
1.398 + $ovar->{$1} = $2;
1.399 + $evar{$1} = '%{'.$1.'}';
1.400 + }
1.401 + }
1.402 + $s =~ s/$re//gm;
1.403 +
1.404 + # add everything looking like a "with_xxx" variable
1.405 + $re = '%{(with\_[\w\_]+)}';
1.406 + @defs = ($s =~ /$re/gm);
1.407 + foreach (@defs) {
1.408 + next if (exists($ovar->{$1}));
1.409 + $ovar->{$1} = '%{'.$1.'}'; # unexpanded
1.410 + $evar{$1} = '%{'.$1.'}';
1.411 + }
1.412 +
1.413 + # extract all conditional sections (#if/#else/#endif)
1.414 + @term = ();
1.415 + %var = ();
1.416 + $cond = '';
1.417 + foreach $l (split(/\n/, $s)) {
1.418 + # expand variables
1.419 + $v = vsub(\%avar, vsub(\%var, $l));
1.420 +
1.421 + if (($p) = ($v =~ /^\#if\s+(.*?)\s*$/)) {
1.422 + # normalize "%{variable}" != ..."
1.423 + $p =~ s/("\%\{[^}]+\}")\s*!=\s*"(yes|no)"/$1 . " == \"" . ($2 ne "yes" ? "yes" : "no") . "\""/sge;
1.424 +
1.425 + # normalize #if expressions
1.426 + # - "%{variable}" == "yes"
1.427 + # - "%{variable}" == "no"
1.428 + # - operators ! && ||
1.429 + # warn on:
1.430 + # - operator !=
1.431 + # - any other word
1.432 + $term = '';
1.433 + while ($p =~ m/(!=)|(\!|\|\||\&\&|\(|\))|"\%\{([^}]+)\}"\s*==\s*"(yes|no)"|(\S+)/g) {
1.434 + if (defined($1)) {
1.435 + warn "openpkg:index:WARNING: unknown token '$1':\n< $l\n> $v";
1.436 + } elsif (defined($5)) {
1.437 + warn "openpkg:index:WARNING: unknown token '$5':\n< $l\n> $v";
1.438 + } elsif (defined($2)) {
1.439 + $term .= " $2 ";
1.440 + } elsif (exists($evar{$3})) {
1.441 + $term .= ($4 eq 'no' ? '! ' : '').vsub(\%evar, '%{'.$3.'}');
1.442 + } else {
1.443 + warn "openpkg:index:WARNING: unknown condition variable '$3':\n< $l\n> $v";
1.444 + }
1.445 + }
1.446 +
1.447 + # join with previous conditions for this #if/#endif block
1.448 + if ($term ne '') {
1.449 + push(@term, "( $term )");
1.450 + $cond = join(' && ', grep { $_ ne '' } @term) . '';
1.451 + } else {
1.452 + push(@term, '');
1.453 + }
1.454 + }
1.455 + elsif ($v =~ /^\#else\s*$/) {
1.456 + # reverse last condition
1.457 + if (@term) {
1.458 + $term[-1] = ' ! '. $term[-1];
1.459 + $cond = join(' && ', grep { $_ ne '' } @term) . '';
1.460 + } else {
1.461 + die "openpkg:index:FATAL: \"else\" without \"if\"";
1.462 + }
1.463 + }
1.464 + elsif ($v =~ /^\#endif\s*$/) {
1.465 + # unwind last #if expression
1.466 + pop(@term);
1.467 + $cond = join(' && ', grep { $_ ne '' } @term) . '';
1.468 + }
1.469 + elsif ($v =~ /^\#(?:define)\s*(\S+)\s*(.*?)\s*$/) {
1.470 + # define conditional variables
1.471 + # - truth-value becomes current condition
1.472 + # define internal variables
1.473 + # - store for subsequent substitution
1.474 + if (exists($evar{$1})) {
1.475 + if ($2 eq 'yes') {
1.476 + if ($cond eq '') {
1.477 + $evar{$1} = "( \%\{$1\} )";
1.478 + } else {
1.479 + $evar{$1} = "( \%\{$1\} || ( $cond ) )";
1.480 + }
1.481 + } elsif ($2 eq 'no') {
1.482 + if ($cond eq '') {
1.483 + $evar{$1} = "( \%\{$1\} )";
1.484 + } else {
1.485 + $evar{$1} = "( %\{$1\} && ! ( $cond ) )";
1.486 + }
1.487 + } else {
1.488 + warn "openpkg:index:WARNING: logic too complex for '$1' (boolean expressions allowed only):\n< $l\n> $v";
1.489 + }
1.490 + } else {
1.491 + $var{$1} = $2;
1.492 + }
1.493 + }
1.494 + elsif ($v =~ /^\#(?:undefine)\s*(\S+)\s*$/) {
1.495 + # undefine conditional variables
1.496 + # undefine internal variables
1.497 + if (exists($evar{$1})) {
1.498 + $evar{$1} = "\%\{$1\}";
1.499 + } else {
1.500 + delete($var{$1});
1.501 + }
1.502 + }
1.503 + elsif ($v =~ /^\#(?:provides)\s*(\S+)\s*(.*?)\s*$/) {
1.504 + # store option for current condition
1.505 + if (exists($attr{'Name'}->{''})) {
1.506 + push(@{$attr{'Provides'}->{$cond}}, {
1.507 + resource => $attr{'Name'}->{''}->[0] . '::' . $1,
1.508 + attrname => 'equ',
1.509 + attrval => optesc($2)
1.510 + });
1.511 + } else {
1.512 + warn "openpkg:index:ERROR: no package name set for option \"$1 = $2\"";
1.513 + }
1.514 + }
1.515 + elsif ($v =~ /^\#NoSource\s*(.*?)\s*$/) {
1.516 + # store conditional NoSource attribute
1.517 + push(@{$attr{'NoSource'}->{$cond}}, commasep('NoSource', $1));
1.518 +
1.519 + }
1.520 + elsif ($v =~ /^\s*([^\#]\S*)\s*:\s*(.*?)\s*$/) {
1.521 + # store "attribute: value" headers for current condition
1.522 + push(@{$attr{$1}->{$cond}}, commasep($1,$2));
1.523 + $avar{lc($1)} = $2 if ($cond eq '');
1.524 + }
1.525 + }
1.526 +
1.527 + # return all header "attributes"
1.528 + return \%attr;
1.529 +}
1.530 +
1.531 +# split spec file into sections starting with a %word
1.532 +# - concatenate extended lines
1.533 +# - strip comment lines
1.534 +# - map %command to #command
1.535 +# - split sections
1.536 +# - return package2data() from default section (before first %xxx section)
1.537 +sub spec2data ($) {
1.538 + my ($s) = @_;
1.539 + my (%map);
1.540 + my ($a, $o);
1.541 + my $spec = $s;
1.542 +
1.543 + # remove comments
1.544 + $s =~ s/^\s*#.*?\n//mg;
1.545 +
1.546 + # map commands
1.547 + $s =~ s/^%(ifdef|ifndef|if|NoSource|option|undefine|define|else|endif|\{)/#$1/mg;
1.548 +
1.549 + # split sections
1.550 + foreach (split(m/^(?=%\w+\s*\n)/m, $s)) {
1.551 + if (m/^%(\w+)\s*\n/) {
1.552 + $map{$1} .= $';
1.553 + } else {
1.554 + $map{'*'} .= $_;
1.555 + }
1.556 + }
1.557 +
1.558 + # translate package information into "data"
1.559 + if (exists($map{'description'})) {
1.560 + # backward compatibility (options are in description)
1.561 + $o = find_options($map{'description'});
1.562 + $a = package2data($map{'*'}, $o );
1.563 + $a->{'Description'} = { '' => [ $map{'description'} ] };
1.564 + } else {
1.565 + # standard case
1.566 + $a = package2data($map{'*'}, {});
1.567 + }
1.568 + return $a;
1.569 +}
1.570 +
1.571 +#############################################################################
1.572 +##
1.573 +## XML/RDF Generation
1.574 +##
1.575 +#############################################################################
1.576 +
1.577 +# start of XML file
1.578 +sub xml_head ($$) {
1.579 + my ($fh, $res) = @_;
1.580 + print $fh <<EOFEOF;
1.581 +<?xml version="1.0" encoding="iso-8859-1"?>
1.582 +<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#"
1.583 + xmlns="http://www.openpkg.org/xml-rdf-index/0.9">
1.584 + <Repository rdf:resource="$res">
1.585 +EOFEOF
1.586 +}
1.587 +
1.588 +# end of XML file, corresponds with start tags
1.589 +sub xml_foot ($) {
1.590 + my($fh) = @_;
1.591 + print $fh <<EOFEOF;
1.592 + </Repository>
1.593 +</rdf:RDF>
1.594 +EOFEOF
1.595 +}
1.596 +
1.597 +# conditional expansion of attribute
1.598 +sub n ($$) {
1.599 + my ($a, $k) = @_;
1.600 + return if (not $a->{$k});
1.601 + return if (not $a->{$k}->{''});
1.602 + return ($a->{$k}->{''}->[0]);
1.603 +}
1.604 +
1.605 +# send out $a->{$k} as text-style tag
1.606 +sub xml_text ($$$;$) {
1.607 + my ($i, $a, $k, $tag) = @_;
1.608 + my ($out);
1.609 + return "" if (not exists($a->{$k}));
1.610 + $tag = $k if (not defined($tag));
1.611 + $i = ' ' x $i;
1.612 + $out = e(n($a, $k));
1.613 + return if $out eq '';
1.614 + return "$i<$tag>\n$out\n$i</$tag>\n";
1.615 +}
1.616 +
1.617 +# send out @{$a->{$k}} as body of an XML tag
1.618 +# $k is the name of the tag unless overridden by $tag
1.619 +# $i denotes the depth of indentation to form nicely
1.620 +# looking files.
1.621 +# all data from the list is flattened into a single
1.622 +# body, separated by LF and escaped for XML metachars.
1.623 +sub xml_tag ($$$;$) {
1.624 + my ($i, $a, $k, $tag) = @_;
1.625 + my ($out, $cond, $upn);
1.626 + return "" if (not exists($a->{$k}));
1.627 + $tag = $k if (not defined($tag));
1.628 + $out = '';
1.629 + $i = ' ' x $i;
1.630 + foreach $cond (sort keys(%{$a->{$k}})) {
1.631 + $upn = e(upn($cond));
1.632 + $out .= $i .
1.633 + ($cond ne '' ? "<$tag cond=\"$upn\">" : "<$tag>") .
1.634 + join("\n", map { e($_) } @{$a->{$k}->{$cond}}) .
1.635 + "</$tag>\n";
1.636 + }
1.637 + return $out;
1.638 +}
1.639 +
1.640 +# send out @{$a->{$k}} as a rdf:bag
1.641 +# $k is the name of the outer tag unless overriden by $tag
1.642 +# $i denotes the depth of indentation, inner tags are indented
1.643 +# 2 or 4 more character positions.
1.644 +# each element of the bag is listed
1.645 +sub xml_bag ($$$;$) {
1.646 + my ($i, $a, $k, $tag) = @_;
1.647 + my ($out, $cond, $upn);
1.648 + return "" if (not exists($a->{$k}));
1.649 + $tag = $k if (not defined($tag));
1.650 + $out = '';
1.651 + $i = ' ' x $i;
1.652 + foreach $cond (sort keys %{$a->{$k}}) {
1.653 + next if (not @{$a->{$k}->{$cond}});
1.654 + $upn = e(upn($cond));
1.655 + $out .= $i .
1.656 + ($cond ne '' ? "<$tag cond=\"$upn\">\n" : "<$tag>\n") .
1.657 + "$i <rdf:bag>\n" .
1.658 + join("",
1.659 + map {
1.660 + ref $_
1.661 + ? "$i <resource".
1.662 + ( exists $_->{attrname}
1.663 + ? " $_->{attrname}=\"".e($_->{attrval})."\""
1.664 + : ""
1.665 + ) .
1.666 + ">".e($_->{resource})."</resource>\n"
1.667 + : "$i <rdf:li>".e($_)."</rdf:li>\n"
1.668 + }
1.669 + @{$a->{$k}->{$cond}}) .
1.670 + "$i </rdf:bag>\n" .
1.671 + "$i</$tag>\n";
1.672 + }
1.673 + return $out;
1.674 +}
1.675 +
1.676 +# send out reference to another RDF
1.677 +sub xml_reference ($$$$$$) {
1.678 + my($fh, $res, $href, $S, $T, $D) = @_;
1.679 + print $fh " <Repository rdf:resource=\"$res\" href=\"$href\"";
1.680 + if ($opt_S && defined($S) && $S ne "") {
1.681 + print $fh " size=\"$S\"";
1.682 + }
1.683 + if ($opt_T && defined($T) && $T ne "") {
1.684 + print $fh " mtime=\"$T\"";
1.685 + }
1.686 + if ($opt_D && defined($D) && $D ne "") {
1.687 + print $fh " md5=\"$D\"";
1.688 + }
1.689 + print $fh "/>\n";
1.690 +}
1.691 +
1.692 +# send out reference to other resources
1.693 +sub xml_other ($$$$$$) {
1.694 + my($fh, $about, $href, $S, $T, $D) = @_;
1.695 + print $fh " <rdf:Description about=\"$about\" href=\"$href\"";
1.696 + if ($opt_S && defined($S) && $S ne "") {
1.697 + print $fh " size=\"$S\"";
1.698 + }
1.699 + if ($opt_T && defined($T) && $T ne "") {
1.700 + print $fh " mtime=\"$T\"";
1.701 + }
1.702 + if ($opt_D && defined($D) && $D ne "") {
1.703 + print $fh " md5=\"$D\"";
1.704 + }
1.705 + print $fh ">\n";
1.706 + print $fh " </rdf:Description>\n";
1.707 +}
1.708 +
1.709 +# translate attributes from %$a as generated by package2data
1.710 +# into XML and write to file $fh
1.711 +sub xml_record ($$$$$$) {
1.712 + my ($fh, $a, $href, $S, $T, $D) = @_;
1.713 + my ($maj, $min, $rel, $about);
1.714 +
1.715 + $about =
1.716 + n($a, 'Name') . '-' .
1.717 + n($a, 'Version') . '-' .
1.718 + n($a, 'Release');
1.719 + if (not defined($href)) {
1.720 + # guess location from Information in Specfile
1.721 + if (exists($a->{'NoSource'})) {
1.722 + $href = "$about.nosrc.rpm";
1.723 + } else {
1.724 + $href = "$about.src.rpm";
1.725 + }
1.726 + ($maj, $min, $rel) = (n($a, 'Release') =~ m/^(\d+)\.(\d+)\.(\d+)/);
1.727 + if (defined($min)) {
1.728 + if ($maj > 1 || ($maj == 1 && $min > 0)) {
1.729 + # OpenPKG-1.1-RELEASE or later
1.730 + if (n($a, 'Distribution') =~ /\[PLUS\]/) {
1.731 + $href = 'PLUS/'.$href;
1.732 + }
1.733 + }
1.734 + if ($maj > 1 || ($maj == 1 && $min >= 0)) {
1.735 + # OpenPKG-1.0-RELEASE or later
1.736 + if ($rel > 0) {
1.737 + $href = 'UPD/'.$href;
1.738 + }
1.739 + }
1.740 + } else {
1.741 + # OpenPKG-CURRENT
1.742 + }
1.743 + }
1.744 +
1.745 + print $fh " <rdf:Description about=\"$about\" href=\"$href\"";
1.746 + if ($opt_S && defined($S) && $S ne "") {
1.747 + print $fh " size=\"$S\"";
1.748 + }
1.749 + if ($opt_T && defined($T) && $T ne "") {
1.750 + print $fh " mtime=\"$T\"";
1.751 + }
1.752 + if ($opt_D && defined($D) && $D ne "") {
1.753 + print $fh " md5=\"$D\"";
1.754 + }
1.755 + print $fh ">\n";
1.756 +
1.757 + # fake Source attribute from Source\d attribtutes
1.758 + # XXX only default conditional
1.759 + $a->{'Source'} = { '' => [
1.760 + map {
1.761 + s/\Q%{name}\E/n($a, 'Name')/esg;
1.762 + s/\Q%{version}\E/n($a, 'Version')/esg;
1.763 + s/\Q%{release}\E/n($a, 'Release')/esg;
1.764 + $_;
1.765 + }
1.766 + map {
1.767 + $a->{$_}->{''} ? @{$a->{$_}->{''}} : ()
1.768 + }
1.769 + sort {
1.770 + my ($x) = ($a =~ /^(\d*)$/);
1.771 + my ($y) = ($b =~ /^(\d*)$/);
1.772 + return $x <=> $y;
1.773 + }
1.774 + grep {
1.775 + /^Source\d*$/
1.776 + } keys(%$a)
1.777 + ]};
1.778 + delete($a->{'Source'}) if (not @{$a->{'Source'}->{''}});
1.779 +
1.780 + print $fh
1.781 + xml_tag(6, $a, 'Name'),
1.782 + xml_tag(6, $a, 'Version'),
1.783 + xml_tag(6, $a, 'Release'),
1.784 + xml_tag(6, $a, 'Distribution'),
1.785 + xml_tag(6, $a, 'Class'),
1.786 + xml_tag(6, $a, 'Group'),
1.787 + xml_tag(6, $a, 'License'),
1.788 + xml_tag(6, $a, 'Packager'),
1.789 + xml_tag(6, $a, 'Summary'),
1.790 + xml_tag(6, $a, 'URL'),
1.791 + xml_tag(6, $a, 'Vendor'),
1.792 + xml_tag(6, $a, 'SourceRPM'),
1.793 + xml_tag(6, $a, 'Arch'),
1.794 + xml_tag(6, $a, 'Os'),
1.795 + xml_tag(6, $a, 'BuildHost'),
1.796 + xml_tag(6, $a, 'BuildSystem'),
1.797 + xml_tag(6, $a, 'BuildTime'),
1.798 + xml_tag(6, $a, 'Relocations'),
1.799 + xml_tag(6, $a, 'Size'),
1.800 + xml_tag(6, $a, 'Prefixes'),
1.801 + xml_tag(6, $a, 'Platform'),
1.802 + xml_tag(6, $a, 'SigSize'),
1.803 + xml_tag(6, $a, 'SigMD5'),
1.804 + xml_tag(6, $a, 'SigPGP'),
1.805 + xml_tag(6, $a, 'SigGPG'),
1.806 + xml_bag(6, $a, 'BuildPreReq'),
1.807 + xml_bag(6, $a, 'PreReq'),
1.808 + xml_bag(6, $a, 'Provides'),
1.809 + xml_bag(6, $a, 'Conflicts'),
1.810 + xml_bag(6, $a, 'Source'),
1.811 + xml_bag(6, $a, 'NoSource'),
1.812 + xml_bag(6, $a, 'Filenames'),
1.813 + xml_text(6, $a, 'Description');
1.814 +
1.815 + print $fh " </rdf:Description>\n";
1.816 +}
1.817 +
1.818 +#############################################################################
1.819 +##
1.820 +## OpenPKG RPM Package Payload Extraction
1.821 +##
1.822 +#############################################################################
1.823 +
1.824 +# extract foo.spec from foo-V-R.src.rpm file
1.825 +sub rpm2spec ($) {
1.826 + my ($fn) = @_;
1.827 + local($SIG{'PIPE'}) = 'IGNORE';
1.828 + local(*PIPE);
1.829 + open(PIPE, "$R2C '$fn' |")
1.830 + or die "openpkg:index:FATAL: cannot read '$fn' ($!)\n";
1.831 + my ($buf, @hdr, $n, $m, $name, $step);
1.832 + my ($spec);
1.833 + while (read(PIPE, $buf, 110) == 110) {
1.834 + @hdr = unpack('a6a8a8a8a8a8a8a8a8a8a8a8a8a8', $buf);
1.835 + $n = hex($hdr[12]); # filename length
1.836 + $m = int(($n+5)/4)*4-2; # filename size (padded)
1.837 + last if (not (read(PIPE,$buf,$m) == $m));
1.838 + $name = substr($buf, 0, $n-1);
1.839 + $n = hex($hdr[7]); # file length
1.840 + $m = int(($n+3)/4)*4; # file size (padded)
1.841 + if ($name !~ m/.spec$/) {
1.842 + while ($m > 0) {
1.843 + $step = $m > 8192 ? 8192 : $m;
1.844 + last if (not read(PIPE,$buf,$step));
1.845 + $m -= length($buf);
1.846 + }
1.847 + } else {
1.848 + if (read(PIPE,$buf,$n) == $n) {
1.849 + $spec = $buf;
1.850 + }
1.851 + last;
1.852 + }
1.853 + }
1.854 + close(PIPE);
1.855 + return $spec;
1.856 +}
1.857 +
1.858 +#############################################################################
1.859 +##
1.860 +## OpenPKG RPM Package Header Extraction
1.861 +##
1.862 +#############################################################################
1.863 +
1.864 +# extract header information from foo-V-R.src.rpm
1.865 +sub rpm2data ($$) {
1.866 + my ($fn, $platform) = @_;
1.867 + my ($q, %a);
1.868 + my ($t, $v);
1.869 + local(*PIPE);
1.870 +
1.871 + if (not defined($platform)) {
1.872 + die "openpkg:index:FATAL: indexing binary package '$fn' requires -p option\n";
1.873 + }
1.874 +
1.875 + $q = <<EOFEOF;
1.876 +Name %{Name}
1.877 +Version %{Version}
1.878 +Release %{Release}
1.879 +URL %{URL}
1.880 +Summary %{Summary}
1.881 +Copyright %{Copyright}
1.882 +License %{License}
1.883 +Distribution %{Distribution}
1.884 +Vendor %{Vendor}
1.885 +Class %{Class}
1.886 +Group %{Group}
1.887 +Packager %{Packager}
1.888 +Prefixes %{Prefixes}
1.889 +BuildHost %{BuildHost}
1.890 +BuildTime %{BuildTime}
1.891 +Arch %{Arch}
1.892 +Os %{Os}
1.893 +Size %{Size}
1.894 +SigSize %{SigSize}
1.895 +SigMD5 %{SigMD5}
1.896 +SigPGP %{SigPGP}
1.897 +SigGPG %{SigGPG}
1.898 +SourceRPM %{SourceRPM}
1.899 +[Patch %{Patch}
1.900 +]
1.901 +[Source %{Source}
1.902 +]
1.903 +[Filenames %{Filenames}
1.904 +]
1.905 +[Conflicts %{CONFLICTNAME} %|CONFLICTFLAGS?{%{CONFLICTFLAGS:depflags} %{CONFLICTVERSION}}:{}|
1.906 +]
1.907 +[PreReq %{REQUIRENAME} %|REQUIREFLAGS?{%{REQUIREFLAGS:depflags} %{REQUIREVERSION}}:{}|
1.908 +]
1.909 +[Provides %{PROVIDENAME} %|PROVIDEFLAGS?{%{PROVIDEFLAGS:depflags} %{PROVIDEVERSION}}:{}|
1.910 +]
1.911 +Description %{Description}
1.912 +EOFEOF
1.913 +
1.914 + open(PIPE, "$RPM -qp --qf '$q' '$fn' |")
1.915 + or die "FATAL: cannot read '$fn' ($!)\n";
1.916 + while (<PIPE>) {
1.917 + if (/^(\S+)\s+(.*?)\s*$/) {
1.918 + $t = $1;
1.919 + $v = $2;
1.920 + } elsif (/^(\s+.+?)\s*$/) {
1.921 + next if (not defined($t));
1.922 + $v = $1;
1.923 + } else {
1.924 + $t = undef;
1.925 + next;
1.926 + }
1.927 + if (exists($a{$t})) {
1.928 + $a{$t} .= "\n$v";
1.929 + } else {
1.930 + $a{$t} = $v;
1.931 + }
1.932 + }
1.933 + close(PIPE);
1.934 +
1.935 + %a = map { $_ => $a{$_} }
1.936 + grep { $a{$_} ne '(none)' }
1.937 + keys(%a);
1.938 + if ($a{'Relocations'} eq '(non relocatable)') {
1.939 + delete($a{'Relocations'});
1.940 + }
1.941 + if ($a{'SigMD5'} eq '(unknown type)') {
1.942 + delete($a{'SigMD5'});
1.943 + }
1.944 + if (defined($platform)) {
1.945 + $a{'Platform'} = $platform;
1.946 + }
1.947 + $a{'Description'} = [ $a{'Description'} ];
1.948 +
1.949 + foreach ('Conflicts', 'PreReq', 'Provides') {
1.950 + $a{$_} = [
1.951 + map { &$make_resource($_) }
1.952 + grep { !/^rpmlib\(/ }
1.953 + split(/\n+/, $a{$_})
1.954 + ];
1.955 + }
1.956 +
1.957 + return { map {
1.958 + $_ => { '' => (ref $a{$_} ? $a{$_} : [ split(/\n+/, $a{$_}) ]) }
1.959 + } keys(%a) };
1.960 +}
1.961 +
1.962 +#############################################################################
1.963 +##
1.964 +## OpenPKG XML/RDF Index Locating
1.965 +##
1.966 +#############################################################################
1.967 +
1.968 +# detect index files
1.969 +sub getindex ($) {
1.970 + my ($dir) = @_;
1.971 + my (@idx) =
1.972 + sort { -M $a <=> -M $b; }
1.973 + grep { -f $_ }
1.974 + ( <$dir/00INDEX.rdf>, <$dir/00INDEX.rdf.*> );
1.975 + return if (not @idx);
1.976 + return $idx[0];
1.977 +}
1.978 +
1.979 +# list RPM directories of unpacked .spec files
1.980 +sub list_specdir ($) {
1.981 + my ($dir) = @_;
1.982 + my ($d, $path);
1.983 + my (@list);
1.984 +
1.985 + local(*DH);
1.986 + opendir(DH, $dir);
1.987 + while ($d = readdir(DH)) {
1.988 + next if ($d =~ m/^\./);
1.989 + $path = "$dir/$d/$d.spec";
1.990 + push(@list, $path) if (-f $path);
1.991 + }
1.992 + closedir(DH);
1.993 + return \@list;
1.994 +}
1.995 +
1.996 +# list index or RPM file directories
1.997 +sub list_rpmdir ($) {
1.998 + my ($dir) = @_;
1.999 + my ($d, $path);
1.1000 + my (@list, $idx, $sub);
1.1001 +
1.1002 + local(*DH);
1.1003 + opendir(DH, $dir);
1.1004 + while ($d = readdir(DH)) {
1.1005 + next if ($d =~ m/^\./);
1.1006 + $path = "$dir/$d";
1.1007 + if (-d $path) {
1.1008 + $idx = getindex($path);
1.1009 + if (defined($idx)) {
1.1010 + push(@list, $idx);
1.1011 + } else {
1.1012 + $sub = list_rpmdir($path);
1.1013 + push(@list, @$sub);
1.1014 + undef $sub;
1.1015 + }
1.1016 + } else {
1.1017 + next if (not ($d =~ m/\.(?:rpm|sh)$/ && -f $path));
1.1018 + push(@list, $path);
1.1019 + }
1.1020 + }
1.1021 + closedir(DH);
1.1022 + return \@list;
1.1023 +}
1.1024 +
1.1025 +#############################################################################
1.1026 +##
1.1027 +## OpenPKG XML/RDF Index Reading
1.1028 +##
1.1029 +#############################################################################
1.1030 +
1.1031 +# fetch a whole file
1.1032 +sub readfile ($) {
1.1033 + my ($fn) = @_;
1.1034 + local(*FH);
1.1035 + open(FH, "< $fn")
1.1036 + or die "FATAL: cannot read '$fn' ($!)\n";
1.1037 + my $l; { local $/; $l = <FH>; }
1.1038 + close(FH);
1.1039 + return $l;
1.1040 +}
1.1041 +
1.1042 +# create relative path by stripping instance prefix
1.1043 +sub relpath ($$) {
1.1044 + my ($prefix, $path) = @_;
1.1045 + $path =~ s/^\Q$prefix\E\///s;
1.1046 + return $path;
1.1047 +}
1.1048 +
1.1049 +# create directory path with trailing slash
1.1050 +sub dirname ($) {
1.1051 + my ($path) = @_;
1.1052 + $path =~ s/\/[^\/]*$//s;
1.1053 + return $path.'/';
1.1054 +}
1.1055 +
1.1056 +# peek at resource identifier of index file
1.1057 +sub getresource ($) {
1.1058 + my ($fn) = @_;
1.1059 + my ($fh, $buf);
1.1060 +
1.1061 + local(*FH);
1.1062 + if ($fn =~ /\.bz2$/) {
1.1063 + open(FH, "$BZ -dc $fn |")
1.1064 + or die "FATAL: cannot read '$fn' ($!)\n";
1.1065 + } else {
1.1066 + open(FH, "< $fn")
1.1067 + or die "FATAL: cannot read '$fn' ($!)\n";
1.1068 + }
1.1069 + read(FH, $buf, 1024);
1.1070 + close(FH);
1.1071 + if ($buf =~ /<Repository.*?rdf:resource="([^"]+)"/) {
1.1072 + return $1;
1.1073 + }
1.1074 + return undef;
1.1075 +}
1.1076 +
1.1077 +#############################################################################
1.1078 +##
1.1079 +## OpenPKG XML/RDF Index Output Generation
1.1080 +##
1.1081 +#############################################################################
1.1082 +
1.1083 +sub sizetime ($) {
1.1084 + my ($file) = @_;
1.1085 + my @stat = stat($file);
1.1086 + return ($stat[7], $stat[9]);
1.1087 +}
1.1088 +
1.1089 +sub digest ($) {
1.1090 + my ($file) = @_;
1.1091 + my $digest = "";
1.1092 + my $output = `($OPENSSL md5 -hex "$file") 2>/dev/null || true`;
1.1093 + if ($output =~ m/MD5\(.+?\)=\s*([0-9a-fA-F]+)/s) {
1.1094 + $digest = uc($1);
1.1095 + }
1.1096 + return $digest;
1.1097 +}
1.1098 +
1.1099 +sub write_index ($$$$$$) {
1.1100 + my ($fh, $prefix, $resource, $platform, $list, $cache) = @_;
1.1101 + my ($a, $h, $r, $spec, $T, $D);
1.1102 +
1.1103 + foreach (@$list) {
1.1104 + $a = undef;
1.1105 + $h = undef;
1.1106 + $r = undef;
1.1107 + $S = undef;
1.1108 + $T = undef;
1.1109 + $D = undef;
1.1110 + $o = undef;
1.1111 +
1.1112 + # determine information
1.1113 + if (m/\.spec$/) {
1.1114 + $spec = readfile($_);
1.1115 + $a = spec2data($spec);
1.1116 + ($S, $T) = sizetime($_) if ($opt_S or $opt_T);
1.1117 + $D = digest($_) if ($opt_D);
1.1118 + } elsif (m/([^\/]+\.(?:no)?src\.rpm)$/) {
1.1119 + $h = relpath($prefix, $_);
1.1120 + ($S, $T) = sizetime($_) if ($opt_S or $opt_T or $cache);
1.1121 + if ($cache) {
1.1122 + if ( exists($cache->{"T$_"})
1.1123 + && $cache->{"T$_"} == $T
1.1124 + && exists($cache->{"s$_"})
1.1125 + && $cache->{"s$_"} ne ""
1.1126 + && (!$opt_S || ($opt_S && exists($cache->{"S$_"}) && $cache->{"S$_"} ne ""))
1.1127 + && (!$opt_D || ($opt_D && exists($cache->{"D$_"}) && $cache->{"D$_"} ne ""))) {
1.1128 + # found in cache
1.1129 + $spec = $cache->{"s$_"};
1.1130 + $S = $cache->{"S$_"} if ($opt_S);
1.1131 + $D = $cache->{"D$_"} if ($opt_D);
1.1132 + } else {
1.1133 + # not found in cache
1.1134 + $spec = rpm2spec($_);
1.1135 + $cache->{"s$_"} = $spec;
1.1136 + $cache->{"S$_"} = $S;
1.1137 + $cache->{"T$_"} = $T;
1.1138 + $D = digest($_) if ($opt_D);
1.1139 + $cache->{"D$_"} = $D if ($opt_D);
1.1140 + }
1.1141 + } else {
1.1142 + # no cache at all
1.1143 + $spec = rpm2spec($_);
1.1144 + $D = digest($_) if ($opt_D);
1.1145 + }
1.1146 + $a = spec2data($spec);
1.1147 + } elsif (m/([^\/]+\.rpm)$/) {
1.1148 + $h = relpath($prefix, $_);
1.1149 + $a = rpm2data($_, $platform);
1.1150 + ($S, $T) = sizetime($_) if ($opt_S or $opt_T);
1.1151 + $D = digest($_) if ($opt_D);
1.1152 + } elsif (m/(([^\/]+)\.(?:no)?src\.sh)$/) {
1.1153 + $h = relpath($prefix, $_);
1.1154 + ($S, $T) = sizetime($_) if ($opt_S or $opt_T);
1.1155 + $D = digest($_) if ($opt_D);
1.1156 + $o = "$2:bootstrap";
1.1157 + } elsif (m/([^\/]+\.rdf[^\/]*)$/) {
1.1158 + $h = relpath($prefix, $_);
1.1159 + $r = getresource($_) || $resource.dirname($h);
1.1160 + ($S, $T) = sizetime($_) if ($opt_S or $opt_T);
1.1161 + $D = digest($_) if ($opt_D);
1.1162 + }
1.1163 +
1.1164 + # process information
1.1165 + if ($a) {
1.1166 + xml_record($fh, $a, $h, $S, $T, $D);
1.1167 + } elsif ($o) {
1.1168 + xml_other($fh, $o, $h, $S, $T, $D);
1.1169 + } elsif ($r) {
1.1170 + xml_reference($fh, $r, $h, $S, $T, $D);
1.1171 + } else {
1.1172 + warn "openpkg:index:ERROR: cannot process $_";
1.1173 + }
1.1174 + }
1.1175 +}
1.1176 +
