use warnings;
use strict;
use Data::Dumper;
use Mail::MboxParser;
use IMAP::Client;
use Mail::IMAPClient;


my $base_dir    = ".thunderbird/profile_path/Mail/Local Folders/";
my $imap_server = "localhost";
my $imap_user   = "username";
my $imap_pass   = "password";
my $parseropts = {
        enable_cache    => 0,
        enable_grep     => 0,
        cache_file_name => 'cache-file',
};

my $skip_deleted = 1;

my $imap = Mail::IMAPClient->new(
                        Server   => $imap_server,
                        User     => $imap_user,
                        Password => $imap_pass,
)       or die "Cannot connect to $imap_server as $imap_user: $@";

parse_dir($base_dir);

sub parse_dir {
        my $dir = shift;
        opendir my $dir_h, $dir
                or die "Unable to opendir $dir: $!\n";
        print "Reading directory $dir\n";


        ##Dirty, probably IMAP-server dependent stuff.
        #This stuff is for dovecot.
        my $temp_dir = $dir;
        $temp_dir =~ s!\.sbd!!g;
        $temp_dir =~ s!^$base_dir!!;
        $temp_dir =~ s!^/!!;
        $temp_dir =~ s!/!.!g;
        print "Making dir $temp_dir\n";
        $imap->create($temp_dir);

        foreach my $directory (grep /\.sbd$/, readdir $dir_h) {
                parse_dir($dir."/".$directory);
        }
        seekdir($dir_h, 0);
        foreach my $mail_file (grep !/^\./, grep !/(\.html|\.sbd|\.msf|\.dat)$/, readdir $dir_h) {
                my $mf = $dir."/".$mail_file;
                print "Going to parse $mf\n";
                my $mb = Mail::MboxParser->new($mf,
                                                decode     => 'ALL',
                                                parseropts => $parseropts);
                for my $msg ($mb->get_messages) {
                        print "Appending msg " . $msg->header->{subject} . " to $temp_dir.$mail_file\n";
                        #Skip deleted messages...
                        unless($skip_deleted and (hex($msg->header->{"x-mozilla-status"}) & 0x0008)) {
                                $imap->append_string($temp_dir.".".$mail_file, $msg)
                                        or die "Couldn't append \n====\n$msg\n====\n to $temp_dir.$mail_file: $@\n";
                        } else {
                                warn "Skipping " . $msg->header->{subject} . " - deleted message\n";
                        }

                }
        }
        closedir($dir_h);

}

Re: Mirror/Copy Mozilla thunderbird emails to IMAP server

davidrw

created: 2006-03-08 11:08:25

perlmonks

• reply
• node
• thread
• author

• node
• author
• thread

prlmnks

• node
• thread
• author

An alternative to the recursion and readdir's and grep's is [cpan://File::Find::Rule] (and you could probably do it in one statement, too, but i left it in the same general form as OP):

use File::Find::Rule;
my @dirs = ( $base_dir, File::Find::Rule->file()->directory()->name('*.sbd')->in( $base_dir ) );
foreach my $dir ( @dirs ){
  # do your $temp_dir munging here
  ...
  my @files = File::Find::Rule->file()->maxdepth(1)->not( File::Find::Rule->name('.*', '*.html', '*.sbd', '*.msf', '*.dat') )->in( $dir );
  foreach my $mail_file ( @files ){
    # do your $mail_file stuff here
    ...    
  }
}