--- /dev/null
+package Susetags;
+
+use strict;
+use warnings;
+use Data::Dumper;
+
+sub parse {
+ my ($file, $tmap, $order, @arches) = @_;
+ # if @arches is empty take all arches
+
+ my @needed = keys %$tmap;
+ my $r = '(' . join('|', @needed) . '|Pkg):\s*(.*)';
+
+ if (!open(F, '<', $file)) {
+ if (!open(F, '-|', "gzip -dc $file".'.gz')) {
+ die "$file: $!";
+ }
+ }
+
+ my $cur;
+ my $pkgs = {};
+ while (<F>) {
+ chomp;
+ next unless $_ =~ /([\+=])$r/;
+ my ($multi, $tag, $data) = ($1, $2, $3);
+ if ($multi eq '+') {
+ while (<F>) {
+ chomp;
+ last if $_ =~ /-$tag/;
+ push @{$cur->{$tmap->{$tag}}}, $_;
+ }
+ } elsif ($tag eq 'Pkg') {
+ $pkgs->{"$cur->{'name'}-$cur->{'arch'}"} = $cur if defined $cur && (!@arches || grep { /$cur->{'arch'}/ } @arches);
+ # keep order (or should we use Tie::IxHash?)
+ push @{$order}, "$cur->{'name'}-$cur->{'arch'}" if defined $order && defined $cur;
+ $cur = {};
+ ($cur->{'name'}, $cur->{'version'}, $cur->{'release'}, $cur->{'arch'}) = split(' ', $data);
+ } else {
+ $cur->{$tmap->{$tag}} = $data;
+ }
+ }
+ $pkgs->{"$cur->{'name'}-$cur->{'arch'}"} = $cur if defined $cur && (!@arches || grep { /$cur->{'arch'}/ } @arches);
+ push @{$order}, "$cur->{'name'}-$cur->{'arch'}" if defined $order && defined $cur;
+ close(F);
+ return $pkgs;
+}
+
+1;
}
use Build;
+use Susetags;
use strict;
sub print_pkg($)
my $tag = sprintf("%s-%s-%s %s",
$pkg->{'name'},
- $pkg->{'ver'},
- $pkg->{'rel'},
+ $pkg->{'version'},
+ $pkg->{'release'},
# $pkg->{'rpm:buildhost'},
$pkg->{'buildtime'});
print "I:$id$tag\n";
# XXX: location is actually defined in content file
my $packages = $url.'suse/setup/descr/packages';
- if(!open(F, '<', $packages)) {
- if(!open(F, '-|', "gzip -dc $packages".'.gz')) {
- die "$packages: $!";
+ my @order = ();
+ my $pkgs = Susetags::parse($packages, { 'Loc' => 'location', 'Prv' => 'provides', 'Req' => 'requires', 'Tim' => 'buildtime' }, \@order);
+ foreach (@order) {
+ my $pkg = $pkgs->{$_};
+ $pkg->{'provides'} = join(' ', @{$pkg->{'provides'}});
+ $pkg->{'requires'} = join(' ', @{$pkg->{'requires'}});
+ $pkg->{'baseurl'} = $url;
+ my @data = split(' ', $pkg->{'location'});
+ # multi cd support hack
+ my $num = $data[0];
+ if($pkg->{'baseurl'} =~ /1\/$/ && $num ne 0) {
+ $pkg->{'baseurl'} =~ s/1\/$/$num\//;
}
- }
-
- {
- my $pkg;
- my ($req, $prv);
- while (<F>) {
- chomp;
- next unless /^[=+]/;
- my ($tag, $data);
- if (/^\+(.*)$/) {
- $tag = $1;
- $data = '';
- while (<F>) {
- chomp;
- last if $_ eq "-$tag";
- $data .= "$_\n";
- }
- chop $data;
- } else {
- ($tag, $data) = split(' ', $_, 2);
- $tag = substr($tag, 1);
- }
- if ($tag eq 'Pkg:') {
- if($pkg) {
- print_pkg($pkg);
- undef $pkg;
- }
- my ($name, $vers, $rel, $arch) = split(' ', $data);
- $pkg = {};
- $pkg->{'name'} = $name;
- $pkg->{'ver'} = $vers;
- $pkg->{'rel'} = $rel;
- $pkg->{'arch'} = $arch;
- $pkg->{'baseurl'} = $url;
- } elsif ($tag eq 'Req:') {
- next unless $pkg;
- $data =~ s/\n/ /gs;
- $pkg->{'requires'} = $data;
- } elsif ($tag eq 'Prv:') {
- next unless $pkg;
- # add self provides for old rpm versions
- my $name = $pkg->{'name'};
- $data = sprintf("%s = %s-%s",
- $name,
- $pkg->{'ver'},
- $pkg->{'rel'}) ."\n".$data unless "\n$data" =~ /\n\Q$name\E =/s;
- $data =~ s/\n/ /gs;
- $pkg->{'provides'} = $data;
- } elsif ($tag eq 'Tim:') {
- $pkg->{'buildtime'} = $data;
- } elsif ($tag eq 'Loc:') {
- my @data = split(' ', $data);
- # multi cd support hack
- my $num = $data[0];
- if($pkg->{'baseurl'} =~ /1\/$/ && $num ne 0) {
- $pkg->{'baseurl'} =~ s/1\/$/$num\//;
- }
- $pkg->{'location'} = $data[1];
- } elsif ($tag eq 'Siz:') {
- my @data = split(' ', $data);
- $pkg->{'size'} = $data[0];
- }
- }
- close F;
+ $pkg->{'location'} = $data[1];
- print_pkg($pkg) if $pkg;
+ print_pkg($pkg);
}
}