examples/debian/versions/merge-one-debinfo

   1 #! /usr/bin/perl
   2
   3 use warnings;
   4 use strict;
   5 use MLDBM qw(DB_File Storable);
   6 use Fcntl;
   7
   8 $MLDBM::DumpMeth=q(portable);
   9
  10 my (%srcbin, %binsrc);
  11 tie %srcbin, 'MLDBM', '/org/bugs.debian.org/versions/indices/srcbin.idx',
  12              O_CREAT|O_RDWR, 0644
  13     or die "tie srcbin.idx: $!";
  14 tie %binsrc, 'MLDBM', '/org/bugs.debian.org/versions/indices/binsrc.idx',
  15              O_CREAT|O_RDWR, 0644
  16     or die "tie binsrc.idx: $!";
  17
  18 my @files  = @ARGV;
  19
  20
  21 for my $file (@files) {
  22     my $fh = IO::File->new($file,'r') or
  23         die "Unable to open $file for reading: $!";
  24     while (<$fh>) {
  25         chomp;
  26         next unless length $_;
  27         my ($binname, $binver, $binarch, $srcname, $srcver) = split;
  28         # if $srcver is not defined, this is probably a broken
  29         # .debinfo file [they were causing #686106, see commit
  30         # 49c85ab8 in dak.] Basically, $binarch didn't get put into
  31         # the file, so we'll fudge it from the filename.
  32         if (not defined $srcver) {
  33             ($srcname,$srcver) = ($binarch,$srcname);
  34             ($binarch) = $file =~ /_([^\.]+)\.debinfo/;
  35         }
  36         print STDERR "$binname/$binver/$binarch => $srcname/$srcver\n";
  37         # see MLDBM(3pm)/BUGS
  38         my $tmp = $srcbin{$srcname};
  39         push @{$tmp->{$srcver}}, [$binname, $binver, $binarch];
  40         $srcbin{$srcname} = $tmp;
  41
  42         $tmp = $binsrc{$binname};
  43         $tmp->{$binver}{$binarch} = [$srcname, $srcver];
  44         $binsrc{$binname} = $tmp;
  45     }
  46 }