OpenPKG CVS Repository
http://cvs.openpkg.org/
____________________________________________________________________________
Server: cvs.openpkg.org Name: Michael van Elst
Root: /e/openpkg/cvs Email: [EMAIL PROTECTED]
Module: openpkg-src openpkg-web Date: 09-Jan-2003 15:23:18
Branch: HEAD Handle: 2003010914231601
Modified files:
openpkg-src/openpkg-tool
openpkg-build.pl openpkg-index.pl
openpkg-tool.spec openpkg.pod
openpkg-web news.txt
Log:
changed index format, compatibility code, code cleanup, comments,
clean revdep sort, optionally ignore XML parser
Summary:
Revision Changes Path
1.27 +584 -355 openpkg-src/openpkg-tool/openpkg-build.pl
1.9 +54 -5 openpkg-src/openpkg-tool/openpkg-index.pl
1.20 +2 -2 openpkg-src/openpkg-tool/openpkg-tool.spec
1.8 +6 -0 openpkg-src/openpkg-tool/openpkg.pod
1.2624 +1 -0 openpkg-web/news.txt
____________________________________________________________________________
patch -p0 <<'@@ .'
Index: openpkg-src/openpkg-tool/openpkg-build.pl
============================================================================
$ cvs diff -u -r1.26 -r1.27 openpkg-build.pl
--- openpkg-src/openpkg-tool/openpkg-build.pl 8 Jan 2003 15:12:38 -0000 1.26
+++ openpkg-src/openpkg-tool/openpkg-build.pl 9 Jan 2003 14:23:17 -0000 1.27
@@ -29,8 +29,8 @@
$|=1; # autoflush
use strict;
-use vars qw/$opt_R $opt_r $opt_f $opt_u $opt_U $opt_a $opt_A $opt_z $opt_Z $opt_P
$opt_N $opt_E $opt_i $opt_D $opt_p $opt_q $opt_s $opt_S/;
-getopts('R:r:f:uUaAzZP:N:E:iD:p:qsS');
+use vars qw/$opt_R $opt_r $opt_f $opt_u $opt_U $opt_a $opt_A $opt_z $opt_Z $opt_P
$opt_N $opt_E $opt_i $opt_D $opt_p $opt_q $opt_s $opt_S $opt_X/;
+getopts('R:r:f:uUaAzZP:N:E:iD:p:qsSX');
##########################################################################
@@ -106,6 +106,9 @@
##########################################################################
+#
+# evaluate a condition attribute from an option set
+#
sub conditional ($$) {
my($cond,$with) = @_;
my(@s,$res);
@@ -138,40 +141,6 @@
return $res;
}
-sub with_list ($$) {
- my($bags,$with) = @_;
- my($bag,$li);
- my(@out);
-
- foreach $bag (@$bags) {
- next unless conditional($bag->{'cond'}, $with);
- foreach $li (@{$bag->{'rdf:bag'}}) {
- push @out, @{$li->{'rdf:li'}};
- }
- }
-
- return \@out;
-}
-
-sub make_hash ($$$) {
- my($bags,$tag,$with) = @_;
- my($bag,$li);
- my(%out,$el);
-
- foreach $bag (@$bags) {
- next unless conditional($bag->{'cond'}, $with);
- foreach $li (@{$bag->{'rdf:bag'}}) {
- foreach (@{$li->{'rdf:li'}}) {
- next unless exists $_->{$tag};
- $el = $_->{$tag}->[0];
- $out{$el->{'ID'}} = $el->{'content'};
- }
- }
- }
-
- return \%out;
-}
-
##########################################################################
my($RPM,$RPM_PRIV,$RPM_NPRIV,$CURL,$PROG);
@@ -326,15 +295,111 @@
}
return {
- name => $nam,
- version => $ver,
- release => $rel,
- proxy => $pxy,
- prefix => $pre,
- with => $with
+ name => $nam, # the full name of the resource
+ version => $ver, # the version (or value)
+ release => $rel, # and release number
+ proxy => $pxy, # wether the resource is a PROXY resource
+ prefix => $pre, # the packagename (if resource is an option)
+ with => $with # the buildoption (if resource is an option)
+ };
+}
+
+sub parse_depends ($) {
+ my($dep) = @_;
+ my($name, $op, $val);
+
+ if (ref $dep) {
+ #
+ # dependency from new index stored as a node
+ #
+ # content of the node is the name
+ # certain attributes denote the comparison operator
+ # the value of such an attribute is the comparison operand
+ #
+ # the operator (and operand) are optional and there can
+ # only be one
+ #
+ $name = $dep->{content};
+ $op = undef;
+ $op = 'equ' if exists $dep->{equ};
+ $op = 'geq' if exists $dep->{geq};
+ $op = 'leq' if exists $dep->{leq};
+ $op = 'gt' if exists $dep->{gt};
+ $op = 'lt' if exists $dep->{lt};
+ if (defined $op) {
+ $val = $dep->{$op};
+ }
+ } elsif ($dep =~ /\S/) {
+ #
+ # dependency from old index stored as text string
+ #
+ # "name operator operand"
+ # or
+ # "name"
+ #
+ ($name,$op,$val) = $dep =~ /(\S+)\s*(?:(\S+)\s*(\S+))?\s*$/;
+ if (defined $op) {
+ $op = {
+ '==' => 'equ', '=' => 'equ',
+ '>=' => 'geq', '=>' => 'geq',
+ '<=' => 'leq', '=<' => 'leq',
+ '>' => 'gt', '<' => 'lt'
+ }->{$op};
+ unless (defined $op) {
+ print "# don't know how to handle dependency: $dep\n";
+ return;
+ }
+ }
+ }
+
+ return {
+ name => $name,
+ op => $op,
+ val => $val
};
}
+sub depends2provides ($) {
+ my($dep) = @_;
+ my($ver,$rel,$pxy);
+
+ ($ver,$rel,$pxy) = $dep->{val} =~ /^([^\s\-]+)-([^\s\+]+)(\+PROXY)?$/;
+
+ return {
+ name => $dep->{name},
+ version => (defined $ver ? $ver : $dep->{val}),
+ release => $rel,
+ proxy => $pxy
+ }
+}
+
+#
+# convert parser output to dependency records
+#
+sub depend_list ($) {
+ my($deps) = @_;
+ foreach (@$deps) {
+ $_ = parse_depends($_);
+ }
+ return $deps;
+}
+
+#
+# compute list of package names from dependency list
+#
+sub depends2pkglist ($) {
+ my($deps) = @_;
+ return map { $_->{name} } @$deps;
+}
+
+#
+# retrieve the local installed base
+#
+# for packages that provide option resources (packagename::buildoption)
+# the options are parsed into the OPTIONS hash
+#
+# other packages will query options on demand
+#
sub get_installed () {
my(%map);
my(@l) = `$RPM_NPRIV --provides -qa`;
@@ -371,23 +436,16 @@
return \%map;
}
-sub revdep ($$$) {
- my($rev,$t,$name) = @_;
-
- return 1 if $name eq $t->{name};
-
- foreach (@{$rev->{$_}}) {
- return 1 if revdep($rev,$t,$_->{name});
- }
- return -1;
-}
-
+#
+# compute reverse dependency map
+#
+#
sub get_revdep ($) {
my($env) = @_;
my($i) = $env->{'installed'};
my($r) = $env->{'repository'};
- my($pkg, %rev);
- my(@vers,$t,@names);
+ my($pkg, %dep, %dlist, %rev);
+ my(@vers,$t);
print "# computing reverse dependencies\n";
@@ -398,26 +456,39 @@
next;
}
+ #
+ # get list of package versions from repository
+ #
@vers = get_versions($r->{$pkg}, sub { 1; });
+
+ #
+ # get forward dependencies from repository packages
+ #
+ # dep{a}{b} is true if b depends directly on a
+ # dlist{a} is list of packages that depend on a
+ #
foreach (@vers) {
foreach $t (@{$r->{$pkg}->{$_}}) {
next unless $i->{$t->{name}};
next unless $t->{depends};
-
- @names = grep { $_ ne '' }
- map { /^(\S+)/ }
- @{$t->{depends}};
- next unless @names;
- push @{$rev{$_}}, $t foreach @names;
+ foreach (depends2pkglist($t->{depends})) {
+ $dep{$_}{$t->{name}} = 1;
+ push @{$dlist{$_}}, $t;
+ }
}
}
}
- foreach $pkg (keys %rev) {
+ #
+ # sort reverse dependencies
+ #
+ foreach $pkg (keys %dep) {
$rev{$pkg} = [
sort {
- revdep(\%rev, $b, $a->{name});
- } @{$rev{$pkg}}
+ $dep{$a->{name}}{$b->{name}} ||
+ -$dep{$b->{name}}{$a->{name}} ||
+ $a->{name} cmp $b->{name}
+ } @{$dlist{$pkg}}
];
}
@@ -450,6 +521,9 @@
}
}
+#
+# pull in OPTIONS for a package or an RPM file
+#
sub get_with ($;$) {
my($t,$fn) = @_;
my(@l,%with);
@@ -465,11 +539,33 @@
return $t->{OPTIONS};
}
+#
+# compute absolute paths
+#
+# (url, fn) point to a base document
+# the location is the file path fn if fn is
+# defined, otherwise it is url.
+#
+# augment the pointer with suburl
+#
+# suburl can be an absolute url
+# then the new pointer is (suburl, undef)
+#
+# suburl can be a absolute file path
+# then the new pointer is (suburl, suburl)
+#
+# suburl can be a relative path
+# then it augments url or fn accordingly
+#
sub relurl ($$$) {
my($url,$fn,$suburl) = @_;
- my($subfn,$submap);
+ my($subfn);
- unless ($suburl =~ /^\w+:\/\// || $suburl =~ /^\//) {
+ if ($suburl =~ /^\w+:\/\//) {
+ # NOP
+ } elsif ($suburl =~ /^\//) {
+ $subfn = $suburl;
+ } else {
if (defined $fn) {
$subfn = $fn;
$subfn =~ s/\/[^\/]*$//;
@@ -488,19 +584,291 @@
return ($suburl, $subfn);
}
+#
+# return node value from XML parser
+#
sub xel($) {
my($a) = @_;
my($l) = $a->[0];
return '' if ref $l;
return $l;
}
-
-sub get_index ($$$) {
- my($url,$fn,$with) = @_;
- my($ua,$req,$res,$rdf);
- my($bzip2,$path);
- my(%map,@include);
- my($fetch);
+
+#
+# grep XML Bag against condition
+# return as flat list
+#
+sub with_list ($$) {
+ my($bags,$with) = @_;
+ my($bag,$li,$el);
+ my(@out);
+
+ foreach $bag (@$bags) {
+ next unless conditional($bag->{'cond'}, $with);
+ foreach $li (@{$bag->{'rdf:bag'}}) {
+ $el = $li->{'resource'} || $li->{'rdf:li'};
+ push @out, @$el;
+ }
+ }
+
+ return \@out;
+}
+
+sub simple_text_parser ($$$$) {
+ my($fh,$url,$with,$map) = @_;
+ my(@include);
+
+ my($section);
+ my($name,$version);
+ my($href,$release,$desc);
+ my(@prereq,@bprereq);
+ my(@provides,@conflicts,@source,@nosource);
+ my(%options);
+ my($platform,$prefix);
+ my($rec);
+ my($tag,$cond,$attrname,$attrval,$body);
+ my($useit);
+
+ print "# using simple text parser\n";
+
+ while (<$fh>) {
+
+ s/>/>/g;
+ s/</</g;
+
+ if (!(defined $href) && /<rdf:Description.*?href="([^"]*)"/) {
+ $href = $1;
+ $section = undef;
+ $name = undef;
+ $release = undef;
+ $desc = '';
+ $platform = undef;
+ $prefix = undef;
+ @prereq = ();
+ @bprereq = ();
+ @provides = ();
+ @conflicts = ();
+ @source = ();
+ @nosource = ();
+ }
+
+ if (!(defined $href) && /<Repository.*?href="([^"]*)"/) {
+ push(@include, $1);
+ next;
+ }
+
+ next unless defined $href;
+
+ ($tag,$cond,$attrname,$attrval,$body) = /
+ <
+ (\/?[\w:]+)
+ \s*
+ (?:cond="([^"]+)")?
+ (?:(\w+)="([^"]+)")?
+ >
+ (.*?)
+ (?:<\/\1>)?
+ $
+ /mx;
+
+ $useit = conditional($cond,$with);
+
+ if ($tag eq 'Description') {
+ $section = 'description';
+ } elsif ($tag eq '/Description') {
+ $section = undef;
+ } elsif ($section eq 'description') {
+ $desc .= $_;
+ } elsif ($tag eq 'PreReq') {
+ $section = 'prereq' if $useit;
+ } elsif ($tag eq '/PreReq') {
+ $section = undef;
+ } elsif ($tag eq 'BuildPreReq') {
+ $section = 'bprereq' if $useit;
+ } elsif ($tag eq '/BuildPreReq') {
+ $section = undef;
+ } elsif ($tag eq 'Provides') {
+ $section = 'provides' if $useit;
+ } elsif ($tag eq '/Provides') {
+ $section = undef;
+ } elsif ($tag eq 'Conflicts') {
+ $section = 'conflicts' if $useit;
+ } elsif ($tag eq '/Conflicts') {
+ $section = undef;
+ } elsif ($tag eq 'NoSource') {
+ $section = 'nosource' if $useit;
+ } elsif ($tag eq '/NoSource') {
+ $section = undef;
+ } elsif ($tag eq 'Source') {
+ $section = 'source' if $useit;
+ } elsif ($tag eq '/Source') {
+ $section = undef;
+ } elsif ($tag eq 'Name') {
+ $name = $body;
+ } elsif ($tag eq 'Version') {
+ $version = $body;
+ } elsif ($tag eq 'Release') {
+ $release = $body;
+ } elsif ($tag eq 'Platform') {
+ $platform = $body;
+ } elsif ($tag eq 'Prefixes') {
+ $prefix = $body;
+ } elsif ($tag eq 'rdf:li' || $tag eq 'resource') {
+ if ($section eq 'prereq') {
+ push(@prereq, $body);
+ } elsif ($section eq 'bprereq') {
+ push(@bprereq, $body);
+ } elsif ($section eq 'provides') {
+ push(@provides, $body);
+ } elsif ($section eq 'conflicts') {
+ push(@conflicts, $body);
+ } elsif ($section eq 'source') {
+ push(@source, $body);
+ } elsif ($section eq 'nosource') {
+ push(@nosource, $body);
+ }
+ } elsif ($tag eq '/rdf:Description') {
+
+ if (defined $href &&
+ defined $name &&
+ defined $version &&
+ defined $release) {
+
+ @provides = map {
+ depends2provides(parse_depends($_))
+ } @provides;
+
+ %options = map {
+ ( $_->{with} => $_->{version} )
+ } grep {
+ defined $_->{with}
+ } @provides;
+
+ unless (grep($_->{name} eq $name, @provides)) {
+ push(@provides, {
+ name => $name,
+ version => $version,
+ release => $release
+ });
+ }
+
+ $rec = {
+ href => (relurl($url, undef, $href))[0],
+ name => $name,
+ version => $version,
+ release => $release,
+ depends => depend_list([ @bprereq ]),
+ keeps => depend_list([ @prereq ]),
+ conflicts => [ @conflicts ],
+ source => [ @source ],
+ nosource => [ @nosource ],
+ desc => $desc,
+ platform => $platform,
+ prefix => $prefix
+ };
+
+ $rec->{OPTIONS} =
+ %options
+ ? { %options }
+ : parse_options($rec->{desc});
+
+ foreach (@provides) {
+ push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
+ }
+ }
+
+ $href = undef;
+ }
+ }
+
+ return \@include;
+}
+
+sub xml_parser ($$$$) {
+ my($fh, $url, $with, $map) = @_;
+ my(@include);
+
+ my($xml,$desc,$sub);
+ my($provides,@provides,%options,$rec);
+ my($href,$name,$version,$release);
+
+ print "# using XML parser\n";
+
+ $xml = XML::Simple::XMLin($fh, forcearray => 1);
+ $desc = $xml->{'Repository'}->[0]->{'rdf:Description'};
+ $sub = $xml->{'Repository'}->[0]->{'Repository'};
+
+ foreach (@$desc) {
+
+ $href = $_->{'href'};
+ $name = xel($_->{'Name'});
+ $version = xel($_->{'Version'});
+ $release = xel($_->{'Release'});
+
+ next unless defined $href &&
+ defined $name &&
+ defined $version &&
+ defined $release;
+
+ $provides = $_->{'Provides'}->[0]->{'rdf:bag'}->[0];
+ if ($provides->{'rdf:li'}) {
+ $provides = $provides->{'rdf:li'};
+ } else {
+ $provides = $provides->{'resource'};
+ }
+ @provides = map {
+ depends2provides(parse_depends($_))
+ } @$provides;
+
+ %options = map {
+ ( $_->{with} => $_->{version} )
+ } grep {
+ defined $_->{with}
+ } @provides;
+
+ unless (grep($_->{name} eq $name, @provides)) {
+ push(@provides, {
+ name => $name,
+ version => $version,
+ release => $release
+ });
+ }
+
+ $rec = {
+ href => (relurl($url, undef, $href))[0],
+ name => $name,
+ version => $version,
+ release => $release,
+ platform => xel($_->{'Platform'}),
+ prefix => xel($_->{'Prefixes'}),
+ depends => depend_list(with_list($_->{'BuildPreReq'}, $with)),
+ keeps => depend_list(with_list($_->{'PreReq'}, $with)),
+ conflicts => with_list($_->{'Conflicts'}, $with),
+ source => with_list($_->{'Source'}, $with),
+ nosource => with_list($_->{'NoSource'}, $with),
+ desc => xel($_->{'Description'})
+ };
+
+ $rec->{OPTIONS} =
+ %options
+ ? { %options }
+ : parse_options($rec->{desc});
+
+ foreach (@provides) {
+ push(@{$map->{$_->{name}}->{vs($_)}}, $rec);
+ }
+ }
+
+ if ($sub) {
+ @include = map { $_->{href} } @$sub;
+ }
+
+ return \@include;
+}
+
+sub open_index ($$) {
+ my($url, $fn) = @_;
+ my($fetch,$bzip2,$path);
$fetch = defined $fn ? $fn : $url;
@@ -530,239 +898,29 @@
open(RFH, $path) or
die "FATAL: cannot open '$fetch' ($!)\n";
+}
- eval {
- require XML::Simple;
- };
- if ($@) {
-
- print "# using simple text parser\n";
-
- my($section);
- my($name,$version);
- my($href,$release,$desc);
- my(@prereq,@bprereq);
- my(@provides,@conflicts,@source,@nosource);
- my(%options);
- my($platform,$prefix);
- my($rec);
- my($tag,$cond,$body);
- my($useit);
-
- while (<RFH>) {
-
- s/>/>/g;
- s/</</g;
-
- if (!(defined $href) && /<rdf:Description.*?href="([^"]*)"/) {
- $href = $1;
- $section = undef;
- $name = undef;
- $release = undef;
- $desc = '';
- $platform = undef;
- $prefix = undef;
- @prereq = ();
- @bprereq = ();
- @provides = ();
- @conflicts = ();
- @source = ();
- @nosource = ();
- }
-
- if (!(defined $href) && /<Repository.*?href="([^"]*)"/) {
- push(@include, $1);
- next;
- }
-
- next unless defined $href;
-
- ($tag,$cond,$body) = /
- <
- (\/?[\w:]+)
- \s*
- (?:cond="([^"]+)")?
- >
- (.*?)
- (?:<\/\1>)?
- $
- /mx;
-
- $useit = conditional($cond,$with);
-
- if ($tag eq 'Description') {
- $section = 'description';
- } elsif ($tag eq '/Description') {
- $section = undef;
- } elsif ($section eq 'description') {
- $desc .= $_;
- } elsif ($tag eq 'PreReq') {
- $section = 'prereq' if $useit;
- } elsif ($tag eq '/PreReq') {
- $section = undef;
- } elsif ($tag eq 'BuildPreReq') {
- $section = 'bprereq' if $useit;
- } elsif ($tag eq '/BuildPreReq') {
- $section = undef;
- } elsif ($tag eq 'Provides') {
- $section = 'provides' if $useit;
- } elsif ($tag eq '/Provides') {
- $section = undef;
- } elsif ($tag eq 'Conflicts') {
- $section = 'conflicts' if $useit;
- } elsif ($tag eq '/Conflicts') {
- $section = undef;
- } elsif ($tag eq 'NoSource') {
- $section = 'nosource' if $useit;
- } elsif ($tag eq '/NoSource') {
- $section = undef;
- } elsif ($tag eq 'Source') {
- $section = 'nosource' if $useit;
- } elsif ($tag eq '/Source') {
- $section = undef;
- } elsif ($tag eq 'Name') {
- $name = $body;
- } elsif ($tag eq 'Version') {
- $version = $body;
- } elsif ($tag eq 'Release') {
- $release = $body;
- } elsif ($tag eq 'Platform') {
- $platform = $body;
- } elsif ($tag eq 'Prefixes') {
- $prefix = $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 ($section eq 'conflicts') {
- push(@conflicts, $body);
- } elsif ($section eq 'source') {
- push(@source, $body);
- } elsif ($section eq 'nosource') {
- push(@nosource, $body);
- }
- } elsif ($tag eq '/rdf:Description') {
-
- if (defined $href &&
- defined $name &&
- defined $version &&
- defined $release) {
-
- @provides = map { parse_provides($_) } @provides;
-
- %options = map {
- ( $_->{with} => $_->{version} )
- } grep {
- defined $_->{with}
- } @provides;
-
- unless (grep($_->{name} eq $name, @provides)) {
- push(@provides, {
- name => $name,
- version => $version,
- release => $release
- });
- }
-
- $rec = {
- href => (relurl($url, undef, $href))[0],
- name => $name,
- version => $version,
- release => $release,
- depends => [ @bprereq ],
- keeps => [ @prereq ],
- conflicts => [ @conflicts ],
- nosource => [ @source ],
- nosource => [ @nosource ],
- desc => $desc,
- platform => $platform,
- prefix => $prefix
- };
-
- $rec->{OPTIONS} =
- %options
- ? { %options }
- : parse_options($rec->{desc});
-
- foreach (@provides) {
- push(@{$map{$_->{name}}->{vs($_)}}, $rec);
- }
- }
+#
+# fetch index from file or URL
+# recursively fetch sub-indexes
+#
+sub get_index ($$$$) {
+ my($url,$fn,$with,$noxml) = @_;
+ my(%map,$include);
+
+ open_index($url,$fn);
+
+ unless ($noxml) {
+ eval {
+ require XML::Simple;
+ };
+ $noxml = 1 if $@;
+ }
- $href = undef;
- }
- }
+ if ($noxml) {
+ $include = simple_text_parser(\*RFH, $url, $with, \%map);
} else {
-
- print "# using XML parser\n";
-
- my($xml) = XML::Simple::XMLin(\*RFH, forcearray => 1);
- my($desc) = $xml->{'Repository'}->[0]->{'rdf:Description'};
- my($sub) = $xml->{'Repository'}->[0]->{'Repository'};
- my($provides,@provides,%options,$rec);
- my($href,$name,$version,$release);
-
- foreach (@$desc) {
-
- $href = $_->{'href'};
- $name = xel($_->{'Name'});
- $version = xel($_->{'Version'});
- $release = xel($_->{'Release'});
-
- next unless defined $href &&
- defined $name &&
- defined $version &&
- defined $release;
-
- $provides = $_->{'Provides'}->[0]->{'rdf:bag'}->[0]->{'rdf:li'};
-
- @provides = map { parse_provides($_) } @$provides;
-
- %options = map {
- ( $_->{with} => $_->{version} )
- } grep {
- defined $_->{with}
- } @provides;
-
- unless (grep($_->{name} eq $name, @provides)) {
- push(@provides, {
- name => $name,
- version => $version,
- release => $release
- });
- }
-
- $rec = {
- href => (relurl($url, undef, $href))[0],
- name => $name,
- version => $version,
- release => $release,
- platform => xel($_->{'Platform'}),
- prefix => xel($_->{'Prefixes'}),
- depends => with_list($_->{'BuildPreReq'}, $with),
- keeps => with_list($_->{'PreReq'}, $with),
- conflicts => with_list($_->{'Conflicts'}, $with),
- source => with_list($_->{'Source'}, $with),
- nosource => with_list($_->{'NoSource'}, $with),
- desc => xel($_->{'Description'})
- };
-
- $rec->{OPTIONS} =
- %options
- ? { %options }
- : parse_options($rec->{desc});
-
- foreach (@provides) {
- push(@{$map{$_->{name}}->{vs($_)}}, $rec);
- }
- }
-
- if ($sub) {
- @include = map { $_->{href} } @$sub;
- }
+ $include = xml_parser(\*RFH, $url, $with, \%map);
}
close(RFH)
@@ -772,10 +930,10 @@
# cannot do real recursions on file handles, so we simply append
# all sub-RDFs, the result is flattend into a big hash anyway
#
- foreach (@include) {
+ foreach (@$include) {
my($submap);
my($suburl,$subfn) = relurl($url,$fn,$_);
- $submap = get_index($suburl,$subfn,$with);
+ $submap = get_index($suburl,$subfn,$with,$noxml);
while (my($name,$vmap) = each %$submap) {
while (my($vs,$recs) = each %$vmap) {
push @{$map{$name}->{$vs}}, @$recs;
@@ -786,6 +944,8 @@
return \%map;
}
+############################################################################
+
#
# grep all versions of a name that
# satisfy a condition
@@ -807,10 +967,10 @@
@recs = grep {
$env->{sourceonly} ? (
- !(defined $_->{'platform'})
+ !(defined $_->{'prefix'})
) : (
- !(defined $_->{'platform'}) || (
- defined $_->{'prefix'} &&
+ !(defined $_->{'prefix'}) || (
+ defined $_->{'platform'} &&
$_->{'platform'} eq $env->{config}->{platform} &&
$_->{'prefix'} eq $env->{config}->{prefix}
)
@@ -933,6 +1093,20 @@
}
#
+# strip doubles from depend/keep lists
+# and a return a map name => depend/keep
+#
+sub unique_map {
+ my(%out);
+ foreach (@_) {
+ foreach (@$_) {
+ $out{$_->{name}} = $_;
+ }
+ }
+ return %out;
+}
+
+#
# test wether target could be upgraded
#
sub target_newer ($$) {
@@ -992,17 +1166,22 @@
}
}
+############################################################################
+
+#
+# LOGIC
+#
+
#
# locate target for a dependency
#
sub dep2target ($$) {
my($dep, $env) = @_;
- my($name,@vers);
+ my($name,$op,@vers);
my($i,$r,$b,$cond,$version);
my($t,$tdef);
- $dep =~ s/(\S+)\s*//;
- $name = $1;
+ ($name, $op, $version) = ($dep->{name}, $dep->{op}, $dep->{val});
$i = $env->{installed}->{$name};
$r = $env->{repository}->{$name};
@@ -1010,26 +1189,20 @@
return unless $i || $r || $b;
- if ($dep =~ /^(?:>=|=>)\s*(\S+)$/) {
- $version = $1;
+ if (!defined $op) {
+ $cond = sub { 1; };
+ } elsif ($op eq 'geq') {
$cond = sub { vcmp($_[0],$version) >= 0; };
- } elsif ($dep =~ /^(?:<=|=<)\s*(\S+)$/) {
- $version = $1;
+ } elsif ($op eq 'leq') {
$cond = sub { vcmp($_[0],$version) <= 0; };
- } elsif ($dep =~ /^>\s*(\S+)$/) {
- $version = $1;
+ } elsif ($op eq 'gt') {
$cond = sub { vcmp($_[0],$version) > 0; };
- } elsif ($dep =~ /^<\s*(\S+)$/) {
- $version = $1;
+ } elsif ($op eq 'lt') {
$cond = sub { vcmp($_[0],$version) < 0; };
- } elsif ($dep =~ /^==?\s*(\S+)$/) {
- $version = $1;
+ } elsif ($op eq 'equ') {
$cond = sub { vcmp($_[0],$version) == 0; };
- } elsif ($dep =~ /^\s*$/) {
- $cond = sub { 1; };
} else {
- print "# don't know how to handle PreReq: $name $dep\n";
- return;
+ die "FATAL: internal error in dep2target\n";
}
$tdef = undef;
@@ -1037,9 +1210,10 @@
if ($i && (@vers = get_versions($i, $cond))) {
foreach (@vers) {
$t = $i->{$_}->[0];
- if (get_with($t), target_suitable($t, $env->{with})) {
+ get_with($t);
+ if (target_suitable($t, $env->{with})) {
$tdef = $t;
- if (!$env->{upgrade}) {
+ unless ($env->{upgrade}) {
return ($t, 1);
}
}
@@ -1051,7 +1225,10 @@
$t = chose_source($env, $name, $r, get_versions($r, $cond));
if ($t) {
- return ($t, 0);
+ if (!$tdef ||
+ ($env->{upgrade} && target_newer($t, $env->{installed}))) {
+ return ($t, 0);
+ }
}
if ($tdef) {
@@ -1061,7 +1238,9 @@
return;
}
-
+#
+#
+#
sub make_dep ($$$$$$) {
my($target,$depth,$env,$list,$blist,$clist) = @_;
my($d,$k,%d,%k,$t,$old);
@@ -1094,6 +1273,7 @@
print "# excluding $target->{name} (no upgrade allowed)\n";
return;
}
+ # pull in options
get_with($t);
if ($target->{REBUILD}) {
target_setstatus($target,'DEPEND',1);
@@ -1112,7 +1292,7 @@
return;
}
# use options from installed base
- override_options($target->{OPTIONS}, $t->{OPTIONS},
+ override_options(get_with($target), get_with($t),
$env->{config}->{optreg});
# remember this is a rebuild for a proxy package
$target->{PROXY} = $t->{PROXY};
@@ -1137,8 +1317,8 @@
#
if (@$d || @$k) {
- %d = map { $_ => 1 } @$d, @$k;
- %k = map { $_ => 1 } @$k;
+ %d = unique_map($d, $k);
+ %k = unique_map($k);
@deps = ();
$conflict = 0;
@@ -1147,7 +1327,7 @@
# old index misses a OpenPKG provider in the index... skip it
next if $_ eq 'OpenPKG';
- ($t,$old) = dep2target($_, $env);
+ ($t,$old) = dep2target($d{$_}, $env);
if ($t) {
if ($old) {
print "# $target->{name} uses ".vsn($t)." for $_\n";
@@ -1182,9 +1362,13 @@
push(@$list, $target);
foreach (@{$target->{nosource}}) {
- print "# ATTENTION: unpackaged source '$target->{source}->[$_]'\n";
+ print "# ATTENTION: unpackaged source $_: $target->{source}->[$_]\n";
}
+ #
+ # a dependency could not be resolved, don't bother with reverse
+ # dependencies for this target
+ #
return if $conflict;
if (!$env->{quick} &&
@@ -1209,23 +1393,20 @@
}
}
-sub remove_list ($$$) {
- my($targets, $keeps, $installed) = @_;
- my(%keep);
-
- %keep = map { $_ => 1 } @$keeps;
- return [ grep {
- !$keep{$_} && !$installed->{$_->{name}}->{vs($_)};
- } @$targets
- ];
-}
-
+#
+# generate build lists for targets matched by pattern
+#
+# all input and output is passed in 'env' hash
+#
sub build_list ($$) {
my($pattern, $env) = @_;
- my(@goals,@targets,@keeps,@conflicts,$bonly,$t);
+ my(@goals,@targets,@keeps,@conflicts,@bonly,$t);
my($name,$r,$i,@vers);
- my(@todo);
+ my(@todo,%keep);
+ #
+ # handle various patterns
+ #
if (defined $pattern) {
@todo = ();
foreach (split(/\s+/,$pattern)) {
@@ -1241,6 +1422,10 @@
grep(/$p/, keys %{$env->{repository}})
} @todo;
} else {
+ #
+ # undefined pattern means -a option that selects
+ # all packages from repository that are installed
+ #
@todo = grep {
my($n) = $_;
(ref $env->{installed}->{$n}) &&
@@ -1296,13 +1481,23 @@
make_dep($t,0,$env,\@targets,\@keeps,\@conflicts);
}
- $bonly = remove_list(\@targets, \@keeps, $env->{installed});
+ %keep = map { $_ => 1 } @keeps;
+ @bonly = grep {
+ !$keep{$_} && !$env->{installed}->{$_->{name}}->{vs($_)};
+ } @targets;
- return (\@targets, $bonly, \@conflicts);
+ return (\@targets, \@bonly, \@conflicts);
}
#######################################################################
+#
+# OUTPUT
+#
+
+#
+# compute path to binary RPM from rpm config and target data
+#
sub target2rpm ($$) {
my($target,$c) = @_;
my($tmpl) = $c->{template};
@@ -1315,17 +1510,23 @@
return $c->{rpmdir}.'/'.$tmpl;
}
-#######################################################################
-
+#
+# compute new target based on old target augmented with options from
+# a binary RPM file
+#
sub binary_target ($$) {
my($t, $fn) = @_;
my(%target) = %$t;
+ # pull in options from binary RPM file
get_with(\%target, $fn);
return \%target;
}
+#
+# return path to master package for a proxy package
+#
sub find_proxy ($$) {
my($t,$bpkg) = @_;
my(@l) = `$RPM_NPRIV -ql $t->{name}`;
@@ -1339,6 +1540,14 @@
return (glob("$prefix/RPM/PKG/$bpkg"))[0];
}
+#
+# merge parameters from installed package
+# with new parameter set and global parameters
+# from configuration
+#
+# then map the result to --define command line arguments
+# suitable for rpm
+#
sub make_defines ($$$) {
my($old, $new, $c) = @_;
my($with);
@@ -1363,13 +1572,21 @@
# skip parameter templates from index
#
$with = join(' ',map { "--define '$_ $old->{$_}'" }
- grep { $old->{$_} !~ /^%/ } keys %$old);
+ sort grep { $old->{$_} !~ /^%/ } keys %$old);
$with = ' '.$with if $with ne '';
return $with;
}
+#
+# print commands from package build list
+#
+# c -> configuration to derive paths from
+# uncond -> always do the --rebuild
+# with -> parameter set passed to build tool
+# ignore -> generate script that does not stop on error
+#
sub print_list1 ($$$@$) {
my($list,$c,$uncond,$with,$ignore) = @_;
my($spkg,$bpkg,$ppkg);
@@ -1440,6 +1657,12 @@
}
}
+#
+# print commands for the temporary package list
+#
+# temporary packages are only used for building other packages
+# and are removed when everything is done
+#
sub print_list2 ($$) {
my($list,$c) = @_;
my($pkg);
@@ -1450,6 +1673,11 @@
}
}
+#
+# instead of printing a command list, print a status map
+# that shows all packages and how the build process would
+# change their status
+#
sub print_status ($$$$$) {
my($installed,$repository,$list,$bonly,$clist) = @_;
my(%bonly) = map { $_ => 1 } @$bonly;
@@ -1457,6 +1685,7 @@
my($old,$tag,$new);
foreach (@$list, @$clist) {
+ next unless defined $_->{release};
$map{$_->{name}} = {
rel => "$_->{version}-$_->{release}",
status => $_->{STATUS}
@@ -1472,6 +1701,7 @@
@names = keys %map;
foreach $n (keys %$installed) {
+ next if $n =~ /::/;
next if exists $map{$n};
next unless grep { $_ ne '-' } keys %{$installed->{$n}};
$map{$n}->{'status'} = 'OK';
@@ -1479,6 +1709,7 @@
}
foreach $n (keys %$repository) {
+ next if $n =~ /::/;
next if exists $map{$n};
next unless grep { $_ ne '-' } keys %{$repository->{$n}};
$t = find_target($n, $repository);
@@ -1537,18 +1768,16 @@
$url = get_release();
}
-#
# if we read the index from a file we can no longer deduce
# repository paths from index paths. For now lets assume
# that everything is below SRC/ to be compatible with
# existing file indexes.
-#
if (defined $opt_f && !defined $opt_r) {
$url .= 'SRC/';
}
$installed = $opt_Z ? {} : get_installed();
-$repository = get_index($url.'00INDEX.rdf',$opt_f,\%with);
+$repository = get_index($url.'00INDEX.rdf',$opt_f,\%with,$opt_X);
$env = {
config => $config,
@@ .
patch -p0 <<'@@ .'
Index: openpkg-src/openpkg-tool/openpkg-index.pl
============================================================================
$ cvs diff -u -r1.8 -r1.9 openpkg-index.pl
--- openpkg-src/openpkg-tool/openpkg-index.pl 8 Jan 2003 15:12:38 -0000 1.8
+++ openpkg-src/openpkg-tool/openpkg-index.pl 9 Jan 2003 14:23:17 -0000 1.9
@@ -68,11 +68,48 @@
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 =~ /^(PreReq|BuildPreReq|Provides|Conflicts|NoSource)$/) {
+ if ($k =~ /^(NoSource)$/) {
return split(/\s*,\s*/, $v);
+ } elsif ($k =~ /^(PreReq|BuildPreReq|Provides|Conflicts)$/) {
+ return map { make_resource($_) }
+ split(/\s*,\s*/, $v);
}
return $v;
@@ -289,8 +326,11 @@
# store option for current condition
#
if (exists $attr{'Name'}->{''}) {
- push @{$attr{'Provides'}->{$cond}},
- $attr{'Name'}->{''}->[0].'::'.$1.' = '.optesc($2);
+ 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";
}
@@ -455,7 +495,16 @@
($cond ne '' ? "<$tag cond=\"$upn\">\n" : "<$tag>\n").
"$i <rdf:bag>\n".
join("",
- map { "$i <rdf:li>".e($_)."</rdf:li>\n" }
+ map {
+ ref $_
+ ? "$i <resource".
+ ( exists $_->{attrname}
+ ? " $_->{attrname}=\"".e($_->{attrval})."\""
+ : ""
+ ).
+ ">".e($_->{resource})."</resource>\n"
+ : "$i <rdf:li>".e($_)."</rdf:li>\n"
+ }
@{$a->{$k}->{$cond}}).
"$i </rdf:bag>\n".
"$i</$tag>\n";
@@ -819,7 +868,7 @@
if (/\.spec$/) {
$spec = readfile($_);
$a = spec2data($spec);
- } elsif (/([^\/]+\.src\.rpm)$/) {
+ } elsif (/([^\/]+\.(?:no)?src\.rpm)$/) {
$h = relpath($prefix, $_);
if ($cache) {
$mtime = (stat $_)[9];
@@ .
patch -p0 <<'@@ .'
Index: openpkg-src/openpkg-tool/openpkg-tool.spec
============================================================================
$ cvs diff -u -r1.19 -r1.20 openpkg-tool.spec
--- openpkg-src/openpkg-tool/openpkg-tool.spec 8 Jan 2003 15:12:38 -0000
1.19
+++ openpkg-src/openpkg-tool/openpkg-tool.spec 9 Jan 2003 14:23:17 -0000
1.20
@@ -32,8 +32,8 @@
Distribution: OpenPKG [EVAL]
Group: Bootstrapping
License: GPL
-Version: 20030108
-Release: 20030108
+Version: 20030109
+Release: 20030109
# list of sources
Source0: openpkg.sh
@@ .
patch -p0 <<'@@ .'
Index: openpkg-src/openpkg-tool/openpkg.pod
============================================================================
$ cvs diff -u -r1.7 -r1.8 openpkg.pod
--- openpkg-src/openpkg-tool/openpkg.pod 30 Dec 2002 22:05:36 -0000 1.7
+++ openpkg-src/openpkg-tool/openpkg.pod 9 Jan 2003 14:23:17 -0000 1.8
@@ -59,6 +59,7 @@
[B<-q>]
[B<-s>]
[B<-S>]
+[B<-X>]
[B<-P> I<priv-cmd>]
[B<-N> I<non-priv-cmd>]
[B<-p> I<platform>]
@@ -248,6 +249,11 @@
The package exists in the repository but isn't required yet.
=back
+
+=item B<-X>
+
+Ignore an installed XML parser module but use the internal
+simple text parser instead.
=item B<-P> I<priv-cmd>
@@ .
patch -p0 <<'@@ .'
Index: openpkg-web/news.txt
============================================================================
$ cvs diff -u -r1.2623 -r1.2624 news.txt
--- openpkg-web/news.txt 9 Jan 2003 14:02:56 -0000 1.2623
+++ openpkg-web/news.txt 9 Jan 2003 14:23:16 -0000 1.2624
@@ -1,3 +1,4 @@
+09-Jan-2003: Upgraded package: P<openpkg-tool-20030109-20030109>
09-Jan-2003: Upgraded package: P<make-3.80-20030109>
09-Jan-2003: Upgraded package: P<openpkg-20030109-20030109>
09-Jan-2003: Upgraded package: P<perl-gd-20030109-20030109>
@@ .
______________________________________________________________________
The OpenPKG Project www.openpkg.org
CVS Repository Commit List [EMAIL PROTECTED]
