- adding support for susetags to download on demand
authorMarcus Hüwe <suse-tux@gmx.de>
Thu, 18 Dec 2008 15:29:29 +0000 (15:29 +0000)
committerMarcus Hüwe <suse-tux@gmx.de>
Thu, 18 Dec 2008 15:29:29 +0000 (15:29 +0000)
- moved the susetags parser into an own module (this is basically based on createyastdeps)
  (see http://lists.opensuse.org/opensuse-buildservice/2008-12/msg00055.html)
- fixed createyastdeps so that it uses the module (parsing a current packages.gz with the
  old and the new createyastdeps code results in the same output)

Susetags.pm [new file with mode: 0644]
createyastdeps

diff --git a/Susetags.pm b/Susetags.pm
new file mode 100644 (file)
index 0000000..f14f977
--- /dev/null
@@ -0,0 +1,48 @@
+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;
index 4aa124f..077441b 100755 (executable)
@@ -5,6 +5,7 @@ BEGIN {
 }
 
 use Build;
+use Susetags;
 use strict;
 
 sub print_pkg($)
@@ -31,8 +32,8 @@ 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";
@@ -65,76 +66,22 @@ while (@ARGV)
   # 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);
   }
 }