#!/usr/bin/perl
#
# migrate.pl
#
# This simple Perl script will copy all folders of a supplied mailbox 
# from a source IMAP server to a destination IMAP server. It tries to
# preserve all message flags.
#
# (c) 2004-2005 Henning Holtschneider <henning@loca.net>

use Getopt::Std;
use Mail::IMAPClient;
use Term::ReadLine;
use Term::ProgressBar;

$| = 1;

getopts('hHf');

if ($opt_h or $opt_H) {

    print "Usage: $0 [-h|-H|-f]:\n\n";
    print " -f     only create folders, don't copy messages\n\n";
    print " -h|-H  print this help message\n";
    print "all command line switches are optional\n\n";

    exit;

}

$term = new Term::ReadLine 'migrate.pl';

my $source_host =          $term->readline("Source host >", "");
my $source_id =            $term->readline("Source username >", "");
my $source_password =      $term->readline("Source password >", "");

my $destination_host =     $term->readline("Destination host >", "");
my $destination_id =       $term->readline("Destination username >", "");
my $destination_password = $term->readline("Destination password >", "");

print "Logging into source server $source_host: ";
$source_imap = Mail::IMAPClient->new (
				      Server => $source_host,
				      User    => $source_id,
				      Password => $source_password,
				      ) or die "Cannot connect to $source_host as $source_id: $@\n";
print "success!\n";
$source_imap->Peek(True);

print "Logging into destination server $destination_host: ";
$destination_imap = Mail::IMAPClient->new (
				      Server => $destination_host,
				      User    => $destination_id,
				      Password => $destination_password,
				      ) or die "Cannot connect to $destination_host as $destination_id: $@\n";
print "success!\n";

my @source_folders = $source_imap->folders() or die "Folder listing failed on $source_host: $@\n";
my @destination_folders = $destination_imap->folders() or die "Folder listing failed on $destination_host: $@\n";

print "Folders on source server:      " . join(", ",@source_folders) . ".\n\n";
print "Folders on destination server: " . join(", ",@destination_folders) . ".\n\n";

my $source_separator = "\\" . $source_imap->separator();
my $destination_separator =  $destination_imap->separator();

print "Separator on source server:      " . $source_separator . "\n";
print "Separator on destination server: " . $destination_separator . "\n";

foreach my $source_folder (@source_folders) {
    $destination_folder = $source_folder;
    $destination_folder =~ s/$source_separator/$destination_separator/g;
    $source_imap->select($source_folder) or die "Select failed on $source_host: $@\n";;
    if (!$destination_imap->exists($destination_folder)) {
	print "Creating new folder $destination_folder on $destination_host.\n";
	$destination_imap->create($destination_folder) or die "Create of $destination_folder failed on $destination_host: $@\n";
    }

    if (!$opt_f) {
	my @messages = $source_imap->search('ALL');
    
	if ($source_imap->message_count() > 0) {

	    print "Copying " . $source_imap->message_count . " messages\nfrom \{$source_host\}$source_folder\nto \{$destination_host\}$destination_folder :\n";

	    $progress = Term::ProgressBar->new ({ count => $source_imap->message_count() });

	    my $count = 1;
	    foreach my $message (@messages) {
		$destination_imap->append_string($destination_folder, $source_imap->message_string($message), $source_imap->flags($message)) or "Append to $source_folder failed on $destination_host: $@\n";
		$progress->update();
	    }
	    print "\n";

	    undef ($progress);
	}
    }

}

$source_imap->close();
$destination_imap->close();
