#!"C:/Program Files/InstantServers/ISMail/Perl/5.00503/bin/MSWin32-x86/perl" -w
#
# migrate.pl - migrate messages from one IMAP account to another
# - Accounts may be on same or different machines.
# - Destination folders will be created if needed.
# - Migrate all folders, or specified folders only
#

use Mail::IMAPClient();

# Version stamp
my $VERSION = "1.02";

my %src = 
  (
   'server' => '127.0.0.1',
   'port' => 143,
   'user' => '',
   'pwd' => '',
   'folder' => '',
   'all' => '1',
 );

my %dst = 
  (
   'server' => '127.0.0.1',
   'port' => 143,
   'user' => '',
   'pwd' => '',
   'folder' => '',
   'all' => '1',
  );

my ($nargs, $arg, $i);
my $test = 0;
my $debug = 0;
my $verbose = 0;

# TEST params
if ($test) {
  $src{'server'} = '127.0.0.1';
  $src{'user'} = 'test@127.0.0.1';
  $src{'pwd'} = 'test';
  $dst{'server'} = '127.0.0.1';
  $dst{'user'} = 'dst@127.0.0.1';
  $dst{'pwd'} = 'dst';
}



# IMAP server login
my $do_login = sub {
  $server = shift;
  $user = shift;
  $pwd = shift;

  # N.B. Setup the long way to avoid complaint about no Fast_io
  my $imap = Mail::IMAPClient->new() or die "Cannot create Mail::IMAPClient: $@\n";
  $imap->Server($server) or die "Cannot set server to $server: $@\n";
  $imap->User($user) or die "Cannot set user to $user: $@\n";
  $imap->Password($pwd) or die "Cannot set password: $@\n";
  $imap->Fast_io(0);
  $imap->connect or die "Could not connect: $@\n";
  $imap->Debug(1) if $debug;

  return $imap;
};

# IMAP server logout
my $do_logout = sub {
  my $imap = shift;

  return if !defined($imap) or !$imap;
  $imap->disconnect or die "Could not close: $@\n";
};

my $do_migrate = sub {
  my @folders = shift(@_);
  my ($f, @f);

  if (!$imap_src->Connected()) {
    print "Could not connect to $src{'server'}, user $src{'user'}..ignoring\n";
    return 0;
  }
  if (!$imap_dst->Connected()) {
    print "Could not connect to $dst{'server'}, user $dst{'user'}...ignoring\n";
    return 0;
  }

    
  # Folders to migrate
  if ($#folders < 0 or (($#folders == 0) and (!$folders[0]))) {
    @f = $imap_src->folders();
  } else {
    @f = @folders;
  }
    
  print "Starting migration:\n" if $verbose;
  foreach $f (@f) {

    # N.B. attempt create but ignore results. Handles sub-folders
    $imap_dst->create($f);

    # Migrate folder, and subscribe to it
    print " $f..." if $verbose;
    $imap_src->examine($f);
    $imap_src->migrate($imap_dst, "ALL", undef);
    $imap_dst->subscribe($f);

    if ($imap_dst->exists($f)) {
      print "done\n" if $verbose;
    } else {
      print " FAILED\n" if $verbose
    }

  }
};



#
# Main
#

$nargs = scalar @ARGV;
if ($nargs < 1) {
  print "Usage: migrate.pl -s1 src -u1 src_user -w1 src_pwd -p1 src_port -s2 dst -u2 dst_user -w2 dst_pwd -p2 dst_port -v\n";
  print "Migrate IMAP messages from server 'src' to server 'dst' (may be the same server or IP address)\n";
  print "All 'src_user' folders are migrated (copied) to folders of same name for 'dst_user'\n";
  print "Destination folders are created, if necessary\n";
  print "Use '-v' for verbose output\n";
  exit;
}
while ($nargs > 0) {
  $arg = $ARGV[$i++];
  --$nargs;

  # Switches without arguments
  if ($arg eq '-v') {
    $verbose = 1;
    next;
  }

  #
  # Switches with arguments follow...
  next if ($nargs < 1);
  
  if ($arg eq '-s1') {
    $src{'server'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-u1') {
    $src{'user'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-w1') {
    $src{'pwd'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-p1') {
    $src{'port'} = $ARGV[$i++];
    --$nargs;
  }

  if ($arg eq '-s2') {
    $dst{'server'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-u2') {
    $dst{'user'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-w2') {
    $dst{'pwd'} = $ARGV[$i++];
    --$nargs;
  }
  if ($arg eq '-p2') {
    $dst{'port'} = $ARGV[$i++];
    --$nargs;
  }
}
if ($nargs > 0) {
  print "Unknown arg: $ARGV[$i]\n";
}


print "Logging in to $src{'server'}, user $src{'user'}\n";
$imap_src = &$do_login($src{'server'}, $src{'user'}, $src{'pwd'});

print "Logging in to $dst{'server'}, user $dst{'user'}\n";
$imap_dst = &$do_login($dst{'server'}, $dst{'user'}, $dst{'pwd'});

&$do_migrate('');

print "Logging out of $src{'server'}, user $src{'user'}\n";
&$do_logout($imap_src);

print "Logging out of $dst{'server'}, user $dst{'user'}\n";
&$do_logout($imap_dst);