head 1.23;
access;
symbols
OPENPKG_E1_MP_HEAD:1.23
OPENPKG_E1_MP:1.23
OPENPKG_1_3_RELEASE:1.11.2.6
OPENPKG_1_3_SOLID:1.11.2.6.0.2
OPENPKG_1_3_SOLID_BP:1.11.2.6
OPENPKG_1_STABLE_MP:1.19
OPENPKG_1_2_RELEASE:1.11.4.1
OPENPKG_1_2_SOLID:1.11.0.4
OPENPKG_1_2_SOLID_BP:1.11
OPENPKG_1_STABLE:1.11.0.2
OPENPKG_1_STABLE_BP:1.11;
locks; strict;
comment @# @;
1.23
date 2004.04.05.19.47.40; author rse; state dead;
branches;
next 1.22;
1.22
date 2004.02.17.13.22.54; author rse; state Exp;
branches;
next 1.21;
1.21
date 2003.09.02.08.17.20; author mlelstv; state Exp;
branches;
next 1.20;
1.20
date 2003.08.16.16.30.49; author mlelstv; state Exp;
branches;
next 1.19;
1.19
date 2003.07.28.17.17.11; author rse; state Exp;
branches;
next 1.18;
1.18
date 2003.07.15.10.08.31; author rse; state Exp;
branches;
next 1.17;
1.17
date 2003.06.03.16.11.04; author mlelstv; state Exp;
branches;
next 1.16;
1.16
date 2003.02.28.14.22.09; author mlelstv; state Exp;
branches;
next 1.15;
1.15
date 2003.02.12.10.10.23; author mlelstv; state Exp;
branches;
next 1.14;
1.14
date 2003.02.06.06.52.50; author mlelstv; state Exp;
branches;
next 1.13;
1.13
date 2003.02.06.00.34.06; author mlelstv; state Exp;
branches;
next 1.12;
1.12
date 2003.01.21.13.25.06; author mlelstv; state Exp;
branches;
next 1.11;
1.11
date 2003.01.14.12.00.55; author mlelstv; state Exp;
branches
1.11.2.1
1.11.4.1;
next 1.10;
1.10
date 2003.01.13.13.25.55; author mlelstv; state Exp;
branches;
next 1.9;
1.9
date 2003.01.09.14.23.17; author mlelstv; state Exp;
branches;
next 1.8;
1.8
date 2003.01.08.15.12.38; author mlelstv; state Exp;
branches;
next 1.7;
1.7
date 2003.01.03.13.47.40; author mlelstv; state Exp;
branches;
next 1.6;
1.6
date 2002.12.31.15.12.39; author mlelstv; state Exp;
branches;
next 1.5;
1.5
date 2002.12.30.22.21.39; author rse; state Exp;
branches;
next 1.4;
1.4
date 2002.12.30.22.05.36; author rse; state Exp;
branches;
next 1.3;
1.3
date 2002.12.30.21.33.49; author rse; state Exp;
branches;
next 1.2;
1.2
date 2002.11.27.07.45.36; author rse; state Exp;
branches;
next 1.1;
1.1
date 2002.11.26.19.54.11; author rse; state Exp;
branches;
next ;
1.11.2.1
date 2003.01.21.14.00.27; author rse; state Exp;
branches;
next 1.11.2.2;
1.11.2.2
date 2003.02.16.09.20.17; author rse; state Exp;
branches;
next 1.11.2.3;
1.11.2.3
date 2003.03.19.10.46.14; author rse; state Exp;
branches;
next 1.11.2.4;
1.11.2.4
date 2003.06.11.14.47.42; author rse; state Exp;
branches;
next 1.11.2.5;
1.11.2.5
date 2003.07.24.20.50.14; author rse; state Exp;
branches;
next 1.11.2.6;
1.11.2.6
date 2003.07.29.10.11.43; author rse; state Exp;
branches;
next ;
1.11.4.1
date 2003.01.21.14.01.09; author rse; state Exp;
branches;
next 1.11.4.2;
1.11.4.2
date 2003.02.16.09.21.26; author rse; state Exp;
branches;
next 1.11.4.3;
1.11.4.3
date 2003.03.19.10.47.09; author rse; state Exp;
branches;
next 1.11.4.4;
1.11.4.4
date 2003.06.11.14.48.41; author rse; state Exp;
branches;
next ;
desc
@@
1.23
log
@remove old openpkg-tool package now that its content is part of openpkg-tools
@
text
@##
## openpkg-index.pl -- OpenPKG Maintenance Tool (backend for indexing)
## Copyright (c) 2000-2003 The OpenPKG Project
## Copyright (c) 2000-2003 Ralf S. Engelschall
## Copyright (c) 2000-2003 Cable & Wireless
##
## Permission to use, copy, modify, and distribute this software for
## any purpose with or without fee is hereby granted, provided that
## the above copyright notice and this permission notice appear in all
## copies.
##
## THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESSED OR IMPLIED
## WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
## MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
## IN NO EVENT SHALL THE AUTHORS AND COPYRIGHT HOLDERS AND THEIR
## CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
## SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
## LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
## USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
## ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
## OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
## OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
## SUCH DAMAGE.
##
require 5;
use strict;
use Getopt::Std;
getopts('r:p:C:o:ci');
use vars qw/$opt_r $opt_p $opt_C $opt_o $opt_c $opt_i/;
use FileHandle;
use DirHandle;
my $l_prefix = '@@l_prefix@@';
my $RPM = ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/rpm") ?
"$l_prefix/bin/openpkg rpm" : "$l_prefix/bin/rpm");
my $R2C = ((-f "$l_prefix/bin/openpkg" && -f "$l_prefix/libexec/rpm2cpio") ?
"$l_prefix/bin/openpkg rpm2cpio" : "$l_prefix/bin/rpm2cpio");
my $BZ = "$l_prefix/lib/openpkg/bzip2 -9";
#########################################################################
#
# escape XML special characters for output in RDF file
#
# remove trailing whitespace
# remove common leading whitespace
#
sub e ($) {
my($s) = @@_;
my($i);
$s =~ s/\n+$//sg;
$s =~ s/[^\S\n]+$//mg;
$i = undef;
while ($s =~ /^([^\S\n]+)/mg) {
$i = $1 if !defined $i || length($1) < length($i);
}
$s =~ s/^\Q$i\E//mg if defined $i;
$s =~ s/&/&/sg;
$s =~ s/</sg;
$s =~ s/>/>/sg;
return $s;
}
my %attrname = (
'==' => 'equ',
'=' => 'equ',
'>=' => 'geq',
'=>' => 'geq',
'<=' => 'leq',
'=<' => 'leq',
'>' => 'gt',
'<' => 'lt'
);
my($opreg) = join '|',
map {
"\Q$_\E"
} sort {
length($b) <=> length($a) ||
$b cmp $a
} keys %attrname;
sub make_resource ($) {
my($s) = @@_;
if ($s =~ /(\S+)\s*($opreg)\s*(.*?)\s*$/o) {
return {
resource => $1,
attrname => $attrname{$2},
attrval => $3
}
}
return {
resource => $s
}
}
sub commasep ($$) {
my($k,$v) = @@_;
if ($k =~ /^(NoSource)$/) {
return split(/\s*,\s*/, $v);
} elsif ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts)$/) {
return map { make_resource($_) }
split(/\s*,\s*/, $v);
}
return $v;
}
sub optesc ($) {
my($s) = @@_;
$s =~ s/([\x00-\x1f\x80-\xbf\s\%])/sprintf("%%%02x",ord($1))/eg;
return $s;
}
sub vsub ($$) {
my($var,$v) = @@_;
$v =~ s/\%\{([^}]+)\}/
exists $var->{$1} ? $var->{$1} : '%{'.$1.'}'/emg;
return $v;
}
sub upn ($) {
my($t) = @@_;
my(@@tok) = $t =~ /(\(|\)|\&\&|\|\||\!|\S+)/g;
my(@@out,$op,$o);
my(@@save);
$op = [];
foreach (@@tok) {
if ($_ eq '(') {
push @@save, $op;
$op = [];
} elsif ($_ eq ')') {
die "FATAL: unresolved operators in: @@tok\n" if @@$op;
$op = pop @@save
or die "FATAL: parenthesis stack underflow in: @@tok\n";
while ($o = pop @@$op) {
push @@out, $o->[0];
last if $o->[1];
}
} elsif ($_ eq '&&') {
push @@$op, [ '+', 1 ] ;
} elsif ($_ eq '||') {
push @@$op, [ '|', 1 ] ;
} elsif ($_ eq '!') {
push @@$op, [ '!', 0 ];
} elsif (/^\%\{(\S*?)\}$/) {
push @@out, $1;
while ($o = pop @@$op) {
push @@out, $o->[0];
last if $o->[1]; # binop
}
}
}
return join (' ',@@out);
}
#
# deduce external variables from description
#
# before openpkg-20021230
#
sub find_options ($) {
my($descr) = @@_;
my $evar = {};
$descr =~ s/--define\s*'(\S+)\s*\%\{\1\}'/$evar->{$1} = '%{'.$1.'}', ''/sge;
return $evar;
}
#
# translate default section from spec-file
# into a hash
# %if/%ifdef/%define... are translated to #if/#ifdef/#define
#
# #defines are interpolated (correct ?)
#
# #if/#ifdef/... sections are stripped
# result is the same as if all conditions evaluate false (!)
#
# all attributes are of the form key: value
# repeated attributes are coalesced into a list
#
sub package2data ($$) {
my($s,$ovar) = @@_;
my(%evar,%var);
my(@@term, $term);
my(%attr,%avar);
my($l, $v, $cond, $d, $p);
my($re,@@defs);
# combine multilines
$s =~ s/\\\n/ /sg;
#
# map conditional variable macros
#
$s =~ s/^#\{\!\?([^:]*):\s*%(.*?)\s*\}\s*$/#ifndef $1\n#$2\n#endif/mg;
$s =~ s/^#\{\!\?([^:]*):\s*(.*?)\s*\}\s*$/#ifndef $1\n$2\n#endif/mg;
#
# map option macro
#
$s =~ s/^#option\s+(\S+)\s*(.*?)\s*$/#ifndef $1\n#define $1 $2\n#endif\n#provides $1 $2/mg;
#
# use option variables for interpolation
#
%evar = %$ovar;
#
# guess more external parameters by scanning for "default" sections.
#
$re = '^\#ifndef\s+[\w\_]+\s*\n((?:\#define\s+[\w\_]+\s.*\n)+)\#endif\n';
@@defs = $s =~ /$re/gm;
foreach (@@defs) {
while (/^\#define\s+([\w\_]+)\s(.*?)\s*$/mg) {
$ovar->{$1} = $2;
$evar{$1} = '%{'.$1.'}';
}
}
$s =~ s/$re//gm;
#
# add everything looking like a with_ variable
#
$re = '%{(with\_[\w\_]+)}';
@@defs = $s =~ /$re/gm;
foreach (@@defs) {
next if exists $ovar->{$1};
$ovar->{$1} = '%{'.$1.'}';
$evar{$1} = '%{'.$1.'}';
}
#
# extract all conditional sections
#
@@term = ();
%var = ();
$cond = '';
foreach $l (split(/\n/, $s)) {
$v = vsub(\%avar, vsub(\%var, $l));
if (($p) = $v =~ /^\#if\s+(.*?)\s*$/) {
#
# normalize #if expressions
# "%{variable}" == "yes"
# "%{variable}" == "no"
# operators ! && ||
#
$term = '';
while ($p =~ /(!=)|(\!|\|\||\&\&|\(|\))|"\%\{([^}]+)\}"\s*==\s*"(yes|no)"|(\S+)/g) {
if (defined $1) {
warn "WARNING: unknown token '$1':\n< $l\n> $v\n";
} elsif (defined $5) {
warn "WARNING: unknown token '$5':\n< $l\n> $v\n";
} elsif (defined $2) {
$term .= " $2 ";
} elsif (exists $evar{$3}) {
$term .= ($4 eq 'no' ? '! ' : '').vsub(\%evar,'%{'.$3.'}');
} else {
warn "WARNING: unknown conditional '$3':\n< $l\n> $v\n";
}
}
#
# join with previous conditions for this #if/#endif block
#
if ($term ne '') {
push @@term, "( $term )";
$cond = join(' && ', grep { $_ ne '' } @@term).'';
} else {
push @@term, '';
}
} elsif ($v =~ /^\#else\s*$/) {
#
# reverse last condition
#
if (@@term) {
$term[-1] = ' ! '.$term[-1];
$cond = join(' && ', grep { $_ ne '' } @@term).'';
} else {
die "FATAL: else without if\n";
}
} elsif ($v =~ /^\#endif\s*$/) {
#
# unwind last #if expression
#
pop @@term;
$cond = join(' && ', grep { $_ ne '' } @@term).'';
} elsif ($v =~ /^\#(?:define)\s*(\S+)\s*(.*?)\s*$/) {
#
# define conditional variables
# truth-value becomes current condition
#
# define internal variables
# -> store for subsequent substitution
#
if (exists $evar{$1}) {
if ($2 eq 'yes') {
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( \%\{$1\} || ( $cond ) )";
}
} elsif ($2 eq 'no') {
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( %\{$1\} && ! ( $cond ) )";
}
} else {
warn "WARNING: logic too complex for '$1':\n< $l\n> $v\n";
}
} else {
$var{$1} = $2;
}
} elsif ($v =~ /^\#(?:undefine)\s*(\S+)\s*$/) {
if (exists $evar{$1}) {
$evar{$1} = "\%\{$1\}";
} else {
delete $var{$1};
}
} elsif ($v =~ /^\#(?:provides)\s*(\S+)\s*(.*?)\s*$/) {
#
# store option for current condition
#
if (exists $attr{'Name'}->{''}) {
push @@{$attr{'Provides'}->{$cond}}, {
resource => $attr{'Name'}->{''}->[0].'::'.$1,
attrname => 'equ',
attrval => optesc($2)
}
} else {
warn "ERROR: no package name set for option $1 = $2\n";
}
} elsif ($v =~ /^\#NoSource\s*(.*?)\s*$/) {
#
# store conditional NoSource attribute
#
push @@{$attr{'NoSource'}->{$cond}}, commasep('NoSource',$1);
} elsif ($v =~ /^\s*([^\#]\S*)\s*:\s*(.*?)\s*$/) {
#
# store attribute=value for current condition
#
push @@{$attr{$1}->{$cond}}, commasep($1,$2);
$avar{lc($1)} = $2 if $cond eq '';
}
}
return \%attr;
}
#
# split spec file into sections starting with a %word
#
# concatenate extended lines
# strip comment lines
# map %command to #command
# split sections
#
# return package2data from default section.
#
sub spec2data ($) {
my($s) = @@_;
my(%map);
my($a,$o);
my $spec = $s;
# remove comments
$s =~ s/^\s*#.*?\n//mg;
# map commands
$s =~ s/^%(ifdef|ifndef|if|NoSource|option|undefine|define|else|endif|\{)/#$1/mg;
# split sections
foreach (split(/^(?=%\w+\s*\n)/m, $s)) {
if (/^%(\w+)\s*\n/) {
$map{$1} .= $';
} else {
$map{'*'} .= $_;
}
}
if (exists $map{'description'}) {
$o = find_options($map{'description'});
$a = package2data($map{'*'}, $o );
$a->{'Description'} = { '' => [ $map{'description'} ] };
} else {
$a = package2data($map{'*'}, {});
}
return $a;
}
##########################################################################
#
# start of XML file
#
sub xml_head ($$) {
my($fh,$res) = @@_;
print $fh <
EOFEOF
}
#
# end of XML file, corresponds with start tags
#
sub xml_foot ($) {
my($fh) = @@_;
print $fh <
EOFEOF
}
sub n($$) {
my($a,$k) = @@_;
return unless $a->{$k};
return unless $a->{$k}->{''};
return $a->{$k}->{''}->[0];
}
#
# send out $a->{$k} as text-style tag
#
sub xml_text ($$$;$) {
my($i,$a,$k,$tag) = @@_;
my($out);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$i = ' ' x $i;
$out = e(n($a,$k));
return if $out eq '';
return "$i<$tag>\n$out\n$i$tag>\n";
}
#
# send out @@{$a->{$k}} as body of an XML tag
# $k is the name of the tag unless overridden by $tag
# $i denotes the depth of indentation to form nicely
# looking files.
#
# all data from the list is flattened into a single
# body, separated by LF and escaped for XML metachars.
#
sub xml_tag ($$$;$) {
my($i,$a,$k,$tag) = @@_;
my($out,$cond,$upn);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
$i = ' ' x $i;
foreach $cond (sort keys %{$a->{$k}}) {
$upn = e(upn($cond));
$out .= $i.
($cond ne '' ? "<$tag cond=\"$upn\">" : "<$tag>").
join("\n", map { e($_) } @@{$a->{$k}->{$cond}}).
"$tag>\n";
}
return $out;
}
#
# send out @@{$a->{$k}} as a rdf:bag
# $k is the name of the outer tag unless overriden by $tag
# $i denotes the depth of indentation, inner tags are indented
# 2 or 4 more character positions.
#
# each element of the bag is listed
#
sub xml_bag ($$$;$) {
my($i,$a,$k,$tag) = @@_;
my($out,$cond,$upn);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
$i = ' ' x $i;
foreach $cond (sort keys %{$a->{$k}}) {
next unless @@{$a->{$k}->{$cond}};
$upn = e(upn($cond));
$out .= $i.
($cond ne '' ? "<$tag cond=\"$upn\">\n" : "<$tag>\n").
"$i \n".
join("",
map {
ref $_
? "$i {attrname}
? " $_->{attrname}=\"".e($_->{attrval})."\""
: ""
).
">".e($_->{resource})."\n"
: "$i ".e($_)."\n"
}
@@{$a->{$k}->{$cond}}).
"$i \n".
"$i$tag>\n";
}
return $out;
}
#
# send out reference to another RDF
#
sub xml_reference ($$$) {
my($fh, $res, $href) = @@_;
print $fh <
EOFEOF
}
#
# translate attributes from %$a as generated by package2data
# into XML and write to file $fh
#
sub xml_record ($$$) {
my($fh, $a, $href) = @@_;
my($maj,$min,$rel,$about);
$about =
n($a,'Name').'-'.
n($a,'Version').'-'.
n($a,'Release');
unless (defined $href) {
# guess location from Information in Specfile
if (exists $a->{'NoSource'}) {
$href = "$about.nosrc.rpm";
} else {
$href = "$about.src.rpm";
}
($maj,$min,$rel) = n($a,'Release') =~ /^(\d+)\.(\d+)\.(\d+)/;
if (defined $min) {
if ($maj > 1 || ($maj == 1 && $min > 0)) {
# 1.1 or later
if (n($a,'Distribution') =~ /\[PLUS\]/) {
$href = 'PLUS/'.$href;
}
}
if ($maj > 1 || ($maj == 1 && $min >= 0)) {
# 1.0 or later
if ($rel > 0) {
$href = 'UPD/'.$href;
}
}
} else {
# current
}
}
print $fh <
EOFEOF
# fake Source attribute from Source\d attribtutes
# XXX only default conditional
$a->{'Source'} = { '' => [
map {
s/\Q%{name}\E/n($a,'Name')/esg;
s/\Q%{version}\E/n($a,'Version')/esg;
s/\Q%{release}\E/n($a,'Release')/esg;
#s/.*\///;
$_;
}
map {
$a->{$_}->{''} ? @@{$a->{$_}->{''}} : ()
}
sort {
my($x) = $a =~ /^(\d*)$/;
my($y) = $b =~ /^(\d*)$/;
return $x <=> $y;
}
grep {
/^Source\d*$/
} keys %$a
]};
delete $a->{'Source'} unless @@{$a->{'Source'}->{''}};
print $fh
xml_tag(6, $a, 'Name'),
xml_tag(6, $a, 'Version'),
xml_tag(6, $a, 'Release'),
xml_tag(6, $a, 'Distribution'),
xml_tag(6, $a, 'Group'),
xml_tag(6, $a, 'License'),
xml_tag(6, $a, 'Packager'),
xml_tag(6, $a, 'Summary'),
xml_tag(6, $a, 'URL'),
xml_tag(6, $a, 'Vendor'),
xml_tag(6, $a, 'SourceRPM'),
xml_tag(6, $a, 'Arch'),
xml_tag(6, $a, 'Os'),
xml_tag(6, $a, 'BuildHost'),
xml_tag(6, $a, 'BuildSystem'),
xml_tag(6, $a, 'BuildTime'),
xml_tag(6, $a, 'Relocations'),
xml_tag(6, $a, 'Size'),
xml_tag(6, $a, 'Prefixes'),
xml_tag(6, $a, 'Platform'),
xml_tag(6, $a, 'SigSize'),
xml_tag(6, $a, 'SigMD5'),
xml_tag(6, $a, 'SigPGP'),
xml_tag(6, $a, 'SigGPG'),
xml_bag(6, $a, 'BuildPreReq'),
xml_bag(6, $a, 'PreReq'),
xml_bag(6, $a, 'Provides'),
xml_bag(6, $a, 'Conflicts'),
xml_bag(6, $a, 'Source'),
xml_bag(6, $a, 'NoSource'),
xml_bag(6, $a, 'Filenames'),
xml_text(6, $a, 'Description');
print $fh <
EOFEOF
}
#####################################################################
sub rpm2spec ($) {
my($fn) = @@_;
local($SIG{'PIPE'}) = 'IGNORE';
my($pipe) = new FileHandle "$R2C '$fn' |"
or die "FATAL: cannot read '$fn' ($!)\n";
my($buf,@@hdr,$n,$m,$name,$step);
my($spec);
while (read($pipe,$buf,110) == 110) {
@@hdr = unpack('a6a8a8a8a8a8a8a8a8a8a8a8a8a8',$buf);
$n = hex($hdr[12]); # filename length
$m = int(($n+5)/4)*4-2; # filename size (padded)
last unless read($pipe,$buf,$m) == $m;
$name = substr($buf,0,$n-1);
$n = hex($hdr[7]); # file length
$m = int(($n+3)/4)*4; # file size (padded)
if ($name !~ /.spec$/) {
while ($m > 0) {
$step = $m > 8192 ? 8192 : $m;
last unless read($pipe,$buf,$step);
$m -= length($buf);
}
} else {
if (read($pipe,$buf,$n) == $n) {
$spec = $buf;
}
last;
}
}
$pipe->close;
return $spec;
}
#####################################################################
sub rpm2data ($$) {
my($fn,$platform) = @@_;
my($q,$pipe,%a);
my($t,$v);
unless (defined $platform) {
die "FATAL: indexing binary package '$fn' requires -p option\n";
}
$q = <) {
if (/^(\S+)\s+(.*?)\s*$/) {
$t = $1;
$v = $2;
} elsif (/^(\s+.+?)\s*$/) {
next unless defined $t;
$v = $1;
} else {
$t = undef;
next;
}
if (exists $a{$t}) {
$a{$t} .= "\n$v";
} else {
$a{$t} = $v;
}
}
$pipe->close;
%a = map { $_ => $a{$_} }
grep { $a{$_} ne '(none)' }
keys %a;
if ($a{'Relocations'} eq '(non relocatable)') {
delete $a{'Relocations'};
}
if ($a{'SigMD5'} eq '(unknown type)') {
delete $a{'SigMD5'};
}
if (defined $platform) {
$a{'Platform'} = $platform;
}
$a{'Description'} = [ $a{'Description'} ];
foreach ('Conflicts', 'PreReq', 'Provides') {
$a{$_} = [
map { make_resource($_) }
grep { !/^rpmlib\(/ }
split(/\n+/, $a{$_})
];
}
return { map {
$_ => { '' => (ref $a{$_} ? $a{$_} : [ split(/\n+/, $a{$_}) ]) }
} keys %a };
}
#####################################################################
sub getindex ($) {
my($dir) = @@_;
my(@@idx) = sort { -M $a <=> -M $b; }
grep { -f $_ }
( <$dir/00INDEX.rdf>, <$dir/00INDEX.rdf.*> );
return unless @@idx;
return $idx[0];
}
sub list_specdir ($) {
my($dir) = @@_;
my($dh,$d,$path);
my(@@list);
$dh = new DirHandle($dir);
while ($d = $dh->read) {
next if $d =~ /^\./;
$path = "$dir/$d/$d.spec";
push @@list, $path if -f $path;
}
return \@@list;
}
sub list_rpmdir ($) {
my($dir) = @@_;
my($dh,$d,$path);
my(@@list,$idx,$sub);
$dh = new DirHandle($dir);
while ($d = $dh->read) {
next if $d =~ /^\./;
$path = "$dir/$d";
if (-d $path) {
$idx = getindex($path);
if (defined $idx) {
push @@list, $idx;
} else {
$sub = list_rpmdir($path);
push @@list, @@$sub;
undef $sub;
}
} else {
next unless $d =~ /\.rpm$/ && -f $path;
push @@list, $path;
}
}
return \@@list;
}
#####################################################################
sub readfile ($) {
my($fn) = @@_;
my($fh) = new FileHandle "< $fn"
or die "FATAL: cannot read '$fn' ($!)\n";
my(@@l) = <$fh>;
$fh->close;
return join('',@@l);
}
sub relpath ($$) {
my($prefix,$path) = @@_;
$path =~ s/^\Q$prefix\E\///s;
return $path;
}
sub dirname ($) {
my($path) = @@_;
$path =~ s/\/[^\/]*$//s;
return $path.'/';
}
sub getresource ($) {
my($fn) = @@_;
my($fh, $buf);
if ($fn =~ /\.bz2$/) {
$fh = new FileHandle "$BZ -dc $fn |"
or die "FATAL: cannot read '$fn' ($!)\n";
} else {
$fh = new FileHandle "< $fn"
or die "FATAL: cannot read '$fn' ($!)\n";
}
$fh->read($buf, 1024);
$fh->close;
if ($buf =~ /{"M$_"} &&
$cache->{"M$_"} == $mtime) {
$spec = $cache->{"S$_"};
} else {
$spec = rpm2spec($_);
$cache->{"S$_"} = $spec;
$cache->{"M$_"} = $mtime;
}
} else {
$spec = rpm2spec($_);
}
$a = spec2data($spec);
} elsif (/([^\/]+\.rpm)$/) {
$h = relpath($prefix, $_);
$a = rpm2data($_, $platform);
} elsif (/([^\/]+\.rdf[^\/]*)$/) {
$h = relpath($prefix, $_);
$r = getresource($_) || $resource.dirname($h);
}
if ($a) {
xml_record($fh, $a, $h);
} elsif ($r) {
xml_reference($fh, $r, $h);
} else {
warn "ERROR: cannot process $_\n";
}
}
}
#####################################################################
my($prefix,$list,$fh,%cache,$tmpo);
if ($#ARGV < 0) {
print "openpkg:index:USAGE: $0 [-r resource] [-p platform] [-C cache.db] [-o index.rdf] [-c] [-i] dir ...\n";
exit(1);
}
if ($opt_C) {
eval {
require DB_File;
};
if ($@@) {
die "Sorry. The -C option requires an installed DB_File perl module.\n";
}
tie %cache, 'DB_File', $opt_C, O_CREAT|O_RDWR, 0666, $DB_File::DB_HASH
or die "FATAL: cannot tie cache '$opt_C' ($!)\n";
}
$opt_r = 'OpenPKG-CURRENT/Source/' unless defined $opt_r;
if (defined $opt_o) {
$tmpo = $opt_o . '.tmp';
if ($opt_c) {
$fh = new FileHandle "| $BZ -c > '$tmpo'"
or die "FATAL: cannot write '$tmpo' ($!)\n";
} else {
$fh = new FileHandle "> $tmpo"
or die "FATAL: cannot write '$tmpo' ($!)\n";
}
} else {
if ($opt_c) {
$fh = new FileHandle "| $BZ -c"
or die "FATAL: cannot write to stdout ($!)\n";
} else {
$fh = new FileHandle ">&=1"
or die "FATAL: cannot write to stdout ($!)\n";
}
}
xml_head($fh, $opt_r);
foreach $prefix (@@ARGV) {
if (-d $prefix) {
if ($opt_i) {
$list = list_rpmdir($prefix);
} else {
$list = list_specdir($prefix);
}
} else {
$list = [ $prefix ];
$prefix = dirname($prefix);
}
write_index($fh, $prefix, $opt_r, $opt_p, $list, $opt_C ? \%cache : undef);
}
xml_foot($fh);
$fh->close
or die "FATAL: write error on output ($!)\n";
if (defined $tmpo) {
rename $tmpo,$opt_o
or die "FATAL: cannot rename $tmpo to $opt_o ($!)\n";
}
@
1.22
log
@switch to new world order by using 'openpkg rpm' and its framework
@
text
@@
1.21
log
@rpm-4.2.1 doesn't know about the BuildRoot tag anymore, drop it from the index
@
text
@d38 4
a41 2
my $RPM = "$l_prefix/bin/rpm";
my $R2C = "$l_prefix/bin/rpm2cpio";
d940 1
a940 1
die "\n";
@
1.20
log
@avoid 'Broken Pipe' messages on some systems
@
text
@a626 1
xml_tag(6, $a, 'BuildRoot'),
a711 1
BuildRoot %{BuildRoot}
@
1.19
log
@spell checking; fix manual page rendering at option -g; small cleanups
@
text
@d657 1
@
1.18
log
@adjust some remaining copyright messages
@
text
@d2 1
a2 1
## openpkg-index.pl -- create index from spec files
@
1.17
log
@handle package attributes as macros, tolerate Provides: %{name}
@
text
@a2 2
##
## Copyright (c) 2000-2003 Cable & Wireless Deutschland GmbH
d5 1
@
1.16
log
@Document that the index cache requires an installed DB_File and produce a nice error message if it isn't.
@
text
@d129 2
a130 1
$v =~ s/\%\{([^}]+)\}/exists $var->{$1} ? $var->{$1} : '%{'.$1.'}'/emg;
d201 1
a201 1
my(%attr);
d255 1
a255 1
$v = vsub(\%var,$l);
d364 1
d977 6
a982 3
die "FATAL: $prefix is not a directory\n" unless -d $prefix;
if ($opt_i) {
$list = list_rpmdir($prefix);
d984 2
a985 1
$list = list_specdir($prefix);
@
1.15
log
@gracefully handle undefined condition variables, keep index syntax correct
@
text
@d942 6
a947 1
require DB_File;
@
1.14
log
@indexer produced empty requirements that confuse builder
@
text
@d274 1
a274 1
warn "WARNING: unknown conditional '$2':\n< $l\n> $v\n";
d315 5
a319 1
$evar{$1} = "( \%\{$1\} || ( $cond ) )";
d321 5
a325 1
$evar{$1} = "( %\{$1\} && ! ( $cond ) )";
@
1.13
log
@use resource elements also for indexing binary packages
@
text
@a762 1
$a{'PreReq'} =~ s/^rpmlib\(.*$//mg;
d766 5
a770 1
$a{$_} = [ map { make_resource($_) } split(/\n+/, $a{$_}) ];
@
1.12
log
@fix temp pkgs, optionally keep temp pkgs, support for su command, skip sub-index by platform, no longer uses defaults for platform name
@
text
@d766 4
@
1.11
log
@Now stores full source paths in index
@
text
@d686 4
d760 3
a762 1
$a{'Platform'} = "$a{'Arch'}-$platform-$a{'Os'}";
a932 1
$opt_p = 'unknown' unless defined $opt_p;
@
1.11.4.1
log
@MFS: latest openpkg-tool
@
text
@a685 4
unless (defined $platform) {
die "FATAL: indexing binary package '$fn' requires -p option\n";
}
d756 1
a756 3
if (defined $platform) {
$a{'Platform'} = $platform;
}
d927 1
@
1.11.4.2
log
@MFS: all latest fixes
@
text
@d274 1
a274 1
warn "WARNING: unknown conditional '$3':\n< $l\n> $v\n";
d315 1
a315 5
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( \%\{$1\} || ( $cond ) )";
}
d317 1
a317 5
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( %\{$1\} && ! ( $cond ) )";
}
d763 1
a764 8
foreach ('Conflicts', 'PreReq', 'Provides') {
$a{$_} = [
map { make_resource($_) }
grep { !/^rpmlib\(/ }
split(/\n+/, $a{$_})
];
}
@
1.11.4.3
log
@MFS: update to latest version
@
text
@d942 1
a942 6
eval {
require DB_File;
};
if ($@@) {
die "Sorry. The -C option requires an installed DB_File perl module.\n";
}
@
1.11.4.4
log
@MFS: all latest changes since last merge
@
text
@d129 1
a129 2
$v =~ s/\%\{([^}]+)\}/
exists $var->{$1} ? $var->{$1} : '%{'.$1.'}'/emg;
d200 1
a200 1
my(%attr,%avar);
d254 1
a254 1
$v = vsub(\%avar, vsub(\%var, $l));
a362 1
$avar{lc($1)} = $2 if $cond eq '';
d975 3
a977 6
if (-d $prefix) {
if ($opt_i) {
$list = list_rpmdir($prefix);
} else {
$list = list_specdir($prefix);
}
d979 1
a979 2
$list = [ $prefix ];
$prefix = dirname($prefix);
@
1.11.2.1
log
@MFC: latest openpkg-tool
@
text
@a685 4
unless (defined $platform) {
die "FATAL: indexing binary package '$fn' requires -p option\n";
}
d756 1
a756 3
if (defined $platform) {
$a{'Platform'} = $platform;
}
d927 1
@
1.11.2.2
log
@MFC: all latest fixes
@
text
@d274 1
a274 1
warn "WARNING: unknown conditional '$3':\n< $l\n> $v\n";
d315 1
a315 5
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( \%\{$1\} || ( $cond ) )";
}
d317 1
a317 5
if ($cond eq '') {
$evar{$1} = "( \%\{$1\} )";
} else {
$evar{$1} = "( %\{$1\} && ! ( $cond ) )";
}
d763 1
a764 8
foreach ('Conflicts', 'PreReq', 'Provides') {
$a{$_} = [
map { make_resource($_) }
grep { !/^rpmlib\(/ }
split(/\n+/, $a{$_})
];
}
@
1.11.2.3
log
@MFC: update to latest version
@
text
@d942 1
a942 6
eval {
require DB_File;
};
if ($@@) {
die "Sorry. The -C option requires an installed DB_File perl module.\n";
}
@
1.11.2.4
log
@MFC: all latest changes since last merge
@
text
@d129 1
a129 2
$v =~ s/\%\{([^}]+)\}/
exists $var->{$1} ? $var->{$1} : '%{'.$1.'}'/emg;
d200 1
a200 1
my(%attr,%avar);
d254 1
a254 1
$v = vsub(\%avar, vsub(\%var, $l));
a362 1
$avar{lc($1)} = $2 if $cond eq '';
d975 3
a977 6
if (-d $prefix) {
if ($opt_i) {
$list = list_rpmdir($prefix);
} else {
$list = list_specdir($prefix);
}
d979 1
a979 2
$list = [ $prefix ];
$prefix = dirname($prefix);
@
1.11.2.5
log
@mass Merge-From-CURRENT (MFC) in preparation for OpenPKG 1.3 [class PLUS only]
@
text
@d3 2
a6 1
## Copyright (c) 2000-2003 Cable & Wireless
@
1.11.2.6
log
@MFC: all changes since last merge
@
text
@d2 1
a2 1
## openpkg-index.pl -- OpenPKG Maintenance Tool (backend for indexing)
@
1.10
log
@Handle %undefine
@
text
@d587 1
a587 1
s/.*\///;
@
1.9
log
@changed index format, compatibility code, code cleanup, comments, clean revdep sort, optionally ignore XML parser
@
text
@d324 6
d381 1
a381 1
$s =~ s/^%(ifdef|ifndef|if|NoSource|option|define|else|endif|\{)/#$1/mg;
@
1.8
log
@support NoSource for private packages
@
text
@d71 34
d108 1
a108 1
if ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts|NoSource)$/) {
d110 3
d329 5
a333 2
push @@{$attr{'Provides'}->{$cond}},
$attr{'Name'}->{''}->[0].'::'.$1.' = '.optesc($2);
d498 10
a507 1
map { "$i ".e($_)."\n" }
d871 1
a871 1
} elsif (/([^\/]+\.src\.rpm)$/) {
@
1.7
log
@support for parameter-based dependencies, partially drop %options support
@
text
@d74 1
a74 1
if ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts)$/) {
d298 6
a304 1
d335 1
a335 1
$s =~ s/^%(ifdef|ifndef|if|option|define|else|endif|\{)/#$1/mg;
d495 5
a499 1
$href = "$about.src.rpm";
d580 1
@
1.6
log
@added Options to Index, various compatibility hacks
@
text
@d38 1
a38 1
my $l_prefix = "@@l_prefix@@";
d81 8
a146 30
# clean up %options macro from description
#
sub clean_options ($$) {
my($descr,$evar) = @@_;
my($p);
$descr =~ s/\s*\%options.*\n//;
$descr =~ s/\n*$/\n/s;
if (%$evar) {
$p = 0;
foreach (keys %$evar) {
$p = length($_) if length($_) > $p;
}
$descr .= "\n" . join '', map {
sprintf(
" %%option %s %s\n",
$_.' 'x($p-length($_)),
$evar->{$_}
)
} sort keys %$evar;
}
return $descr;
}
#
d179 1
a179 1
$s =~ s/^#option\s+(\S+)\s*(.*?)\s*$/#ifndef $1\n#define $1 $2\n#endif/mg;
d287 11
a342 1
d344 1
a344 6
$a->{'Options'} = { '' => $o };
$a->{'Description'} = { '' => [
clean_options($map{'description'}, $o)
] };
a462 42
# send out @@{$a->{$k}} as a rdf:bag
# $k is the name of the outer tag unless overriden by $tag
# $i denotes the depth of indentation, inner tags are indented
# 2 or 4 more character positions.
#
# each element of the bag is a name value pair
#
sub xml_vals ($$$$$) {
my($i,$a,$k,$tags,$tag) = @@_;
my($out,$cond,$upn,$map);
return "" unless exists $a->{$k};
$out = '';
$i = ' ' x $i;
foreach $cond (sort keys %{$a->{$k}}) {
$map = $a->{$k}->{$cond};
next unless %$map;
$upn = e(upn($cond));
$out .= $i.
($cond ne '' ? "<$tags cond=\"$upn\">\n" : "<$tags>\n").
"$i \n".
join('',
map {
"$i ".
( ( $map->{$_} =~ /^\%\{/ )
? "<$tag ID=\"".e($_)."\"/>"
: "<$tag ID=\"".e($_)."\">".
e($map->{$_}).
"$tag>"
).
"\n"
}
keys %$map
).
"$i \n".
"$i$tags>\n";
}
return $out;
}
#
a565 1
xml_vals(6, $a, 'Options', 'Options', 'Option'),
@
1.5
log
@more regex fixes, but build is still broken
@
text
@d56 1
a56 1
$s =~ s/\s+$//mg;
d59 1
a59 1
while ($s =~ /^(\s+)/mg) {
d129 4
a132 2
sub find_options ($$) {
my($spec, $descr) = @@_;
d134 1
a134 2
$descr =~ s/--define\s*'(\S+)\s*\%\{\1\}'/$evar->{$1} = '%{'.$1.'}', ''/sge; # before openpkg-20021230
$spec =~ s/^%option\s+(\S+)\s+\S+/$evar->{$1} = '%{'.$1.'}', ''/mge; # after openpkg-20021230
d139 30
d182 2
a183 2
my($s,$evar) = @@_;
my(%var);
d199 10
d215 2
a216 1
$evar->{$1} = '%{'.$1.'}';
d227 3
a229 1
$evar->{$1} = '%{'.$1.'}';
a231 1
d256 2
a257 2
} elsif (exists $evar->{$3}) {
$term .= ($4 eq 'no' ? '! ' : '').vsub($evar,'%{'.$3.'}');
d298 1
a298 1
if (exists $evar->{$1}) {
d300 1
a300 1
$evar->{$1} = "( \%\{$1\} || ( $cond ) )";
d302 1
a302 1
$evar->{$1} = "( %\{$1\} && ! ( $cond ) )";
a351 2
$o = find_options($spec, $map{'description'});
$a = package2data($map{'*'}, $o);
d353 11
a363 1
$a->{'Description'} = { '' => [ $map{'description'} ] };
d453 2
d464 1
d480 42
d625 1
@
1.4
log
@bump of Copyright messages for forthcoming years 2003
@
text
@d133 1
a133 1
$spec =~ s/^%option\s*(\S+)\s+\S+/$evar->{$1} = '%{'.$1.'}', ''/mge; # after openpkg-20021230
@
1.3
log
@fix also indexing in new %options world
@
text
@d4 3
a6 3
## Copyright (c) 2000-2002 Cable & Wireless Deutschland GmbH
## Copyright (c) 2000-2002 The OpenPKG Project
## Copyright (c) 2000-2002 Ralf S. Engelschall
@
1.2
log
@cleanups and make sure openpkg index uses the own tools
@
text
@d129 6
a134 9
sub find_options ($) {
my($descr) = @@_;
my(%evar);
%evar = map {
$1 => '%{'.$1.'}'
} $descr =~ /--define\s*'(\S+)\s*\%\{\1\}'/;
return \%evar;
d292 1
d298 1
a298 1
$s =~ s/^%(ifdef|ifndef|if|define|else|endif|\{)/#$1/mg;
d309 1
a309 1
$o = find_options($map{'description'});
@
1.1
log
@new package: openpkg-tool 20021126 (OpenPKG Tool)
@
text
@d2 1
a2 1
## openpkg-index -- create index from spec files
d38 4
a41 3
my $RPM = 'rpm';
my $R2C = 'rpm2cpio';
my $BZ = 'bzip2 -9';
@