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