add mailbox deduplicate comand

diff --git a/mailbox_deduplicate b/mailbox_deduplicate
new file mode 100755 (executable)
index 0000000..c8d5f57
--- /dev/null
+++ b/mailbox_deduplicate
@@ -0,0 +1,185 @@
+#!/usr/bin/perl
+# mailbox_deduplicate Deduplicates mail boxes by moving or deleting
+# and is released under the terms of the GNU GPL version 3, or any
+# later version, at your option. See the file README and COPYING for
+# more information.
+# Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
+
+
+use warnings;
+use strict;
+
+use Getopt::Long;
+use Pod::Usage;
+
+use File::Copy;
+use IO::Dir;
+use IO::File;
+
+=head1 NAME
+
+mailbox_deduplicate - Deduplicates mail boxes by moving or deleting
+
+=head1 SYNOPSIS
+
+mailbox_deduplicate [options] [mailboxes]
+
+ Options:
+  --move-to Target to move mail (Default .duplicated)
+  --delete Delete mail instead of moving it
+  --simulate, -n Don't actually do anything
+  --debug, -d debugging level (Default 0)
+  --help, -h display this help
+  --man, -m display manual
+
+=head1 OPTIONS
+
+=over
+
+=item B<--move-to>
+
+Mail box to move duplicate mail to. Defaults to .duplicated
+
+=item B<--delete>
+
+Delete duplicate mail instead of moving it.
+
+=item B<--debug, -d>
+
+Debug verbosity. (Default 0)
+
+=item B<--help, -h>
+
+Display brief usage information.
+
+=item B<--man, -m>
+
+Display this manual.
+
+=back
+
+=head1 EXAMPLES
+
+mailbox_deduplicate
+
+=cut
+
+
+use vars qw($DEBUG);
+
+my %options = (debug           => 0,
+              help            => 0,
+              man             => 0,
+               simulate        => 0,
+               move_to         => '.duplicated',
+              );
+
+GetOptions(\%options,
+           'simulate|n!',
+           'move_to|move-to=s',
+           'delete',
+          'debug|d+','help|h|?','man|m');
+
+pod2usage() if $options{help};
+pod2usage({verbose=>2}) if $options{man};
+
+$DEBUG = $options{debug};
+
+my @USAGE_ERRORS;
+if (0) {
+    push @USAGE_ERRORS,"You must pass something";
+}
+
+pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
+
+
+if (not @ARGV) {
+    push @ARGV,'.';
+}
+
+my %messages;
+for my $mb (@ARGV) {
+    if (not -d $mb) {
+        print STDERR "No directory named '$mb'\n";
+        exit 1;
+    }
+    for my $nc (qw(new cur)) {
+        if (not -d "$mb/$nc") {
+            print STDERR "This probably isn't a mailbox; no '$nc' directory inside\n";
+            exit 1;
+        }
+        my $dir = IO::Dir->new("$mb/$nc") or
+            die "Unable to open directory '$mb/$nc' for reading: $!";
+        my $message;
+        while (defined ($message = $dir->read())) {
+            my $msg_id = get_message_id("$mb/$nc/$message");
+            if (not defined $msg_id) {
+                print STDERR "No message id for $mb/$nc/$message\n" if $DEBUG;
+                next;
+            }
+            print STDERR "$mb/$nc/$message is $msg_id\n" if $DEBUG;
+            push @{$messages{$msg_id}},"$mb/$nc/$message";
+        }
+    }
+}
+
+# handle duplicated messages
+if (not $options{delete}) {
+    for my $dir ('','/new','/cur') {
+        if (not -d $options{move_to}.$dir) {
+            mkdir($options{move_to}.$dir) or
+                die "Unable to make directory $options{move_to}.$dir";
+        }
+    }
+}
+for my $msg_id (keys %messages) {
+    # if there is only one message with this message id, do nothing.
+    next unless @{$messages{$msg_id}} > 1;
+    # otherwise, we need to remove or move the message to the
+    # duplicate folder
+    for my $i (1..$#{$messages{$msg_id}}) {
+        my ($nc) = $messages{$msg_id}[$i] =~ /(new|cur)/;
+        $nc //= 'new';
+        if ($options{delete}) {
+            if ($options{simulate} or $options{verbose}) {
+                print "rm $messages{$msg_id}[$i] (duplicate of $msg_id $messages{$msg_id}[0])\n";
+            }
+            if (not $options{simulate}) {
+                unlink($messages{$msg_id}[$i]) or
+                    die "Unable to unlink message $messages{$msg_id}[$i]";
+            }
+        } else {
+            if ($options{simulate} or $options{verbose}) {
+                print "mv $messages{$msg_id}[$i] $options{move_to}/$nc/. (duplicate of $msg_id $messages{$msg_id}[0])\n";
+            }
+            if (not $options{simulate}) {
+                move($messages{$msg_id}[$i],
+                     "$options{move_to}/$nc/."
+                    ) or die "Unable to move message $messages{$msg_id}[$i]";
+            }
+        }
+    }
+}
+
+sub get_message_id{
+    my ($message) = @_;
+
+    my $fh = IO::File->new($message,'r') or
+        die "Unable to open $message for reading: $!";
+    my $msg_id;
+    while (<$fh>) {
+        chomp;
+        if (/^$/) {
+            last;
+        }
+        if (/^Message-Id:\s+(<?)(\S+)\1/i) {
+            $msg_id = $2;
+            last;
+        }
+    }
+    close($fh);
+    return $msg_id;
+}
+
+
+__END__