use Data::Dumper;
sub addpkg {
- my ($pkgs, $cur, $order, @arches) = @_;
+ my ($pkgs, $cur, $order, $cb, $cbdata, @arches) = @_;
if (defined($cur) && (!@arches || grep { /$cur->{'arch'}/ } @arches)) {
- my $k = "$cur->{'name'}-$cur->{'version'}-$cur->{'release'}-$cur->{'arch'}";
- $pkgs->{$k} = $cur;
- # keep order (or should we use Tie::IxHash?)
- push @{$order}, $k if defined $order;
+ if(!$cb || &$cb($cur, $cbdata)) {
+ my $k = "$cur->{'name'}-$cur->{'version'}-$cur->{'release'}-$cur->{'arch'}";
+ $pkgs->{$k} = $cur;
+ # keep order (or should we use Tie::IxHash?)
+ push @{$order}, $k if defined $order;
+ }
}
}
sub parse {
- my ($file, $tmap, $order, @arches) = @_;
# if @arches is empty take all arches
+ my ($file, $tmap, $order, @arches) = @_;
+ my $cb;
+ my $cbdata;
+ if (ref $order eq 'HASH') {
+ my $d = $order;
+ $order = undef;
+ $cb = $d->{'cb'} if (exists $d->{'cb'});
+ $cbdata = $d->{'data'} if (exists $d->{'data'});
+ }
+ # if @arches is empty take all arches
my @needed = keys %$tmap;
my $r = '(' . join('|', @needed) . '|Pkg):\s*(.*)';
push @{$cur->{$tmap->{$tag}}}, $_;
}
} elsif ($tag eq 'Pkg') {
- addpkg($pkgs, $cur, $order, @arches);
+ addpkg($pkgs, $cur, $order, $cb, $cbdata, @arches);
$cur = {};
($cur->{'name'}, $cur->{'version'}, $cur->{'release'}, $cur->{'arch'}) = split(' ', $data);
} else {
$cur->{$tmap->{$tag}} = $data;
}
}
- addpkg($pkgs, $cur, $order, @arches);
+ addpkg($pkgs, $cur, $order, $cb, $cbdata, @arches);
close(F);
return $pkgs;
}
print "I:$id$tag\n";
}
+sub callback
+{
+ my ($pkg, $url) = @_;
+ $pkg->{'provides'} = [] unless exists $pkg->{'provides'};
+ # add self provides (rpm3 misses that)
+ my $n = $pkg->{'name'};
+ if(substr($pkg->{'arch'}, -3) ne 'src' && !scalar grep(/^\Q$n\E( =.*)?$/,@{$pkg->{'provides'}}))
+ {
+ push @{$pkg->{'provides'}}, sprintf("%s = %s-%s", $pkg->{'name'}, $pkg->{'version'}, $pkg->{'release'});
+ }
+ $pkg->{'provides'} = join(' ', @{$pkg->{'provides'}});
+ $pkg->{'requires'} = join(' ', @{$pkg->{'requires'}}) if $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\//;
+ }
+ $pkg->{'location'} = $data[1];
+
+ print_pkg($pkg);
+
+ return 0;
+}
+
while (@ARGV)
{
my $url = shift;
my $packages = $url.'suse/setup/descr/packages';
my @order = ();
- my $pkgs = Susetags::parse($packages, { 'Loc' => 'location', 'Prv' => 'provides', 'Req' => 'requires', 'Tim' => 'buildtime' }, \@order);
- foreach (@order) {
- my $pkg = $pkgs->{$_};
- $pkg->{'provides'} = [] unless exists $pkg->{'provides'};
- # add self provides (rpm3 misses that)
- my $n = $pkg->{'name'};
- if(substr($pkg->{'arch'}, -3) ne 'src' && !scalar grep(/^\Q$n\E( =.*)?$/,@{$pkg->{'provides'}}))
- {
- push @{$pkg->{'provides'}}, sprintf("%s = %s-%s", $pkg->{'name'}, $pkg->{'version'}, $pkg->{'release'});
- }
- $pkg->{'provides'} = join(' ', @{$pkg->{'provides'}});
- $pkg->{'requires'} = join(' ', @{$pkg->{'requires'}}) if $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\//;
- }
- $pkg->{'location'} = $data[1];
-
- print_pkg($pkg);
- }
+ my $pkgs = Susetags::parse($packages,
+ { 'Loc' => 'location', 'Prv' => 'provides', 'Req' => 'requires', 'Tim' => 'buildtime' },
+ { cb => \&callback, data => $url });
}
# vim: sw=2