#!/usr/bin/perl
# 2003 Michael Fischer v. Mollard
#
# Durchsucht einen Folder IMAP Server nach Nachrichten mit doppelter Message_id
# und markiert die überschüssigen als gelöscht.

# Änderungen:
# 08.09.2003	fvm	Sucht jetzt nur noch in nicht als gelöscht markierten
#			Nachrichten nach Duplikaten

# 	$Id: cyrus_search_dups.pl,v 1.5 2003/11/06 12:46:30 fvm Exp $

# Versionsbeschreibungen
my ($nonsense2, $version) = split ' ',"\$Revision: 1.5 $$";
my ($nonsense1, $date1, $date2)=split ' ',"\$Date: 2003/11/06 12:46:30 $$";
my $date = join ' ', $date1, $date2;
my $author="Michael Fischer v. Mollard";
my $mailto="fvm\@heise.de";    

use Mail::IMAPClient;
use Getopt::Std;
use strict;

# Konstanten
my $IMAPSERVER='localhost';
my %arguments;
my ($imap,$folderstructref,@dup_ids);

sub usage(){
    print  <<EOF;
Searches for duplicate Messages in a given Folder on an IMAP Server
(same Message Id and same Date)

Usage: $0 -u user -p password -f folder [-h server]  [-d]

-u	Username
-p	password
-f	folder
-h	server		(default: $IMAPSERVER)
-d	delete 		(default: display only)

EOF
    exit;
}

sub delete_dups(){
    my $SPLICE_LENGTH = 100;
    my @dupid_splice;
    while ($#dup_ids>=0){
	@dupid_splice = splice(@dup_ids, 0, $SPLICE_LENGTH);
	$imap->delete_message(@dupid_splice);
    }
}

sub search_dubs($){
    my $folder = @_[0];
    my ($hashref,@all_ids);
    my $SPLICE_LENGTH = 100; 
    
    $imap->select($folder) or die "$folder nicht gefunden!\n";

    @all_ids=$imap->search("NOT DELETED");
    
    # Ich muss die Abfrage zerlegen, weil mich sonst bei zu großen
    # Anfragen der IMAP Server rauswirft (BYE word to long)
    while ($#all_ids>=0){
	my @id_splice= splice(@all_ids,0,$SPLICE_LENGTH);
	$hashref = $imap->parse_headers(\@id_splice ,"Date","Message-ID","Subject","To");
	# Hash aufbauen, das die Message ID als schlüssel hat und als Wert
	# ein Array von Ergebnissen der parse_headers Funktion. Wenn es nur ein
	# Element gibt, ist die Nachricht eindeutig.
	foreach my $uid (@id_splice){
	    if ($folderstructref->{$hashref->{$uid}->{'Message-ID'}->[0]}){
		# Falls ein kapputter Client die Message-ID recycled, sollte wenigstens
                # das Datum anders sein
		if ($hashref->{$uid}->{'Date'}->[0] eq $folderstructref->{$hashref->{$uid}->{'Message-ID'}->[0]}[0]{'Date'}[0]){
		    push @{$folderstructref->{$hashref->{$uid}->{'Message-ID'}->[0]}}, $hashref->{$uid};
		    push @dup_ids,$uid;
		}
	    }
	    else{
		push @{$folderstructref->{$hashref->{$uid}->{'Message-ID'}->[0]}}, $hashref->{$uid};
	    }
	}
    }
}

sub print_dups(){
    my ($message_id,$dup_group,$i);
    $dup_group=1;
    foreach $message_id (keys %$folderstructref){
	if (scalar(@{$folderstructref->{$message_id}})>1){
	    print ("Dup group #$dup_group\n");
	    for ($i=0;$i<scalar(@{$folderstructref->{$message_id}});$i++){
		print "\t$folderstructref->{$message_id}[$i]{'Date'}[0]\t$folderstructref->{$message_id}[$i]{'Subject'}[0]\n";
	    }
	    $dup_group++;
	}
    }
}


my $result=getopts('f:u:p:h:d',\%arguments);

if ($result==0){
    usage();
}

if (!$arguments{'u'} || !$arguments{'p'}){
    usage();
}

my $imapserver=$arguments{'h'}?$arguments{'h'}:$IMAPSERVER;


$imap = Mail::IMAPClient->new( Server => $imapserver,
			       User   => $arguments{'u'},
			       Password => $arguments{'p'},
			       )
    or die "Can't connect to $imapserver!\n";



print "Searching for dups in $arguments{'f'}\n";
search_dubs($arguments{'f'});
print_dups();
if ($arguments{'d'}){
    delete_dups();
}