Script to Migrate pop3 mails to IMAP server

#!perl
use Mail::IMAPClient;
use File::Path;
use Data::Dumper;
use Tie::File;

my $run_once = (($ARGV[2] eq 'run_once')? 1: 0);
my $revert_import = (($ARGV[2] eq 'revert_import')? 1: 0);
my $check_migration = (($ARGV[2] eq 'check_import')? 1: 0);

my %path_mails_to_export = ();
my %user = (
    mail => $ARGV[0],
    passwd => $ARGV[1],
);

print "\n". '-'x25,"##POP_TO_IMAP_1.5##",'-'x25, "\n";
die 'Mail User and password requires to migrate!'  if !($user{mail} && $user{passwd});

$user{mailServer} = (($user{mail}) =~ m/\@(.+)$/? 'mail.'.$1: undef);
die 'Can not indentify mail server'  if not defined $user{mailServer};

print 'Initializing IMAP Server and do connect...';

my %connect_config = (
    Server   => $user{mailServer},
    User     => $user{mail},
    Password => $user{passwd},
);

my $imap = new Mail::IMAPClient->new(%connect_config);
print 'Cant connect to IMAP server!'
    and exit if $imap && not $imap->IsConnected;
print ' Done!'."\n"x2;

if ($revert_import) {
    revert_import();
    exit;
}

if ($check_migration) {
    check_migration();
    exit;
}

my $target_directory = 'inc/database';
$email_path = mail_to_folder($user{mail});

#prepare files to port
$target_directory .= '/'. $email_path;

#exiting
print 'Can not find the specified email folder->'.$target_directory.'     Aborted!!', "\n"x2 and exit if !-d $target_directory;

opendir (my $mails_fh, $target_directory) || die 'Can not open '.$target_directory. 'for some reason    Aborting!';
my $exclude_folders = join '|', qw{attachments _infos};

# print $exclude_folders and exit;
my @folders_to_export = grep { !/^\./ && !/$exclude_folders/ } readdir($mails_fh)
    and print 'Exclude folders: ', $exclude_folders."\n"x2;

print 'Parsing old mails folders...';
#FIXME::Só ta lendo o primeiro folder

foreach (@folders_to_export){
    my @files = ();
    opendir (my $fh_mails, my $directories_to_parse =  "$target_directory/$_") || die 'Can not open '."$target_directory/$_". 'for some reason    Aborting!';
    if (-d $target_directory) {
        @files =  map { $directories_to_parse."/$_" } grep { !/^\./ } readdir $fh_mails;

    }

    @{$path_mails_to_export{$_}} = @files;
}
print ' Done!'."\n"x2;

#Going loco by doing this dude!
my $count = 0 ;
my %folders_to_file_fail = ();
my $copy_done;

#########################
####### Acontece aqui ###
#########################
migrate(%path_mails_to_export);
#########################
#########################
print '-'x55,"\n";

if (defined $copy_done) {
    my $folders_fails = keys %folders_to_file_fail;
    print "Can not migrate Thoses Files below:";

    foreach (@{$folders_fails}) {
        print "Folder: $_\n";
        print $folders_to_file_fail{$_}, "\n";
    }

    print "Trying to Migrate again!\n";
    #migrate(%folders_to_file_fail);
}

print $count .' Files  imported on account-> '. $user{mail}, "\n";
print '#'x50, "\n";

# functions!
sub mail_to_folder {
    my ($email) = @_;
    return if not $email;

    my $email_path = $email;
    $email_path =~ s{\@}{\_};

    return $email_path.'_173.201.191.20'  if !$@;
}

sub fetch_mail_info($) {
    my ($file_name) = @_;
    my $file;
    my $mail_date = '';

    -f $file_name || return;
    tie my @file, 'Tie::File', $file_name || die 'Cant read the '. $file_name.' for some reason     Aborting!';
    $file = join "\n", @file or return undef, undef;

    foreach(@file) {
        $mail_date = ( $_ =~ m{^Date\:\s*(.+)$}m )? $1: undef;
        if (defined $mail_date) {
            if ($mail_date =~ m{(\d\d?)\s*(\w\w\w)\s*(\d\d\d\d)\s*(\d\d\:\d\d\:\d\d)\s*([\-|\+]\d\d\d\d)}){
                $mail_date = "$1-$2-$3 $4 $5";
                $mail_date = '0'.$mail_date  if $mail_date =~ m{^\d\-};

                return $file, $mail_date;
            }
        }
    }
}

sub migrate($) {
    my (%path_mails_to_export) = @_;
    my @folders_to_export = keys %path_mails_to_export;

    foreach my $folder (@folders_to_export) {
        my $folder_fail = ();
        $copy_done = undef;
        my $imap_mail_path = 'INBOX.Importados.'.ucfirst($folder);

        my $folder_exists = $imap->create($imap_mail_path) if !$imap->exists($imap_mail_path);
        print "Folder $folder created!\n" if $folder_exists;
        print "Folder $folder already exists! Can not Create!\n" if !$folder_exists;

        die 'Can not create INBOX/Importados'  if !$imap->exists($imap_mail_path);

        my @files_to_append = grep { -f } @{$path_mails_to_export{$folder}};
        foreach (@files_to_append){
            reconnect();

            my ($mail_file, $mail_date) = fetch_mail_info($_);

            if ( not defined $mail_file or not defined $mail_date) {
                print "Can not Copy:\n\t$_  \n\tERROR::because the mail file or mail date (or both) is undefined ---  Move to Next Mail File\n\n";
                push @{$folder_fail}, $_  if not defined $copy_done;
                next;
            }

            print "Copying file:\n\t$_\n\tInto folder:\n\t $imap_mail_path";
            $copy_done = $imap->append_string($imap_mail_path, $mail_file, undef, $mail_date) and print '       Done!',"\n"x2;

            push @{$folder_fail}, $_  if not defined $copy_done;

            sleep(0.3);
            exit  if $run_once;
        }

        push @{$folders_to_file_fail{$folder}}, @{$folder_fail}  if not defined $copy_done;
        print scalar @files_to_append, ' files Copied into: '. $folder, "\n\n";
        $count += scalar @files_to_append;
    }
}

sub revert_import() {
    print 'Undo import to user: ', $user{mail}, "\n";
    reconnect();
    my @folders = $imap->folders('INBOX.Importados'); # hardcoded!
    print 'There is no subdirectories in INBOX.Importados'."\n" and  return  if scalar @folders == 0;

    foreach my $folder (@folders) {
        reconnect();

        print 'Deleting emails from Folder', $folder, "\n" ;
        $imap->select($folder);

        my $uids_messages = $imap->messages($folder);
        foreach (@{$uids_messages}) {
            my $deleted = $imap->delete_message($_);
            print 'Message UID: ', $_, ' Deleted From Folder: ', $folder, "\n"  if defined $deleted;
        }
        print "\n"x2, 'Deleting Folder ', $folder, "\n"x2;

        my $deleted = $imap->delete($folder);
        print "Folder: $_ deleted"  if !$deleted;
        print "Folder: $_ Not Deleted"  if defined $deleted;
        print "\n";
    }

    print 'Importation reverted!';
}

sub check_migration() {
    my $already_migrate = $imap->folders('INBOX.Importados');

    print $user{mail}, ' MIGRATED!'         if scalar @{$already_migrate} > 0;
    print $user{mail}, ' NOT MIGRATED!'     if scalar @{$already_migrate} <= 0;
}


sub reconnect {
    CONNECT:
        $imap = new Mail::IMAPClient->new(%connect_config)
            if !$imap->IsConnected;
    goto CONNECT  if !$imap->IsConnected;

    return 1;
}

__DATA__
::USAGE::
deprecated::pop_to_imap.pl EMAIL SENHA [run_once, revert_import, check_import]
perl_hash_mails_account.pl -> percorre um hash passando chave->valor como argumento para este arquivo