OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Michael van Elst
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-re Date: 12-Nov-2002 09:12:12
Branch: HEAD Handle: 2002111208121100
Added files:
openpkg-re openpkg-build openpkg-index
Log:
initial submit
Summary:
Revision Changes Path
1.1 +584 -0 openpkg-re/openpkg-build
1.1 +338 -0 openpkg-re/openpkg-index
____________________________________________________________________________
Index: openpkg-re/openpkg-build
============================================================
$ cvs update -p -r1.1 openpkg-build
#!/usr/bin/perl
require 5;
$|=1; # autoflush
use strict;
use Getopt::Std;
use vars qw/$opt_f $opt_u/;
getopts('f:u');
my($RPM,$PROG);
$RPM = $ENV{'RPM'} || 'rpm';
$RPM = (`which $RPM` =~ m{^(/.*)})[0];
die "FATAL: cannot locate rpm in path\n" unless $RPM =~ m{^/};
($PROG) = $0 =~ /(?:.*\/)?(.*)/;
sub vcmp ($$) {
my($a,$b) = @_;
my(@a,@b,$c);
my($ax,$bx);
@a = split(/\./, $a);
@b = split(/\./, $b);
while (@a && @b) {
if ($a[0] =~ /^\d+$/ && $b[0] =~ /^\d+$/) {
$c = $a[0] <=> $b[0];
} elsif ((($a,$ax) = $a[0] =~ /^(\d+)(.*)$/) &&
(($b,$bx) = $b[0] =~ /^(\d+)(.*)$/)) {
$c = $a <=> $b;
$c = $ax cmp $bx unless $c;
} else {
$c = $a[0] cmp $b[0];
}
return $c if $c;
shift @a;
shift @b;
}
$c = scalar(@a) <=> scalar(@b);
return $c;
}
sub get_config ()
{
my($c,@q);
$c = `$RPM --eval '%{_rpmdir} %{_rpmfilename} %{_target_os} %{_target_cpu}'`;
chomp($c);
(@q) = split(/\s+/,$c);
$q[1] =~ s/%{OS}/$q[2]/;
$q[1] =~ s/%{ARCH}/$q[3]/;
return {
rpmdir => $q[0],
template => $q[1]
};
}
sub get_release () {
my($rel,$url);
($rel) =`$RPM -qi openpkg` =~ /Version:\s*(\S+)/m;
if ($rel =~ /^\d+$/) {
print "# $PROG current($rel)\n";
$url = "ftp://ftp.openpkg.org/current/SRC/";;
} elsif ($rel =~ /^(\d+\.\d+)/) {
$rel = $1;
print "# $PROG release($rel)\n";
$url = "ftp://ftp.openpkg.org/release/$rel/SRC/";;
} else {
die "FATAL: don't know how to handle this release\n";
}
return $url;
}
sub get_installed () {
my(%map);
my(@l) = `$RPM --provides -qa`;
foreach (@l) {
/^(\S+)\s*(?:=\s*([^\s\-]+)-(\S+))?$/;
push(@{$map{$1}->{"$2"}}, {
name => $1,
version => (defined $2 ? $2 : '*'),
release => (defined $3 ? $3 : '*')
});
}
return \%map;
}
sub bunzip ($) {
my($source) = @_;
my($pid);
pipe RFH, WFH
or die "FATAL: cannot create pipe ($!)\n";
print "# uncompressing\n";
$pid = fork;
die "FATAL: cannot fork ($!)\n" unless defined $pid;
if ($pid == 0) {
close(RFH);
open STDOUT,'>&='.fileno(WFH) or die;
if (ref $source) {
# filehandle
open STDIN,'<&='.fileno($source) or die;
exec 'bzip2','-dc';
} else {
# buffer
open FH, '| bzip2 -dc' or die;
print FH $source or die;
close FH or die;
}
exit 0;
}
close WFH;
return $pid;
}
sub get_index ($$) {
my($url,$fn) = @_;
my($ua,$req,$res,$rdf);
my($pid);
my(%map);
$url .= '00INDEX.rdf.bz2';
if (defined $fn) {
print "# reading index file $fn\n";
if ($fn =~ /\.bz2$/) {
open(FH, "< $fn") or
die "FATAL: cannot read file '$fn' ($!)\n";
$pid = bunzip(\*FH);
close(FH);
} else {
open(RFH, "< $fn") or
die "FATAL: cannot read file '$fn' ($!)\n";
}
} else {
print "# fetching index $url\n";
eval {
require LWP;
};
if ($@) {
die "FATAL: LWP is not installed, please fetch index manually\n";
}
$ua = new LWP::UserAgent;
$req = new HTTP::Request GET => $url;
$res = $ua->request($req);
die "FATAL: cannot read build index\n" unless $res->is_success;
$pid = bunzip($res->content);
}
eval {
require XML::Simple;
};
if ($@) {
print "# using simple text parser\n";
my($section);
my($name,$version);
my($href,$release);
my(@prereq,@bprereq);
my(@provides,$rec);
my($tag,$cond,$body);
while (<RFH>) {
s/>/>/g;
s/</</g;
if (/<rdf:Description.*?href="([^"]*)"/) {
$section = undef;
$href = $1;
$name = undef;
$release = undef;
@prereq = ();
@bprereq = ();
@provides = ();
}
next unless defined $href;
($tag,$cond,$body) = /<(\/?[\w:]+)\s*(cond="[^"]+")?>([^<]*)/;
next unless $tag;
next if $cond ne '';
if ($tag eq 'PreReq') {
$section = 'prereq';
@prereq = ();
} elsif ($tag eq '/PreReq') {
$section = undef;
} elsif ($tag eq 'BuildPreReq') {
$section = 'bprereq';
@bprereq = ();
} elsif ($tag eq '/BuildPreReq') {
$section = undef;
} elsif ($tag eq 'Provides') {
$section = 'provides';
@provides = ();
} elsif ($tag eq '/Provides') {
$section = undef;
} elsif ($tag eq 'Name') {
$name = $body;
} elsif ($tag eq 'Version') {
$version = $body;
} elsif ($tag eq 'Release') {
$release = $body;
} elsif ($tag eq 'rdf:li') {
if ($section eq 'prereq') {
push(@prereq, $body);
} elsif ($section eq 'bprereq') {
push(@bprereq, $body);
} elsif ($section eq 'provides') {
push(@provides, $body);
}
} elsif ($tag eq '/rdf:Description') {
if (defined $href && defined $name && defined $version) {
@provides = map {{ name => $_, version => '' } } @provides;
push(@provides, {
name => $name,
version => $version
});
$rec = {
name => $name,
version => $version,
release => $release,
depends => [ @bprereq ],
keeps => [ @prereq ],
href => $href
};
foreach (@provides) {
push(@{$map{$_->{name}}->{$_->{version}}}, $rec);
}
}
$href = undef;
}
}
} else {
print "# using XML parser\n";
my($xml) = XML::Simple::XMLin(\*RFH, forcearray => 1);
my($desc) = $xml->{'Repository'}->[0]->{'rdf:Description'};
my($provides,@provides,$rec);
foreach (@$desc) {
$provides = $_->{'Provides'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'};
if ($provides) {
@provides = map {{ name => $_, version => '' }} @$provides;
} else {
@provides = ();
}
push(@provides, {
name => $_->{'Name'}->[0],
version => $_->{'Version'}->[0]
});
$rec = {
name => $_->{'Name'}->[0],
version => $_->{'Version'}->[0],
release => $_->{'Release'}->[0],
depends => $_->{'BuildPreReq'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'},
keeps => $_->{'PreReq'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'},
href => $_->{'href'}
};
foreach (@provides) {
push(@{$map{$_->{name}}->{$_->{version}}}, $rec);
}
}
}
close(RFH);
waitpid $pid,0 if $pid;
return \%map;
}
#
# grep all versions of a name that
# satisfy a condition
#
sub get_versions ($$) {
my($relmap, $cond) = @_;
return grep { $cond->($_); }
sort { vcmp($a,$b); } keys %$relmap;
}
#
# there can be multiple sources for a target release
#
sub chose_source ($@) {
my($name, $vmap, @vers) = @_;
my($version,$recs,$rec);
return unless @vers;
$version = $vers[-1];
$recs = $vmap->{$version};
return unless $recs && @$recs;
if (scalar(@$recs) > 1) {
print "# ambigous sources for $name\n";
my($i) = 0;
foreach (@$recs) {
print "# $i: $_->{name}-$_->{version}\n";
$i++;
}
die "ERROR: ambigous dependency\n";
} else {
$rec = $recs->[0];
print "# source for $name is $rec->{name}-$rec->{version}\n";
}
return $rec;
}
#
# see wether target is in map
#
sub target_exists ($$) {
my($target, $map) = @_;
my($vmap) = $map->{$target->{name}};
return unless $vmap;
return !defined $target->{version} ||
defined $vmap->{$target->{version}};
}
#
# retrieve build dependencies for target in map
#
sub target_depends ($$) {
my($target, $map) = @_;
my($vmap) = $map->{$target->{name}};
my($vers);
return unless $vmap;
return unless defined $target->{version};
$vers = $vmap->{$target->{version}};
return unless $vers && @$vers;
return $vers->[0]->{depends};
}
#
# retrieve runtime dependencies for target in map
#
sub target_keeps ($$) {
my($target, $map) = @_;
my($vmap) = $map->{$target->{name}};
my($vers);
return unless $vmap;
return unless defined $target->{version};
$vers = $vmap->{$target->{version}};
return unless $vers && @$vers;
return $vers->[0]->{keeps};
}
#
# locate target for a dependency
#
sub dep2target ($$) {
my($dep, $env) = @_;
my($name,@vers);
my($i,$r,$b,$cond);
$dep =~ s/(\S+)\s*//;
$name = $1;
$i = $env->{installed}->{$name};
$r = $env->{repository}->{$name};
$b = $env->{built}->{$name};
return unless $i || $r || $b;
if ($dep =~ /^>=\s*(\S+)$/) {
$cond = sub { vcmp($_[0],$2) >= 0; };
} elsif ($dep =~ /^=\s*(\S+)$/) {
$cond = sub { vcmp($_[0],$2) == 0; };
} elsif ($dep =~ /^\s*$/) {
$cond = sub { 1; };
} else {
die "FATAL: don't know how to handle PreReq: $name $dep\n";
}
if ($i && (@vers = get_versions($i, $cond))) {
return ($i->{$vers[0]}->[0], 1);
}
if ($b && (@vers = get_versions($b, $cond))) {
return ($b->{$vers[0]}->[0], 1);
}
return (chose_source($name, $r, get_versions($r, $cond)), 0);
}
sub make_dep ($$$$$) {
my($target,$depth,$env,$list,$blist) = @_;
my($d,$k,%d,%k,$t,$old);
if (target_exists($target, $env->{installed})) {
print "# $target->{name} is already installed\n";
return;
} elsif (target_exists($target, $env->{built})) {
print "# $target->{name} is already in list\n";
return;
}
$d = target_depends($target, $env->{repository});
$k = target_keeps($target, $env->{repository});
%d = map { $_ => 1 } @$d, @$k;
return unless %d;
%k = map { $_ => 1 } @$k;
foreach (keys %d) {
# we are still missing a OpenPKG provider in the index... skip it
next if $_ eq 'OpenPKG';
($t,$old) = dep2target($_, $env);
if ($t) {
if ($old) {
print "# $target->{name} uses $t->{name}-$t->{version} for $_\n";
next;
}
# record which targets to keep in blist
if ($k{$_}) {
push(@$blist,$t);
print "# $target->{name} installs $t->{name}-$t->{version} for $_\n";
} else {
print "# $target->{name} requires $t->{name}-$t->{version} for $_\n";
}
make_dep($t,$depth+1,$env,$list,$blist);
} else {
\*STDOUT->flush;
die "FATAL: $target->{name} requires $_\n";
}
}
print "# adding $target->{name}-$target->{version} to list\n";
push(@$list, $target);
push(@{$env->{built}->{$target->{name}}->{$target->{version}}}, $target);
}
sub remove_list ($$$) {
my($targets, $keeps, $installed) = @_;
my(%keep);
%keep = map { $_ => 1 } @$keeps;
return [ grep {
!$keep{$_} && !$installed->{$_->{name}}->{$_->{version}};
} @$targets
];
}
sub build_list ($$) {
my($pattern, $env) = @_;
my(@goals,@targets,@keeps,$bonly,$t);
my($name,$r,@vers);
if ($pattern =~ s/\*+$//) {
$pattern = '^'.quotemeta($pattern).'';
} else {
$pattern = '^'.quotemeta($pattern).'$';
}
#
# chose maximum releases
#
foreach $name (grep(/$pattern/, sort keys %{$env->{repository}})) {
$r = $env->{repository}->{$name};
@vers = get_versions($r, sub { 1; });
next unless @vers;
push(@goals, chose_source($name, $r, @vers));
}
return unless @goals;
@targets = ();
@keeps = @goals;
foreach $t (@goals) {
print "# recursing over dependencies for $t->{name}-$t->{version}\n";
make_dep($t,0,$env,\@targets,\@keeps);
}
$bonly = remove_list(\@targets, \@keeps, $env->{installed});
return (\@targets, $bonly);
}
#######################################################################
sub target2rpm ($$) {
my($target,$c) = @_;
my($tmpl) = $c->{template};
$tmpl =~ s/%{NAME}/$target->{name}/;
$tmpl =~ s/%{VERSION}/$target->{version}/;
$tmpl =~ s/%{RELEASE}/$target->{release}/;
return $c->{rpmdir}.'/'.$tmpl;
}
#######################################################################
sub print_list1 ($$$$) {
my($list,$c,$url,$uncond) = @_;
my($spkg,$bpkg);
foreach (@$list) {
$spkg = $_->{href};
$bpkg = target2rpm($_, $c);
if ($uncond || !-f $bpkg) {
print "$RPM --rebuild $url$spkg || exit 1\n";
}
print "$RPM -Uvh $bpkg\n";
}
}
sub print_list2 ($$) {
my($list,$c) = @_;
my($pkg);
foreach (@$list) {
$pkg = "$_->{name}-$_->{version}-$_->{release}";
print "$RPM -e $pkg\n";
}
}
#######################################################################
my($config,$url,$repository,$installed,$list,$bonly);
die "usage: $0 [-f index.rdf] [-u] package\n" unless $ARGV[0] =~ /^\S+$/;
$config = get_config();
$url = get_release();
$installed = get_installed();
$repository = get_index($url,$opt_f);
($list,$bonly) = build_list($ARGV[0], {
installed => $installed,
repository => $repository,
built => {}
});
die "FATAL: cannot find package\n" unless defined $list;
print_list1($list,$config,$url,$opt_u);
print_list2($bonly,$config);
Index: openpkg-re/openpkg-index
============================================================
$ cvs update -p -r1.1 openpkg-index
#!/usr/bin/perl
use strict;
use DirHandle;
#
# escape XML special characters for output in RDF file
#
sub e ($) {
my($s) = @_;
$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 paren ($) {
my($s) = @_;
$s = "($s)" if $s !~ /^\(/ && $s =~ / & | \|/;
return $s;
}
#
# translate default section from spec-file
# into a hash
# extended lines have already been concatenated
# comment lines have already been removed
# %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) = @_;
my(%var);
my(@term, $term);
my(%attr, %evar);
my($l, $v, $cond, $d, $p);
my($re,@defs);
#
# 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;
$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;
#
# extract all conditional sections
#
@term = ();
%var = ();
$cond = '';
foreach $l (split(/\n/, $s)) {
$v = vsub(\%var,$l);
if (($p) = $v =~ /^\#if\s+(.*?)\s*$/) {
$term = '';
while ($p =~ /(?:(\|\|)|"\%\{([^}]+)\}"\s*==\s*"(yes|no)")/g) {
if (defined $1) {
$term .= ' | ';
} elsif (exists $evar{$2}) {
$term .= ($3 eq 'no' ? '!' : '').vsub(\%evar,$evar{$2});
} else {
die "ERROR: unknown conditional: $l\n== $v\n";
}
}
if ($term ne '') {
push @term, paren($term);
$cond = join(' + ',sort @term).'';
}
} elsif ($v =~ /^\#endif\s*$/) {
pop @term;
$cond = join(' + ',sort @term).'';
} elsif ($v =~ /^\#(?:define)\s*(\S+)\s*(.*?)\s*$/) {
if (exists $evar{$1}) {
if ($2 eq 'yes') {
$evar{$1} = paren($cond);
} elsif ($2 eq 'no') {
$evar{$1} = '!'.paren($cond);
} else {
die "ERROR: logic too complex: $l\n== $v\n";
}
} else {
$var{$1} = $2;
}
} elsif ($v =~ /^\s*([^\#]\S*)\s*:\s*(.*?)\s*$/) {
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);
# combine multilines
$s =~ s/\\\n/ /sg;
# remove comments
$s =~ s/^\s*#.*?\n//mg;
# map commands
$s =~ s/^%(ifdef|ifndef|if|define|endif|\{)/#$1/mg;
# split sections
foreach (split(/^(?=%\w+\s*\n)/m, $s)) {
if (/^%(\w+)\s*\n/) {
$map{$1} .= $';
} else {
$map{'*'} .= $_;
}
}
return package2data($map{'*'});
}
##########################################################################
#
# start of XML file
#
sub xml_head ($) {
my($fh) = @_;
print $fh <<EOFEOF;
<?xml version="1.0" encoding="iso-8859-1"?>
<rdf:RDF xmlns:rdf="http://www.w3.org/1999/02/22-rdf-syntax-ns#";
xmlns="http://www.openpkg.org/xml-rdf-index/0.9";>
<Repository rdf:resource="OpenPKG-CURRENT/Source/">
EOFEOF
}
#
# end of XML file, corresponds with start tags
#
sub xml_foot ($) {
my($fh) = @_;
print $fh <<EOFEOF;
</Repository>
</rdf:RDF>
EOFEOF
}
sub n($$) {
my($a,$k) = @_;
return unless $a->{$k};
return unless $a->{$k}->{''};
return $a->{$k}->{''}->[0];
}
#
# 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);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
foreach $cond (sort keys %{$a->{$k}}) {
$out .= (' ' x $i).
($cond ne '' ? "<$tag cond=\"$cond\">" : "<$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);
return "" unless exists $a->{$k};
$tag = $k unless defined $tag;
$out = '';
foreach $cond (sort keys %{$a->{$k}}) {
$out .= (' ' x $i).
($cond ne '' ? "<$tag cond=\"$cond\">\n" : "<$tag>\n").
(' ' x ($i+2))."<rdf:bag>\n".
join("",
map { (' ' x ($i+4))."<rdf:li>".e($_)."</rdf:li>\n" }
@{$a->{$k}->{$cond}}).
(' ' x ($i+2))."</rdf:bag>\n".
(' ' x $i)."</$tag>\n";
}
return $out;
}
#
# translate attributs from %$a as generated by package2data
# into XML and write to file $fh
#
sub xml_record ($$) {
my($fh, $a) = @_;
my($srcrpm);
$srcrpm =
n($a,'Name').'-'.
n($a,'Version').'-'.
n($a,'Release').'.src.rpm';
print $fh <<EOFEOF;
<rdf:Description about="$srcrpm" href="$srcrpm">
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->{$_}->{''}}
}
sort {
my($x) = $a =~ /^(\d*)$/;
my($y) = $b =~ /^(\d*)$/;
return $x <=> $y;
}
grep {
/^Source\d*$/
} keys %$a
]};
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_bag(6, $a, 'BuildPreReq'),
xml_bag(6, $a, 'PreReq'),
xml_bag(6, $a, 'Provides'),
xml_bag(6, $a, 'Conflicts'),
xml_bag(6, $a, 'Source');
print $fh <<EOFEOF;
</rdf:Description>
EOFEOF
}
#####################################################################
my($prefix,$dh,$d,$s,$a,$specpath);
if ($#ARGV != 0) {
print "usage: $0 [openpkg-src]\n";
die "\n";
}
$prefix = $ARGV[0];
die "FATAL: '$prefix' is not a directory\n" unless -d $prefix;
$dh = new DirHandle($prefix)
or die $!;
xml_head(\*STDOUT);
while ($d = $dh->read) {
next if $d =~ /^\./;
$specpath = "$prefix/$d/$d.spec";
warn "$specpath\n";
if (-f $specpath) {
$s = `cat $specpath`;
$a = spec2data($s)
and xml_record(\*STDOUT, $a);
}
}
xml_foot(\*STDOUT);
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
