Category: E-Mail Programs
Author/Contact Info /msg davis
Description:

This script works on Mozilla Thunderbird email stores, and attempts to upload the emails to an IMAP server. Right now, it's not finished, in that it doesn't upload the top-level emails (ie mails from Inbox, Sent etc). It handles subfolders of those just fine.

There's slso some dirty hackery to munge folder paths for dovecot. YMMV

Update: Fixed now, ie it correctly parses email in top-level folders. I'd still call it a quick-and-dirty script though. 

use warnings;
use strict;
use Data::Dumper;
use Mail::MboxParser;
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;
                $mf =~ s!//+!/!g;
                print "Going to parse $mf\n";
                my $mb = Mail::MboxParser->new($mf,
                                                decode     => 'ALL',
                                                parseropts => $parsero
+pts);
                for my $msg ($mb->get_messages) {
                        #Skip deleted messages...
                        my $folder_name = $temp_dir.".".$mail_file;
                        $folder_name =~ s!//+!/!g;

                        unless($skip_deleted and (hex($msg->header->{"
+x-mozilla-status"}) & 0x0008)) {
                                print "Appending msg " . $msg->header-
+>{subject} . " to $folder_name\n";
                                $folder_name =~ s/^\.//;
                                $imap->create($folder_name)
                                        or warn "unable to create $fol
+der_name: $@\n";
                                unless($imap->append_string($folder_na
+me, $msg)) {
                                        warn "Couldn't append " . $msg
+->header->{subject} . " to $folder_name: $@\n";
                                        warn "Skipping\n";
                                        next;
                                }
                        } else {
                                warn "Skipping " . $msg->header->{subj
+ect} . " - deleted message\n";
                        }

                }
        }
        closedir($dir_h);

}
Replies are listed 'Best First'.
Re: Mirror/Copy Mozilla thunderbird emails to IMAP server
by davidrw (Prior) on Mar 08, 2006 at 16:08 UTC
    An alternative to the recursion and readdir's and grep's is 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
    ...    
  }
}

    [download]
[reply]
[d/l]
Mark messages as read
by nagelp (Initiate) on May 23, 2008 at 06:19 UTC

    The only thing that was wrong after uploading the mails with this script was, that all mails were 'marked as unread' (i.e. no 'Seen' flag was set). After looking into the Mail::IMAPClient documentation, I figured out how to change the script, so that all mails are 'marked as read' on the server. I think that's what most people need...

    Here is the patch (just add '\Seen' as the third argument to the append_string() call):

    --- original.pl 2008-05-23 14:10:40.000000000 +0800
+++ mark_as_read.pl     2008-05-23 14:11:51.000000000 +0800
@@ -63,7 +63,7 @@
                                 $folder_name =~ s/^\.//;
                                 $imap->create($folder_name)
                                         or warn "unable to create $fo
+lder_name: $@\n";
-                                unless($imap->append_string($folder_n
+ame, $msg)) {
+                                unless($imap->append_string($folder_n
+ame, $msg, '\Seen')) {
                                         warn "Couldn't append " . $ms
+g->header->{subject} . " to $folder_name: $@\n";
                                         warn "Skipping\n";
                                         next;

    [download]
[reply]
[d/l]

      davis
      Yep, fair enough. I think I may have actually ended up doing something like this in the final version. Thanks for the patch!
      cheers
[reply]

        Had some horror to migrate my old Thunderbird archive to IMAP.. found this script. I have made some additions to this code:

        - replace '.' (dots) by '_' in folder names

        - subscribe to the folders !

        - create (final) dir on other location

        - appended a base target folder

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

my $base_dir    = ".thunderbird/profile_path/Mail/Local Folders/";
my $base_target = "INBOX";
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!^$base_dir!$base_target!;
    $temp_dir =~ s!\.sbd!!g;
    $temp_dir =~ s!/+!/!g;
    $temp_dir =~ s!\.+!_!g;
    $temp_dir =~ s!^/!!;
    $temp_dir =~ s!/ *!.!g;
    if ($temp_dir ne $base_target) {
        print "================================= Making dir $temp_dir\
+n";
        $imap->create($temp_dir)
                        or warn "(A) unable to create $temp_dir: $@\n"
+;
        $imap->subscribe($temp_dir)
                        or warn "(A) subscribe to $temp_dir: $@\n";
        print "\n";
    }
    
    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|\.d
+at)$/, readdir $dir_h) {
        my $mf = $dir."/".$mail_file;
        print "Going to parse $mf\n";
        my $mb = Mail::MboxParser->new($mf,
                                                                      
+  decode     => 'ALL',
                                                                      
+  parseropts => $parseropts);
    
        my $folder_name = $temp_dir.".".$mail_file;
        $folder_name =~ s!/+!/!g;
        $folder_name =~ s!\.+!_!g;
        $folder_name =~ s!^/!!;
        $folder_name =~ s!/ *!.!g;
        print "================================= Making dir $folder_na
+me\n";
        $imap->create($folder_name)
                        or warn "(B) unable to create $folder_name: $@
+\n";
        $imap->subscribe($folder_name)
                        or warn "(B) subscribe to $folder_name: $@\n";
    
        for my $msg ($mb->get_messages) {
            #Skip deleted messages...
            unless($skip_deleted and (hex($msg->header->{"x-mozilla-st
+atus"}) & 0x0008)) {
                print "Appending msg " . $msg->header->{subject} . " t
+o $folder_name\n";
                unless($imap->append_string($folder_name, $msg, '\Seen
+')) {
                                warn "Couldn't append " . $msg->header
+->{subject} . " to $folder_name: $@\n";
                                warn "Skipping\n";
                                next;
                }
            } else {
                warn "Skipping " . $msg->header->{subject} . " - delet
+ed message\n";
            }
    
        }
    }
    closedir($dir_h);

}

        [download]
[reply]
[d/l]
Thanks for this timesaver!
by nagelp (Initiate) on May 22, 2008 at 17:03 UTC

    Thanks a lot for this script, it helped us a lot!
    Thunderbird's IMAP upload functionality is wacky at best :(

    Patrick.
[reply]

Back to Code Catacombs