2 # mailbox_deduplicate Deduplicates mail boxes by moving or deleting
3 # and is released under the terms of the GNU GPL version 3, or any
4 # later version, at your option. See the file README and COPYING for
6 # Copyright 2013 by Don Armstrong <don@donarmstrong.com>.
21 mailbox_deduplicate - Deduplicates mail boxes by moving or deleting
25 mailbox_deduplicate [options] [mailboxes]
28 --move-to Target to move mail (Default .duplicated)
29 --delete Delete mail instead of moving it
30 --simulate, -n Don't actually do anything
31 --debug, -d debugging level (Default 0)
32 --help, -h display this help
33 --man, -m display manual
41 Mail box to move duplicate mail to. Defaults to .duplicated
45 Delete duplicate mail instead of moving it.
49 Debug verbosity. (Default 0)
53 Display brief usage information.
70 my %options = (debug => 0,
74 move_to => '.duplicated',
81 'debug|d+','help|h|?','man|m');
83 pod2usage() if $options{help};
84 pod2usage({verbose=>2}) if $options{man};
86 $DEBUG = $options{debug};
90 push @USAGE_ERRORS,"You must pass something";
93 pod2usage(join("\n",@USAGE_ERRORS)) if @USAGE_ERRORS;
103 print STDERR "No directory named '$mb'\n";
106 for my $nc (qw(new cur)) {
107 if (not -d "$mb/$nc") {
108 print STDERR "This probably isn't a mailbox; no '$nc' directory inside\n";
111 my $dir = IO::Dir->new("$mb/$nc") or
112 die "Unable to open directory '$mb/$nc' for reading: $!";
114 while (defined ($message = $dir->read())) {
115 my $msg_id = get_message_id("$mb/$nc/$message");
116 if (not defined $msg_id) {
117 print STDERR "No message id for $mb/$nc/$message\n" if $DEBUG;
120 print STDERR "$mb/$nc/$message is $msg_id\n" if $DEBUG;
121 push @{$messages{$msg_id}},"$mb/$nc/$message";
126 # handle duplicated messages
127 if (not $options{delete}) {
128 for my $dir ('','/new','/cur') {
129 if (not -d $options{move_to}.$dir) {
130 mkdir($options{move_to}.$dir) or
131 die "Unable to make directory $options{move_to}.$dir";
135 for my $msg_id (keys %messages) {
136 # if there is only one message with this message id, do nothing.
137 next unless @{$messages{$msg_id}} > 1;
138 # otherwise, we need to remove or move the message to the
140 for my $i (1..$#{$messages{$msg_id}}) {
141 my ($nc) = $messages{$msg_id}[$i] =~ /(new|cur)/;
143 if ($options{delete}) {
144 if ($options{simulate} or $options{verbose}) {
145 print "rm $messages{$msg_id}[$i] (duplicate of $msg_id $messages{$msg_id}[0])\n";
147 if (not $options{simulate}) {
148 unlink($messages{$msg_id}[$i]) or
149 die "Unable to unlink message $messages{$msg_id}[$i]";
152 if ($options{simulate} or $options{verbose}) {
153 print "mv $messages{$msg_id}[$i] $options{move_to}/$nc/. (duplicate of $msg_id $messages{$msg_id}[0])\n";
155 if (not $options{simulate}) {
156 move($messages{$msg_id}[$i],
157 "$options{move_to}/$nc/."
158 ) or die "Unable to move message $messages{$msg_id}[$i]";
167 my $fh = IO::File->new($message,'r') or
168 die "Unable to open $message for reading: $!";
175 if (/^Message-Id:\s+(<?)(\S+)\1/i) {