source: ProjectBuilder/projects/md2mb/devel/md2mb/bin/md2mb.pl

#!/usr/bin/perl -w

=head1 NAME

md2mb.pl - Import a maildir kmail environment into a thunderbird one

=cut

# Released under the GPLv2 or the Artistic license at your will.
# Cf: http://www.gnu.org/licenses/gpl2.html
# Remember that:
# 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
#
# 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 

use strict;
use File::Find;
use File::Copy;
use File::Basename;
use File::Path;
use File::Glob ':glob';
use Getopt::Long;
use Pod::Usage;
use List::Util qw(first);

# settings
my $cmd = 'formail';
my $debug = 0;
my $file = 0; # is the newroot a file (1) or a dir (0) ?
my $help = 0;
my $man = 0;
my $oldroot = first { -d } "$ENV{HOME}/.Mail", "$ENV{HOME}/Mail";
my @default_profiles = bsd_glob("$ENV{HOME}/.thunderbird/*.default");
my $profile = shift @default_profiles;
# if there is more than one default profile (quite unlikely, but you never
# know), unset $profile again and let the user resolve this
if (@default_profiles) { undef $profile }
my $subdir;
my $touch = 1;

# parse command-line options
GetOptions(
    'cmd|c=s'     => \$cmd,
    'debug|d+'    => \$debug,
    'file|f'      => \$file,
    'help|h'      => \$help,
    'man|m'       => \$man,
    'notouch|n'   => sub { $touch = 0 },
    'oldroot|o=s' => \$oldroot,
    'profile|p=s' => \$profile,
    'subdir|s=s'  => \$subdir,
) or pod2usage(2);
pod2usage(1) if ($help);
pod2usage(-exitstatus => 0, -verbose => 2) if ($man);
defined $subdir or pod2usage("Error: -subdir is a mandatory argument\n");

# the new root is constructed from the profile and the chosen subdirectory name
my $newroot = "$profile/$subdir" if defined $profile;

# debug mode overview
if ($debug) {
    print <<EOF;
DEBUG MODE, not doing anything, just printing
--- current state ---
debug   = $debug
cmd     = $cmd
oldroot = $oldroot
profile = $profile
subdir  = $subdir
newroot = $newroot (constructed)
--- end ---
EOF
}

# some sanity checks before proceeding
system("$cmd </dev/null >/dev/null 2>/dev/null") == 0 or die <<EOF;
Cannot run `$cmd' or locate it in your \$PATH!

I need the program `formail' to process your mailboxes. You can provide the
full path to the formail utility using the `-cmd' command-line switch.

Perhaps `formail' is not installed on your system. Try installing the `formail'
package using your distribution's package manager. The formail utility might be
contained in the `procmail' package (e.g., Ubuntu 11.10), so you may need to
look for the latter instead.

Aborting ...
EOF
defined $oldroot or pod2usage(<<EOF);
Cannot locate KMail mailboxes automatically. Please specify their location by
rerunning the program with the -oldroot option.
EOF
-d $oldroot or die "cannot find mailbox root `$oldroot'";
defined $profile or pod2usage(<<EOF);
Cannot locate the default Thunderbird profile directory automatically. Please
specify its location by rerunning the program with the -profile option.
EOF
-d $profile or die "cannot find Thunderbird profile directory `$profile'";

# create destination path
if ($debug) { 
    print "TARGET DIR: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $file));
    print "CMD: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $file));
} else {
    mkpath("$newroot",0, 0755) if ((not -d "$newroot") && (not $file));
}

# the main work is done here
if ($debug) {
    print "DESCENDING INTO oldroot($oldroot)\n";
}
find(\&md2mb,($oldroot));

# now go back again and create empty files corresponding to the `.sbd'
# directories
if ($touch) {
    print "DESCENDING AGAIN INTO oldroot($oldroot)\n" if ($debug);
    find(sub {
            return if (! -d);   # consider only directories ...
            return if (! /\.sbd$/); # ... with the right name
            s/\.sbd//;      # strip .sbd suffix
            if ($debug) {
                print "WOULD CREATE file($_) IF NEEDED\n";
            } else {
                open my $fh, '>>', $_ or die "cannot open $_: $!";
            }
        }, $newroot);
}

# rename `inbox' to `Inbox'
if ((-z "$newroot/Inbox") || (! -e "$newroot/Inbox")) {
    if ($debug) {
        print "RENAMING inbox($newroot/inbox) INTO Inbox($newroot/Inbox)\n" if (-e "$newroot/inbox");
    } else {
        print "Renaming inbox into Inbox\n";
        move("$newroot/inbox","$newroot/Inbox") if (-e "$newroot/inbox");
    }
}

sub md2mb {

if (-f $File::Find::name) {
    if (($File::Find::name =~ /\.ids$/) ||
        ($File::Find::name =~ /\.sorted$/) ||
        ($File::Find::name =~ /\.index$/)) {
        print "SKIP FILE: $File::Find::name\n" if ($debug);
        return;
    }
}
if (-d $File::Find::name) {
    if (($File::Find::name =~ /\/cur$/) ||
        ($File::Find::name =~ /\/new$/) ||
        ($File::Find::name =~ /\/tmp$/)) {
        print "SKIP DIR: $File::Find::name\n" if ($debug);
        return;
    }
}
my $destname = $File::Find::name;
# Target name is under a different root dir
$destname =~ s|^$oldroot||;
# Target name is not under a .directory dir but under a .sdb one
$destname =~ s|\.([^/]+)\.directory/|$1.sbd/|g;
# Here we create the target dir and target name
my $outputfile="$newroot/$destname";
my $cdir = dirname("$outputfile");
# Handle case where target file name is empty
$outputfile="$newroot" if ($destname =~ /^\s*$/);
# When we treat a dir, we will have to handle what it has below
if (-d $File::Find::name) {
    if ($debug) { 
        print "DIR SRC: $File::Find::name\n";
    }
    my @files = (bsd_glob("$File::Find::name/cur/*"),bsd_glob("$File::Find::name/new/*"));
    if (@files) {
        if ($debug) { 
            print "DIR ($File::Find::name) DIR TARGET: mkdir -p $cdir\n" if (not -d "$cdir");
        } else {
            mkpath("$cdir",0, 0755) if (not -d "$cdir");
        }
    }
    foreach my $file (@files) {
        next unless -f $file; # skip non-regular files
        next unless -s $file; # skip empty files
        next unless -r $file; # skip unreadable files
        $file =~ s/'/'"'"'/g;  # escape ' (single quote)
        # NOTE! The output file must not contain single quotes (')!
        my $run = "cat '$file' | $cmd >> '$outputfile'";
        if ($debug) { 
            print "COPYING CONTENT maildir($file) to $outputfile\n";
            print "CMD: $run\n";
        } else {
            print "Copying maildir content from $file to $outputfile\n";
            system($run) == 0 or warn "cannot run \"$run\".";
        }
    }
}
if (-f $File::Find::name) {
    if (($File::Find::name =~ /\/cur\//) ||
        ($File::Find::name =~ /\/new\//) ||
        ($File::Find::name =~ /\/tmp\//)) {
        print "SKIP FILE: $File::Find::name\n" if ($debug);
        return;
    }
    if ($debug) { 
        print "FILE ($File::Find::name) TARGET DIR: mkdir -p $cdir\n" if (not -d "$cdir");
        print "CMD: cp $File::Find::name $cdir\n";
    } else {
        print "Copying mailbox content from $File::Find::name to $cdir\n";
        mkpath("$cdir",0, 0755) if (not -d "$cdir");
        copy($File::Find::name,$cdir);
    }
}
}
__END__

=head1 SYNOPSIS

md2mb.pl  [options]  -s name

 Options:
   -cmd     | -c <cmd>      command to process mail
   -debug   | -d        debug mode
   -file    | -f        whether $newroot is a file or a directory
   -help    | -h        brief help message
   -man     | -m        full documentation
   -notouch | -n        do not create empty files corresponding to .sdb
                dirs
   -oldroot | -o <path>     location of the KMail mailboxes
   -profile | -p <path>     path to the Thunderbird profile to install to
   -subdir  | -s <name>     subdir that will be created to hold the
                imported mails

=head1 OPTIONS

=over 4

=item B<-cmd> I<cmd>

Use I<cmd> to process your maildirs. By default uses B<formail> in
your C<$PATH>, but you can use this option to specify the full path to the
executable to use instead.

=item B<-debug>

Enter debug mode. This will print what would be done. No commands are executed,
so this is safe to use when testing.

=item B<-file>

Specifies that $newroot is a file. If this option is omitted, it is assumed
that $newroot is a directory instead.

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=item B<-notouch>

Do not create empty files corresponding to the F<.sbd> dirs created by this
script. By default, those empty files are created to make KMail's subfolders
show up in Thunderbird. You probably don't need to use this option, but it is
here nevertheless in case you need it.

=item B<-oldroot> I<path>

Specify where your B<KMail> mailboxes are to be found. By default assumes a
folder called F<.Mail> or F<Mail> in your homedir, preferring F<.Mail> if it
exists.

=item B<-profile> I<path>

Specify the path to the Thunderbird profile. Your imported mails will go inside
a directory in this profile. By default uses the default profile in the
F<.thunderbird> directory in your home directory, if it is unique.

=item B<-subdir> I<name>

Specify the subdirectory I<name> that will be created inside the Thunderbird
profile to hold the imported mails. This option is mandatory; there is no
default.

=back

=head1 EXAMPLES

    # this will fetch all mails from the folder .Mail or Mail in your home
    # directory, and import them into your default Thunderbird profile, in
    # a directory called Mail/pop.home.musique-ancienne.org/
    #
    # usually, this is all you need to specify:

    perl md2mb.pl -s Mail/pop.home.musique-ancienne.org/

    # on your computer, the mails may end up in
    # /users/segolene/.thunderbird/qk2f4dl6.default/Mail/pop.home.musique-ancienne.org/

    # if md2mb.pl cannot figure out where your default Thunderbird profile
    # is, use the following:

    perl md2mb.pl -p ~/.thunderbird/qk2f4dl6.default -s Mail/pop.home.musique-ancienne.org/

=head1 DESCRIPTION

B<md2mb.pl> will import a B<kmail> maildir environment, and transform it into a
B<thunderbird> one. It relies on B<formail> (or an equivalent utility) being
available on your system.

By default, B<md2mb.pl> assumes that your B<kmail> mailboxes are stored in a
folder called F<.Mail> or F<Mail> in your homedir. If this assumption is
incorrect, you need to specify the correct folder with B<-oldroot>.

The mails will be imported into the Thunderbird profile that is either
specified with B<-profile> or determined automatically. The script will try to
determine the default Thunderbird profile automatically. If there is a folder
that ends in F<.default> in the F<.thunderbird> directory in your home dir, and
if it is unique, that one will be used.

The mails finally end up in a subdirectory below the profile. You must specify
the subdirectory on the command line with B<-subdir>, as shown in the examples
above.

If you have used a structure with subfolders in KMail, mails in subfolders
should show up correctly in Thunderbird.

=head1 AUTHOR

=over 4

=item *

Bruno Cornec, http://brunocornec.wordpress.com

=item *

Edward Baudrez, C<< ebaudrez@cpan.org >>

=back

=head1 LICENSE

Released under the GPLv2 or the Artistic license at your will.
Cf: http://www.gnu.org/licenses/gpl2.html
Cf: http://www.perlfoundation.org/artistic_license_1_0
Remember that:
BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION.

IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. 


=cut