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; 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\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}}). "\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\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->{$_}). "" ). "\n" } keys %$map ). "$i \n". "$i\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'; @