I have the following code that is supposed to take mail from a Thunderbird MBOX store and upload them to an IMAP server. Yes, I know Thunderbird can theoretically do this on it's own, but it is not working reliably for many of my users, so I need to do it manually. The following code works, up to a point. On very large mail stores, it eventually runs out of memory even on a machine with 32Gb of Ram. Any help solving the out of memory issue would be greatly appreciated.

#!/usr/bin/perl
use strict;
use warnings;
use Mail::Mbox::MessageParser;
use Net::Imap::Client;
use File::Glob;
use IO::Socket::SSL;
use Getopt::Long;
use File::Basename;
use Date::Parse;


my $imap_folder = "Imported";
my $source_folder = ".\\";
my $imap_user = 'example';
my $imap_pwd = 'examplePW';
my $imap_server = 'mail.example.com';


GetOptions ('imap_folder|i=s'   => \$imap_folder,
            'source_folder|s=s' => \$source_folder,
            'user|u=s'          => \$imap_user,
            'password|p=s'      => \$imap_pwd);

if (! $imap_pwd || ! $imap_user) {
  print "\nMust specify --user & --password (or -u & -p)\n\n";
}

my $prev_folder;

Mail::Mbox::MessageParser::SETUP_CACHE( { 'file_name' => 'imapcache.da
+t' } );

#$File::Glob::Windows::sorttype = 1;
#$File::Glob::Windows::nocase = 1;
#$File::Glob::Windows::encoding = File::Glob::Windows::getCodePage();

#print "Encoding: $File::Glob::Windows::encoding";

my @Months = ("Jan","Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","S
+ep","Oct","Nov","Dec");


my $imap = Net::IMAP::Client->new(
    user   => $imap_user,
    pass   => $imap_pwd,
    server => $imap_server,
    port => 143,
) || die "Cannot connect ($!)\n";

$imap->login or die('Login failed: ' . $imap->last_error);

 

#print "Folders:\n";
#foreach my $folder (@folders){  
#  print "- $folder\n";
#}
  
imap_make_folder($imap_folder);  
  
my @folders = $imap->folders; 

print "Folders:\n";
foreach my $folder (@folders){  
  print "- $folder\n";
}  
#print "- ", $_, "\n" for @flds;  
print "\n";

$imap->select($imap_folder) || die "Unable to select \"$imap_folder\":
+". $imap->last_error;
my $current_folder = $imap_folder;


scan_folder($source_folder);


sub scan_folder {
  my $folder = shift @_;
  if (! ($folder =~ m/\\$/) ) {
    $folder .= "\\";
  } 
  my @boxes = glob($folder."*");
  foreach my $box (@boxes) {
    if ( ($box =~ /\.msf$/) || ($box =~ /\.$/) || ($box =~ /\.\w{3}$/)
+ ) {
      next;
    } elsif (-f $box) {
      process_mbox ($box);
    }
  }
}

sub process_mbox {
  my $mbox_file = shift @_;
  my $imap_folder = basename($mbox_file);
  imap_make_folder($current_folder."/".$imap_folder);
  $prev_folder = $current_folder;
  $current_folder .= "/".$imap_folder; 
  $imap->select($current_folder) || die "Unable to select \"$current_f
+older\":". $imap->last_error;
  if (-d $mbox_file.".sbd") {
    scan_folder($mbox_file.".sbd");
  }                                                                   
+          my $mbox_fh = new FileHandle($mbox_file);
  my $mbox_reader = new Mail::Mbox::MessageParser( {
      'file_name'    => $mbox_file,
      'file_handle'  => $mbox_fh,
      'enable_cache' => 1,
      'enable_grep'  => 1,
    } );
  die $mbox_reader unless ref $mbox_reader;
  while (!$mbox_reader->end_of_file() ) {
    my $message = $mbox_reader->read_next_email();
    #print "Message: $$message\n";
#    my $mtext = $$message;
    my ($date) = $$message =~ m/From - (.*)\n/i;
    $date =~ s/(\r|\n)//g;
    my ($ss,$mm,$hh,$day,$month,$year,$zone) = strptime($date);
    $year +=1900;
    $date = "$day-".$Months[$month]."-$year $hh:$mm:$ss -0600";
    print "Folder: $current_folder Date: $date\n"; 
    my @flags = ("\\Seen",);
    $imap->append($current_folder,$message,\@flags,$date) || die "Unab
+le to append message: ". $imap->last_error;
    undef $message;
  }
  $current_folder = $prev_folder;
  #$imap->select($current_folder) || die "Unable to select \"$current_
+folder\":". $imap->last_error;
  #print "Current Folder: "
  #print "$mbox_file\n";  
  undef $mbox_reader;
  undef $mbox_fh
}

sub imap_make_folder {
  my $folder = shift @_;
  my @folders = $imap->folders;
  if (! (grep $_ eq $folder,@folders)  ) {
    $imap->create_folder($folder) || die "Unable to create folder \"$f
+older\" : ". $imap->last_error;
  }
}
[download]