head 1.24; access; symbols; locks; strict; comment @# @; 1.24 date 2002.11.26.19.54.52; author rse; state dead; branches; next 1.23; 1.23 date 2002.11.26.09.52.39; author mlelstv; state Exp; branches; next 1.22; 1.22 date 2002.11.26.09.52.01; author mlelstv; state Exp; branches; next 1.21; 1.21 date 2002.11.25.16.50.59; author mlelstv; state Exp; branches; next 1.20; 1.20 date 2002.11.25.15.57.28; author mlelstv; state Exp; branches; next 1.19; 1.19 date 2002.11.25.15.54.15; author rse; state Exp; branches; next 1.18; 1.18 date 2002.11.25.15.28.37; author mlelstv; state Exp; branches; next 1.17; 1.17 date 2002.11.25.14.58.47; author mlelstv; state Exp; branches; next 1.16; 1.16 date 2002.11.25.13.40.19; author mlelstv; state Exp; branches; next 1.15; 1.15 date 2002.11.25.13.35.53; author mlelstv; state Exp; branches; next 1.14; 1.14 date 2002.11.25.13.25.44; author mlelstv; state Exp; branches; next 1.13; 1.13 date 2002.11.19.22.35.27; author mlelstv; state Exp; branches; next 1.12; 1.12 date 2002.11.18.14.35.37; author mlelstv; state Exp; branches; next 1.11; 1.11 date 2002.11.18.13.56.14; author mlelstv; state Exp; branches; next 1.10; 1.10 date 2002.11.18.11.15.02; author mlelstv; state Exp; branches; next 1.9; 1.9 date 2002.11.14.09.00.52; author mlelstv; state Exp; branches; next 1.8; 1.8 date 2002.11.13.17.55.41; author mlelstv; state Exp; branches; next 1.7; 1.7 date 2002.11.13.15.32.29; author mlelstv; state Exp; branches; next 1.6; 1.6 date 2002.11.13.09.24.29; author mlelstv; state Exp; branches; next 1.5; 1.5 date 2002.11.12.14.23.18; author mlelstv; state Exp; branches; next 1.4; 1.4 date 2002.11.12.13.47.32; author mlelstv; state Exp; branches; next 1.3; 1.3 date 2002.11.12.11.23.27; author mlelstv; state Exp; branches; next 1.2; 1.2 date 2002.11.12.08.15.36; author mlelstv; state Exp; branches; next 1.1; 1.1 date 2002.11.12.08.12.11; author mlelstv; state Exp; branches; next ; desc @@ 1.24 log @the code is now in openpkg-src/openpkg-tool/ @ text @#!/usr/opkg/bin/perl ## ## openpkg-index -- create index from spec files ## ## Copyright (c) 2000-2002 Cable & Wireless Deutschland GmbH ## Copyright (c) 2000-2002 The OpenPKG Project ## Copyright (c) 2000-2002 Ralf S. Engelschall ## ## 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 $RPM = 'rpm'; my $R2C = 'rpm2cpio'; my $BZ = '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+$//mg; $i = undef; while ($s =~ /^(\s+)/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; } sub commasep ($$) { my($k,$v) = @@_; if ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts)$/) { return split(/\s*,\s*/, $v); } return $v; } 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 # sub find_options ($) { my($descr) = @@_; my(%evar); %evar = map { $1 => '%{'.$1.'}' } $descr =~ /--define\s*'(\S+)\s*\%\{\1\}'/; 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,$evar) = @@_; my(%var); my(@@term, $term); my(%attr); 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; # # 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) { $evar->{$1} = '%{'.$1.'}'; } } $s =~ s/$re//gm; # # add everything looking like a with_ variable # $re = '%{(with\_[\w\_]+)}'; @@defs = $s =~ /$re/gm; foreach (@@defs) { $evar->{$1} = '%{'.$1.'}'; } # # extract all conditional sections # @@term = (); %var = (); $cond = ''; foreach $l (split(/\n/, $s)) { $v = 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 '$2':\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') { $evar->{$1} = "( \%\{$1\} || ( $cond ) )"; } elsif ($2 eq 'no') { $evar->{$1} = "( %\{$1\} && ! ( $cond ) )"; } else { warn "WARNING: logic too complex for '$1':\n< $l\n> $v\n"; } } else { $var{$1} = $2; } } elsif ($v =~ /^\s*([^\#]\S*)\s*:\s*(.*?)\s*$/) { # # store attribute=value for current condition # push @@{$attr{$1}->{$cond}}, commasep($1,$2); } } 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); # remove comments $s =~ s/^\s*#.*?\n//mg; # map commands $s =~ s/^%(ifdef|ifndef|if|define|else|endif|\{)/#$1/mg; # split sections foreach (split(/^(?=%\w+\s*\n)/m, $s)) { if (/^%(\w+)\s*\n/) { $map{$1} .= $'; } else { $map{'*'} .= $_; } } $o = find_options($map{'description'}); $a = package2data($map{'*'}, $o); if (exists $map{'description'}) { $a->{'Description'} = { '' => [ $map{'description'} ] }; } 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. # 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}}) { $upn = e(upn($cond)); $out .= $i. ($cond ne '' ? "<$tag cond=\"$upn\">\n" : "<$tag>\n"). "$i \n". join("", map { "$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 $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, 'BuildRoot'), 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, 'Filenames'), xml_text(6, $a, 'Description'); print $fh < EOFEOF } ##################################################################### sub rpm2spec ($) { my($fn) = @@_; 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); $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'}; } $a{'Platform'} = "$a{'Arch'}-$platform-$a{'Os'}"; $a{'PreReq'} =~ s/^rpmlib\(.*$//mg; $a{'Description'} = [ $a{'Description'} ]; 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 "usage: $0 [-r resource] [-p platform] [-C cache.db] [-o index.rdf] [-c] [-i] dir ...\n"; die "\n"; } if ($opt_C) { require DB_File; 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; $opt_p = 'unknown' unless defined $opt_p; 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) { die "FATAL: $prefix is not a directory\n" unless -d $prefix; if ($opt_i) { $list = list_rpmdir($prefix); } else { $list = list_specdir($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"; } =pod =head1 NAME openpkg-index =head1 VERSION $Id: openpkg-index,v 1.23 2002/11/26 09:52:39 mlelstv Exp $ =head1 SYNOPSIS B [-r resource] [-p platform] [-C cache.db] [-o index.rdf] [-c] [-i] dir ...\n"; =head1 DESCRIPTION B creates a resource index for spec files in a source tree or from a RPM package repository. The index holds enough information to support an automated build process. =head1 OPTIONS =over 4 =item B<-r resource> The name of the resource stored in the index. The default is 'OpenPKG-CURRENT/Source/'. =item B<-p platform> B adds a platform attribute for binary RPMs. The attribute is built as I<%{Arch}-$platform-%{Os}> where I<%{Arch}> and I<%{Os}> are taken from the RPM header and I<$platform> is the value of the B<-p> option. The default value is 'unkown'. This must be used to distinguish between platforms that support the same Architecture and OS name like various Linux distributions. =item B<-C cache.db> Cache all spec files into this Berkeley DB when indexing source RPMs. The cache is refreshed automatically when the source RPMs are more recent than the cache entry. =item B<-o index.rdf> Name of the output file, default is to write to stdout. =item B<-c> Compress output with bzip2. Use the B<-o> option to specify a .bz2 suffix. =item B<-i> The specified directories are RPM repositories. Build index over all .rpm-files in these directories and all subdirectories. If a subdirectory already contains a 00INDEX.rdf or 00INDEX.rdf.* file then skip scanning the subdirectory, instead add a reference to the index file into the new index. Without this option the directories are source trees with a subdirectory per package and a I file inside each subdirectory. =back =head1 SEE ALSO openpkg-build, rpm(1) =head1 HISTORY =head1 AUTHORS Michael van Elst mlelstv@@dev.de.cw.net =cut @ 1.23 log @log is a bit intrusive in a manual page @ text @d876 1 a876 1 $Id: openpkg-index,v 1.22 2002/11/26 09:52:01 mlelstv Exp $ @ 1.22 log @added POD @ text @d876 1 a876 2 $Id:$ $Log:$ @ 1.21 log @write temporary file and rename later @ text @d867 80 @ 1.20 log @cache result of rpm2spec @ text @d813 1 a813 1 my($prefix,$list,$fh,%cache); d830 1 d832 2 a833 2 $fh = new FileHandle "| $BZ -c > '$opt_o'" or die "FATAL: cannot write '$opt_o' ($!)\n"; d835 2 a836 2 $fh = new FileHandle "> $opt_o" or die "FATAL: cannot write '$opt_o' ($!)\n"; d862 5 @ 1.19 log @use standard devteam perl @ text @d33 2 a34 2 getopts('r:p:o:ci'); use vars qw/$opt_r $opt_p $opt_o $opt_c $opt_i/; d765 2 a766 2 sub write_index ($$$$$) { my($fh,$prefix,$resource,$platform,$list) = @@_; d768 1 d779 13 a791 1 $spec = rpm2spec($_); d813 1 a813 1 my($prefix,$list,$fh); d816 1 a816 1 print "usage: $0 [-r resource] [-p platform] [-o index.rdf] [-c] [-i] dir ...\n"; d820 6 d855 1 a855 1 write_index($fh, $prefix, $opt_r, $opt_p, $list); @ 1.18 log @retrieve resource names from existing index files fix output formatting @ text @d1 1 a1 1 #!/usr/bin/perl @ 1.17 log @-r option now gets full resource string scan directories recursively and reference existing index files. -c option pipes output through bzip2 @ text @d33 1 a33 1 getopts('r:p:o:i'); d55 3 d63 1 a63 2 $s =~ s/^$i//mg if defined $i; $s =~ s/\s+$//mg; a363 1 $out =~ s/\n+$//s; d742 21 d785 1 a785 1 $r = $resource.dirname($h); a826 3 # sanitize resource path $opt_r =~ s/\/*$/\//s; @ 1.16 log @beautify output @ text @d28 2 d34 1 a34 1 use vars qw/$opt_r $opt_p $opt_o $opt_i/; d41 1 d324 1 a324 1 my($fh,$rel) = @@_; d329 1 a329 1 d427 12 a438 1 # translate attributs from %$a as generated by package2data d547 1 a547 1 my($pipe) = new FileHandle("$R2C '$fn' |") d624 1 a624 1 $pipe = new FileHandle("$RPM -qp --qf '$q' '$fn' |") d666 10 d683 1 a683 1 next if $d =~ /^\.$/; d694 1 a694 1 my(@@list); d698 1 a698 1 next if $d =~ /^\.$/ || $d !~ /\.rpm$/; d700 13 a712 1 push @@list, $path if -f $path; d718 2 d722 1 a722 1 my($fh) = new FileHandle $fn,'r' d729 12 d743 3 a745 3 sub write_index ($$$$) { my($fh,$release,$platform,$list) = @@_; my($a,$h,$s); d750 1 d752 2 a753 2 $s = readfile($_); $a = spec2data($s); d755 3 a757 3 $h = $1; $s = rpm2spec($_); $a = spec2data($s); d759 5 a763 2 $h = $1; $a = rpm2data($_, $platform); d765 1 d768 2 d781 1 a781 1 print "usage: $0 [-r release] [-p platform] [-o index.rdf] [-i] dir ...\n"; d785 1 a785 1 $opt_r = 'CURRENT' unless defined $opt_r; a787 4 if ($opt_r !~ /^(CURRENT|\d+\.\d+)$/) { die "FATAL: you must specify a release tag (CURRENT or x.y)\n"; } d789 7 a795 2 $fh = new FileHandle $opt_o,'w' or die "FATAL: cannot write '$opt_o' ($!)\n"; d797 7 a803 1 $fh = \*STDOUT; d806 3 d817 1 a817 1 write_index($fh, $opt_r, $opt_p, $list); a819 1 $fh->close if defined $opt_o; d821 2 @ 1.15 log @add signature data from binary rpms @ text @d53 1 a53 1 while ($s =~ /^(\s+)/g) { d57 1 a57 1 $s =~ s/^$i//mg; @ 1.14 log @now supports indexing of RPM files @ text @d512 4 d636 4 a639 1 delete $a{'Relocations'} @ 1.13 log @guess release phrase or allow explicit release phrase as second parameter. @ text @d30 5 d37 5 d45 3 d50 1 d52 7 d309 1 a309 1 $a->{'Description'} = $map{'description'}; d358 2 a359 2 $out = e($a->{$k}); $out .= "\n" unless $out =~ /\n$/s; d361 3 a363 1 return "$i<$tag>\n$out$i\n"; d429 1 a429 1 my($maj,$min,$rel,$srcrpm); d431 1 a431 1 $srcrpm = d434 1 a434 1 n($a,'Release').'.src.rpm'; d440 1 a440 1 $href = $srcrpm; d463 1 a463 1 d488 1 d501 11 d517 1 d527 188 a714 1 my($prefix,$release,$dh,$d,$s,$a,$specpath); d717 1 a717 1 print "usage: $0 [openpkg-src [release]]\n"; d721 6 a726 2 $prefix = $ARGV[0]; die "FATAL: '$prefix' is not a directory\n" unless -d $prefix; d728 3 a730 2 if (defined $ARGV[1]) { $release = $ARGV[1]; d732 1 a732 1 ($release) = $prefix =~ /.*(\d+\.\d+)/; a733 1 $release = 'CURRENT' if $release eq ''; d735 7 a741 14 $dh = new DirHandle($prefix) or die $!; xml_head(\*STDOUT, $release); while ($d = $dh->read) { next if $d =~ /^\./; $specpath = "$prefix/$d/$d.spec"; if (-f $specpath) { $s = `cat $specpath`; if ($a = spec2data($s)) { xml_record(\*STDOUT, $a, undef); } else { die "ERROR: cannot parse $specpath\n"; } d743 1 d745 2 a746 1 xml_foot(\*STDOUT); @ 1.12 log @code cleanup @ text @d299 2 a300 2 sub xml_head ($) { my($fh) = @@_; d305 1 a305 1 d491 1 a491 1 my($prefix,$dh,$d,$s,$a,$specpath); d493 2 a494 2 if ($#ARGV != 0) { print "usage: $0 [openpkg-src]\n"; d501 7 d511 1 a511 1 xml_head(\*STDOUT); @ 1.11 log @support Distribution directory (SRC/PLUS/) and updates (UPD/). @ text @d404 3 a406 3 sub xml_record ($$) { my($fh, $a) = @@_; my($maj,$min,$rel,$sub, $srcrpm); d413 1 a413 1 ($maj,$min,$rel) = n($a,'Release') =~ /^(\d+)\.(\d+)\.(\d+)/; d415 11 a425 6 $sub = ''; if (defined $min) { if ($maj > 1 || ($maj == 1 && $min > 0)) { # 1.1 or later if (n($a,'Distribution') =~ /\[PLUS\]/) { $sub = 'PLUS/'; d427 5 a431 5 } if ($maj > 1 || ($maj == 1 && $min >= 0)) { # 1.0 or later if ($rel > 0) { $sub = 'UPD/'; d433 2 d436 1 a436 2 } else { # current d440 1 a440 1 d511 1 a511 1 xml_record(\*STDOUT, $a); @ 1.10 log @fix variable interpolation for building Source names @ text @d406 1 a406 1 my($srcrpm); d413 20 d434 1 a434 1 @ 1.9 log @more warnings about ignored #if phrases @ text @d421 3 a423 3 s/\Q%{name}\E/n($a,{'Name'})/esg; s/\Q%{version}\E/n($a,{'Version'})/esg; s/\Q%{release}\E/n($a,{'Release'})/esg; @ 1.8 log @more guesswork about with_ options needed for 1.0 specfiles @ text @d183 1 a183 1 while ($p =~ /(?:(\!|\|\||\&\&|\(|\))|"\%\{([^}]+)\}"\s*==\s*"(yes|no)")/g) { d185 7 a191 3 $term .= " $1 "; } elsif (exists $evar->{$2}) { $term .= ($3 eq 'no' ? '! ' : '').vsub($evar,'%{'.$2.'}'); @ 1.7 log @support %else @ text @d157 10 a175 1 d424 1 a424 1 @@{$a->{$_}->{''}} @ 1.6 log @look for external parameters in description @ text @d189 13 a201 1 $cond = join(' && ', @@term).''; d208 1 a208 1 $cond = join(' + ', @@term).''; d261 1 a261 1 $s =~ s/^%(ifdef|ifndef|if|define|endif|\{)/#$1/mg; d471 5 a475 2 $a = spec2data($s) and xml_record(\*STDOUT, $a); @ 1.5 log @since commands hide as comments we need to remove comments first @ text @d101 14 d127 2 a128 2 sub package2data ($) { my($s) = @@_; d131 1 a131 1 my(%attr, %evar); d145 1 a145 2 # guess what parameters are external conditions by scanning # for "default" sections. d151 1 a151 1 $evar{$1} = '%{'.$1.'}'; d177 2 a178 2 } elsif (exists $evar{$2}) { $term .= ($3 eq 'no' ? '! ' : '').vsub(\%evar,'%{'.$2.'}'); d180 1 a180 1 die "ERROR: unknown conditional: $l\n== $v\n"; d207 1 a207 1 if (exists $evar{$1}) { d209 1 a209 1 $evar{$1} = "( \%\{$1\} || ( $cond ) )"; d211 1 a211 1 $evar{$1} = "( %\{$1\} && ! ( $cond ) )"; d213 1 a213 1 die "ERROR: logic too complex: $l\n== $v\n"; d243 1 a243 1 my($a); d260 2 a261 1 $a = package2data($map{'*'}); @ 1.4 log @no more condition sorting to match upn code with static #if structure include module description in RDF @ text @a123 3 # remove comments $s =~ s/^\s*#.*?\n//mg; d231 3 @ 1.3 log @store conditions in UPN support && and ! in #if (no operator precedences between || and &&) added comments @ text @a102 2 # extended lines have already been concatenated # comment lines have already been removed d121 6 d168 1 a168 1 $term .= ($3 eq 'no' ? '! ' : '').vsub(\%evar,$evar{$2}); d179 1 a179 1 $cond = join(' && ',sort @@term).''; d186 1 a186 1 $cond = join(' + ',sort @@term).''; d233 1 a233 6 # combine multilines $s =~ s/\\\n/ /sg; # remove comments $s =~ s/^\s*#.*?\n//mg; d247 6 a252 1 return package2data($map{'*'}); d289 16 d319 1 d323 1 a323 1 $out .= (' ' x $i). d344 1 d348 1 a348 1 $out .= (' ' x $i). d350 1 a350 1 (' ' x ($i+2))."\n". d352 1 a352 1 map { (' ' x ($i+4))."".e($_)."\n" } d354 2 a355 2 (' ' x ($i+2))."\n". (' ' x $i)."\n"; d416 2 a417 1 xml_bag(6, $a, 'Source'); a442 1 warn "$specpath\n"; @ 1.2 log @add copyright header @ text @d63 35 a97 4 sub paren ($) { my($s) = @@_; $s = "($s)" if $s !~ /^\(/ && $s =~ / & | \|/; return $s; d129 4 d152 7 d160 1 a160 1 while ($p =~ /(?:(\|\|)|"\%\{([^}]+)\}"\s*==\s*"(yes|no)")/g) { d162 1 a162 1 $term .= ' | '; d164 1 a164 1 $term .= ($3 eq 'no' ? '!' : '').vsub(\%evar,$evar{$2}); d169 4 d174 2 a175 2 push @@term, paren($term); $cond = join(' + ',sort @@term).''; d178 3 d183 1 d185 8 d195 1 a195 1 $evar{$1} = paren($cond); d197 1 a197 1 $evar{$1} = '!'.paren($cond); d205 4 d295 1 a295 1 my($out,$cond); d301 1 d303 1 a303 1 ($cond ne '' ? "<$tag cond=\"$cond\">" : "<$tag>"). d319 1 a319 1 my($out,$cond); d325 1 d327 1 a327 1 ($cond ne '' ? "<$tag cond=\"$cond\">\n" : "<$tag>\n"). d428 1 @ 1.1 log @initial submit @ text @d2 25 @