examples/debian/versions/build-mldbm.pl

   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 %db;
   9 my %db2;
  10 tie %db, "MLDBM", "versions.idx.new", O_CREAT|O_RDWR, 0664
  11     or die "tie versions.idx.new: $!";
  12 tie %db2, "MLDBM", "versions_time.idx.new",O_CREAT|O_RDWR, 0664
  13      or die "tie versions_time.idx.new failed: $!";
  14
  15 my $archive = shift;
  16 my $dist = shift;
  17 my $arch = shift;
  18 print "$archive/$dist/$arch\n";
  19
  20 my $time = time;
  21 my ($p, $v);
  22 while (<>) {
  23     if (/^Package: (.*)/)    { $p = $1; }
  24     elsif (/^Version: (.*)/) { $v = $1; }
  25     elsif (/^$/) {
  26         # see MLDBM(3pm)/BUGS
  27         my $tmp = $db{$p};
  28         $tmp->{$dist}{$arch} = $v;
  29         $db{$p} = $tmp;
  30         $tmp = $db2{$p};
  31         $tmp->{$dist}{$arch}{$v} = $time if not exists
  32              $tmp->{$dist}{$arch}{$v};
  33         $db2{$p} = $tmp;
  34     }
  35 }