examples/debian/versions/rebuild-debinfo

   1 #! /usr/bin/perl -w
   2 use strict;
   3 use MLDBM qw(DB_File Storable);
   4 use Fcntl;
   5
   6 $MLDBM::DumpMeth=q(portable);
   7
   8 my (%srcbin, %binsrc);
   9 tie %srcbin, 'MLDBM', '/org/bugs.debian.org/versions/indices/srcbin_rebuild.idx',
  10              O_CREAT|O_RDWR, 0644
  11     or die "tie srcbin_rebuild.idx: $!";
  12 tie %binsrc, 'MLDBM', '/org/bugs.debian.org/versions/indices/binsrc_rebuild.idx',
  13              O_CREAT|O_RDWR, 0644
  14     or die "tie binsrc_rebuild.idx: $!";
  15
  16
  17 my %temp_srcbin;
  18 my %temp_binsrc;
  19 while (<>) {
  20     my ($binname, $binver, $binarch, $srcname, $srcver) = split;
  21     if (not defined $srcver) {
  22         print STDERR "Something is wrong with file: $ARGV line $.: 0x".unpack(q(H*),$_)."\n";
  23         next;
  24     }
  25
  26     # see MLDBM(3pm)/BUGS
  27     if (not exists $temp_srcbin{$srcname}) {
  28         $temp_srcbin{$srcname} = $srcbin{$srcname} // {};
  29     }
  30     push_if_not_exists($temp_srcbin{$srcname}{$srcver},[$binname, $binver, $binarch]);
  31     if (not exists $temp_binsrc{$binname}) {
  32         $temp_binsrc{$binname} = $binsrc{$binname} // {};
  33     }
  34     $temp_binsrc{$binname}{$binver}{$binarch} = [$srcname, $srcver];
  35 }
  36 for my $key  (keys %temp_srcbin) {
  37     $srcbin{$key} = $temp_srcbin{$key};
  38 }
  39 for my $key  (keys %temp_binsrc) {
  40     $binsrc{$key} = $temp_binsrc{$key};
  41 }
  42
  43 sub push_if_not_exists{
  44     my ($array,@push_bits) = @_;
  45  PUSH_CHECK: for my $push_bit (@push_bits) {
  46         my $push_ok = 1;
  47         my @pb = @{$push_bit};
  48     ARRAY_CHECK: for my $array_bit (@{$array}) {
  49             my @ab = @{$array_bit};
  50             next ARRAY_CHECK unless $#ab == $#pb;
  51             for my $i (0..$#ab) {
  52                 next ARRAY_CHECK if $ab[$i] ne $pb[$i];
  53             }
  54             # if we get here, then the array has matched; skip to the
  55             # next thing to try to push
  56             next PUSH_CHECK;
  57         }
  58         push @{$array},$push_bit;
  59     }
  60 }