print packages on the fly instead of storing all in a hash
authorLudwig Nussel <ludwig.nussel@suse.de>
Thu, 15 Jan 2009 13:16:45 +0000 (13:16 +0000)
committerLudwig Nussel <ludwig.nussel@suse.de>
Thu, 15 Jan 2009 13:16:45 +0000 (13:16 +0000)
Susetags.pm
createyastdeps

index d927441..70bb6d2 100644 (file)
@@ -5,19 +5,30 @@ use warnings;
 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*(.*)';
 
@@ -40,14 +51,14 @@ sub parse {
         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;
 }
index 0e796c9..0c347fb 100755 (executable)
@@ -34,6 +34,32 @@ sub print_pkg($)
   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;
@@ -62,29 +88,9 @@ while (@ARGV)
   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