#$Id$
#
# An example of how to migrate from a Netscape server
# (which uses a slash as a separator and which does
# not allow subfolders under the INBOX, only next to it)
# to a Cyrus server (which uses a dot (.) as a separator
# and which requires subfolders to be under "INBOX").
# There are also some allowed-character differences taken
# into account but this is by no means complete AFAIK.
#
# This is an example. If you are doing mail migrations 
# then this may in fact be a very helpful example but
# it is unlikely to work 100% correctly as-is. 
# A good place to start is by testing a rather large-volume
# transfer of actual mail from the source server with the
# -v option turned on and redirect output to a file for
# perusal. Examine the output carefully for unexpected
# results, such as a number of messages being skipped because
# they're already in the target folder when you know darn
# well this is the first time you ran the script. This
# would indicate an incompatibility with the logic for
# detecting duplicates, unless for some reason the source 
# mailbox contains a lot of duplicate messages to begin with.
# (The latter case is an example of why you should use an
# actual mailbox stuffed with actual mail for test; if you
# generate test messages and then test migrating those you
# will only prove that your test messages are migratable.
# 
# Also, you may need to play with the rules
# for translating folder names based on what kind of
# names your target server and source server support.
#
# You may also need to play with the logic that determines
# whether or not a message has already been migrated, 
# especially if your source server has messages that 
# did not come from an SMTP gateway or something like that.
#
# Some servers allow folders to contain mail and subfolders,
# some allow folders to only contain either mail or subfolders.
# If you are migrating from a "mixed use" type to a "single use"
# type server then you'll have to figure out how to deal 
# with this. (This script deals with this by creating folders like
# "/blah_mail", "/blah/blah_mail", and "/blah/blah/blah_mail"
# to hold mail if the source folder contains mail and subfolders
# and the target server supports only single-use folders. 
# You may not choose a different strategy.)
#
# Finally, it's possible that in some server-to-server
# copies, the source server supports messages that the
# target server considers unacceptable. For example, some
# but not all IMAP servers flat out refuse to accept 
# messages with "base newlines", which is to say messages
# whose lines are match the pattern /[^\r]\n$/. There is
# no logic in this script that deals with the situation;
# you will have to identify it if it exists and figure
# out how you want to handle it.
# 
# This is probably not an exhaustive list of issues you'll
# face in a migration, but it's a start.
#
# If you're just migrating from an old version to a newer
# version of the same server then you'll probably have
# a much easier time of it.
#
#

use Mail::IMAPClient;
use Data::Dumper;
use IO::File;
use File::Basename ;
use Getopt::Std;
use strict;
use vars qw/     $opt_B $opt_D $opt_T $opt_U
        $opt_W $opt_b $opt_d $opt_h
        $opt_t $opt_u $opt_w $opt_v
        $opt_s $opt_S $opt_W $opt_p
        $opt_P $opt_f $opt_F $opt_m 
        $opt_M
/;

getopts('vs:S:u:U:dDb:B:f:F:w:W:p:P:t:T:hm:M:');

if ( $opt_h ) {
    print STDERR <<"HELP";

$0 -     an example script demonstrating the use of the Mail::IMAPClient's
    migrate method.

Syntax:
    $0 -s source_server -u source_user -w source_password -p source_port \
       -d debug_source -f source_debugging_file -b source_buffsize       \
       -t source_timeout -m source_auth_mechanism                        \
       -S target_server -U target_user -W target_password -P target_port \
       -D debug_target -F target_debugging_file -B target_buffsize       \
       -T target_timeout -M target_auth_mechanism                        \
       -v

where "source" refers to the "copied from" mailbox, target is the 
"copied to" mailbox, and -v turns on verbose output.
Authentication mechanisms default to "PLAIN".

HELP
    exit;
}
$opt_v and ++$|;
print "$0: Started at ",scalar(localtime),"\n" if $opt_v;

$opt_p||=143;
$opt_P||=143;

# Make a connection to the source mailbox:
my $imap = Mail::IMAPClient->new(
                Server  => $opt_s,
                User    => $opt_u,
                Password=> $opt_w,
                Uid    => 1,    
                Port    => $opt_p,    
                Debug    => $opt_d||0,
                Buffer    => $opt_b||4096,
                Fast_io    => 1,
                ( $opt_m ? ( Authmechanism => $opt_m) : () ),
                Timeout    => $opt_t,     
                ($opt_f ? ( Debug_fh=>IO::File->new(">$opt_f" )) : ()),
) or die "$@";

# Make a connection to the target mailbox:
my $imap2 = Mail::IMAPClient->new(    
                Server  => $opt_S,
                User    => $opt_U,
                Password=> $opt_W,
                Port    => $opt_P,
                Uid    => 1,    
                Debug    => $opt_D||0,
                ( $opt_M ? ( Authmechanism => $opt_M) : () ),
                ($opt_F ? ( Debug_fh=>IO::File->new(">$opt_F")) : ()),
                Buffer    => $opt_B||4096,
                Fast_io    => 1,
                Timeout    => $opt_T,             # True value
) or die "$@";

# Turn off buffering on debug files:
$imap->Debug_fh->autoflush;
$imap2->Debug_fh->autoflush;

# Get folder hierarchy separator characters from source and target:
my $sep1 = $imap->separator;
my $sep2 = $imap2->separator;

# Find out if source and target support subfolders inside INBOX:
my $inferiorFlag1 = $imap->is_parent("INBOX");
my $inferiorFlag2 = $imap2->is_parent("INBOX");

# Set up a test folders to see if the source and target support mixed-use
# folders (i.e. folders with both subfolders and mail messages):
my $testFolder1 = "Migrate_Test_$$" ;        # Ex: Migrate_Test_1234
$testFolder1 = $inferiorFlag2 ? 
        "INBOX" . $sep2 . $testFolder1  : 
        $testFolder1 ;

# The following folder will be a subfolder of $testFolder1:
my $testFolder2 = "Migrate_Test_$$" . $sep2 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag2 ? "INBOX" . $sep2 . $testFolder2  : $testFolder2 ;

$imap2->create($testFolder2) ;    # Create the subfolder first; RFC2060 dictates that
                # the parent folder should be created at the same time


# The following line inspired the selectable method.  It was also made obsolete by it,
# but I'm leaving it as is to demonstrate use of lower-level method calls:
my $mixedUse2 = grep(/NoSelect/i,$imap2->list("",$testFolder1))? 0 : 1;

# Repeat the above with the source mailbox:
$testFolder2 = "Migrate_Test_$$" . $sep1 . "Migrate_test_subfolder_$$" ;
$testFolder2 = $inferiorFlag1 ? "INBOX" . $sep1 . $testFolder1  : $testFolder1 ;

$imap->create($testFolder2) ;

my $mixedUse1 = grep(/NoSelect/i,$imap->list("",$testFolder1))? 0 : 1;

print     "Imap host $opt_s:$opt_p uses a '$sep1' as a separator and ",
    ( defined($inferiorFlag1) ? "allows " : "does not allow "), 
    "children in the INBOX. It supports ",
    ($mixedUse1?"mixed use ":"single use "), "folders.\n" if $opt_v;

print     "Imap host $opt_S:$opt_P uses a '$sep2' as a separator and ",
    ( defined($inferiorFlag2) ? "allows " : "does not allow "), 
    "children in the INBOX. It supports ",
    ($mixedUse2?"mixed use ":"single use "), "folders.\n" if $opt_v;

for ($testFolder1,$testFolder2) {$imap->delete($_); $imap2->delete($_);}

my($totalMsgs, $totalBytes) = (0,0);

# Now we will migrate the folder. Here we are doing one message at a time
# so that we can do more granular status reporting and error checking.
# A lazier way would be to do all the messages in one migrate method call
# (specifying "ALL" as the message number) but then we wouldn't be able
# to print out which message we were migrating and it would be a little 
# bit tougher to control checking for duplicates and stuff like that.
# We could also check the size of the message on the target right after 
# the migrate as an extra safety check if we wanted to but I didn't bother
# here. (I saved as an exercise for the reader. Yeah! That's it! An exercise!)

# Iterate over all the folders in the source mailbox:
for my $f ($imap->folders) { 
    # Select the folder on the source side:
    $imap->select($f) ; 

    # Massage the foldername into an acceptable target-side foldername:
    my $targF = "";
    my $srcF = $f;
    $srcF =~ s/^INBOX$sep1//i;
    if ( $inferiorFlag2 ) {
        $targF = $srcF eq "INBOX" ? "INBOX" : "INBOX.$f" ;
    } else {
        $targF = $srcF ;
    }

    $targF =~ s/$sep1/$sep2/go unless $sep1 eq $sep2;
    $targF =~ tr/#\$\& '"/\@\@+_/;
    if ( $imap->is_parent($f) and !$mixedUse2 ) {
        $targF .= "_mail" ;
    }
    print "Migrating folder $f to $targF\n" if $opt_v;

    # Create the (massaged) folder on the target side:
    unless ( $imap2->exists($targF) ) {
        $imap2->create($imap2->Massage($targF))
            or warn "Cannot create $targF on " . $imap2->Server . ": $@\n" and next;
    }

    # ... and select it
    $imap2->select($imap2->Massage($targF))  
            or warn "Cannot select $targF on " . $imap2->Server . ": $@\n" and next;

    # now that we know the target folder is selectable, we can close it again:
    $imap2->close; 
    my $count = 0;
    my $expectedTotal = $imap->message_count($f) ;

    # Now start iterating over all the messages on the source side...
    for my $msg ($imap->messages) {
        ++$count; 
        my $h = "";
        # Get some basic info about the message:
        eval { $h = ($imap->parse_headers($msg,"Message-id")||{})->{'Message-id'}[0]};
        my $tsize = $imap->size($msg);
        my $ret = 0 ; my $h2 = [];

        # Make sure we didn't already migrate the message in a previous pass:
        $imap2->select($targF);
        if (     $tsize and $h and $h2 = $imap2->search( 
                    HEADER     => 'Message-id'    => $imap2->Quote($h),
                    NOT     =>  SMALLER     => $tsize, 
                    NOT    =>  LARGER    => $tsize
            )
        ) {
            print      
                "Skipping $f/$msg to $targF. ",
                "One or more messages (" ,join(", ",@$h2),
                ") with the same size and message id ($h) ",
                "is already on the server. ",
                "\n" 
            if $opt_v;
            $imap2->close;

        } else {

            print      
                "Migrating $f/$msg to $targF. ",
                "Message #$count of $expectedTotal has ",
                $tsize , " bytes.",
                "\n" if $opt_v;
            $imap2->close;

            # Migrate the message:
            my $ret = $imap->migrate($imap2,$msg,"$targF") ;
            $ret and ( $totalMsgs++ , $totalBytes += $tsize);
            $ret or warn "Cannot migrate $f/$msg to $targF on " . $imap2->Server . ": $@\n" ;
        }
    }
}

print "$0: Finished migrating $totalMsgs messages and $totalBytes bytes at ",scalar(localtime),"\n" 
    if $opt_v;
exit;


=head1 AUTHOR 
    
David J. Kernen

The Kernen Group, Inc.

[email protected]

=head1 COPYRIGHT

This example and Mail::IMAPClient are Copyright (c) 2003 
by The Kernen Group, Inc. All rights reserved.

This example is distributed with Mail::IMAPClient and 
subject to the same licensing requirements as Mail::IMAPClient.

imtest is a utility distributed with Cyrus IMAP server, 
Copyright (c) 1994-2000 Carnegie Mellon University.  
All rights reserved. 

=cut

#$Log: migrate_mail2.pl,v $
#Revision 19991216.4  2003/06/12 21:38:33  dkernen
#
#Preparing 2.2.8
#Added Files: COPYRIGHT
#Modified Files: Parse.grammar
#Added Files: Makefile.old
#    Makefile.PL Todo sample.perldb
#    BodyStructure.pm
#    Parse.grammar Parse.pod
#     range.t
#     Thread.grammar
#     draft-crispin-imapv-17.txt rfc1731.txt rfc2060.txt rfc2062.txt
#     rfc2221.txt rfc2359.txt rfc2683.txt
#