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;
$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$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.
#
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$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
$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$tag>\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)."$tag>\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
@