quick hack to update a db mapping message-id to message file names

diff --git a/msgiddb b/msgiddb
new file mode 100644 (file)
index 0000000..a5ff9bf
--- /dev/null
+++ b/msgiddb
@@ -0,0 +1,73 @@
+#!/usr/local/bin/perl
+
+=head1 NAME
+
+B<msgiddb> - update database mapping Message-ID to message file names
+
+=head1 SYNOPSIS
+
+B<msgiddb> I<dbfile> I<message-files>
+
+=head1 DESCRIPTION
+
+For each I<message-file>, read its Message-ID and use as key in I<dbfile>.
+Check for its presence in the JSON-serialized list stored as the value;
+if absent, append and update the db.
+
+For messages with multiple Message-ID fields, concatenate all the values and use
+that as the key.
+
+I<message-file> names are used exactly; no path components are stripped.
+
+=cut
+
+use strict;
+use warnings;
+use v5.14;
+
+use DB_File;
+use JSON::PP;
+use List::Util 'first';
+
+use FindBin;
+use lib $FindBin::Bin;
+
+require 'minc';
+
+sub push_dblist {
+    my $db            = shift;
+    my $key           = shift;
+    my $value         = shift;
+    my $current_value = $db->{$key};
+    my $values;
+    if ($current_value) {
+        $values = decode_json($current_value);
+        if ( first { defined($_) } @$values ) {
+            return;
+        }
+    }
+    else {
+        my @tmp;
+        $values = \@tmp;
+    }
+    push( @$values, $value );
+    $db->{$key} = encode_json($values);
+}
+
+if ( !caller() ) {
+    my $dbfn = shift;
+    tie( my %db, 'DB_File', $dbfn ) or die("tie(DB_File, $dbfn): $!");
+
+    my $errors = 0;
+    for my $fn (@ARGV) {
+        my $msgids = get_headers($fn)->{'message-id'};
+        if ( !( defined($msgids) && @$msgids ) ) {
+            say STDERR "$fn has no message-id";
+            $errors++;
+            next;
+        }
+        my $msgid = join( '', @$msgids );
+        push_dblist( \%db, $msgid, $fn );
+    }
+    exit($errors);
+}