* Add mldbm stuff

[debbugs.git] / examples / debian / versions / build-mldbm.pl

diff --git a/examples/debian/versions/build-mldbm.pl b/examples/debian/versions/build-mldbm.pl
new file mode 100755 (executable)
index 0000000..f91d3d5
--- /dev/null
+++ b/examples/debian/versions/build-mldbm.pl
@@ -0,0 +1,34 @@
+#! /usr/bin/perl -w
+use strict;
+use MLDBM qw(DB_File Storable);
+use Fcntl;
+
+$MLDBM::DumpMeth=q(portable);
+
+my %db;
+tie %db, "MLDBM", "versions.idx.new", O_CREAT|O_RDWR, 0664
+    or die "tie versions.idx.new: $!";
+tie %db2, "MLDBM", "versions_time.idx.new",O_CREAT|O_RDWR, 0664
+     or die "tie versions_time.idx.new failed: $!";
+
+my $archive = shift;
+my $dist = shift;
+my $arch = shift;
+print "$archive/$dist/$arch\n";
+
+my $time = time;
+my ($p, $v);
+while (<>) {
+    if (/^Package: (.*)/)    { $p = $1; }
+    elsif (/^Version: (.*)/) { $v = $1; }
+    elsif (/^$/) {
+       # see MLDBM(3pm)/BUGS
+       my $tmp = $db{$p};
+       $tmp->{$dist}{$arch} = $v;
+       $db{$p} = $tmp;
+       $tmp = $db2{$p};
+       $tmp->{$dist}{$arch}{$v} = $time if not exists
+            $tmp->{$dist}{$arch}{$v};
+       $db2{$p} = $tmp;
+    }
+}