| 1 | #!/usr/bin/perl -w
|
|---|
| 2 |
|
|---|
| 3 | =head1 NAME
|
|---|
| 4 |
|
|---|
| 5 | md2mb.pl - Import a maildir kmail environment into a thunderbird one
|
|---|
| 6 |
|
|---|
| 7 | =cut
|
|---|
| 8 |
|
|---|
| 9 | # Released under the GPLv2 or the Artistic license at your will.
|
|---|
| 10 | # Cf: http://www.gnu.org/licenses/gpl2.html
|
|---|
| 11 | # Remember that:
|
|---|
| 12 | # 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.
|
|---|
| 13 | #
|
|---|
| 14 | # 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.
|
|---|
| 15 |
|
|---|
| 16 | use strict;
|
|---|
| 17 | use File::Find;
|
|---|
| 18 | use File::Copy;
|
|---|
| 19 | use File::Basename;
|
|---|
| 20 | use File::Path;
|
|---|
| 21 | use File::Glob ':glob';
|
|---|
| 22 | use Getopt::Long;
|
|---|
| 23 | use Pod::Usage;
|
|---|
| 24 | use List::Util qw(first);
|
|---|
| 25 |
|
|---|
| 26 | # settings
|
|---|
| 27 | my $cmd = 'formail';
|
|---|
| 28 | my $debug = 0;
|
|---|
| 29 | my $file = 0; # is the newroot a file (1) or a dir (0) ?
|
|---|
| 30 | my $help = 0;
|
|---|
| 31 | my $man = 0;
|
|---|
| 32 | my $oldroot = first { -d } "$ENV{HOME}/.Mail", "$ENV{HOME}/Mail";
|
|---|
| 33 | my @default_profiles = bsd_glob("$ENV{HOME}/.thunderbird/*.default");
|
|---|
| 34 | my $profile = shift @default_profiles;
|
|---|
| 35 | # if there is more than one default profile (quite unlikely, but you never
|
|---|
| 36 | # know), unset $profile again and let the user resolve this
|
|---|
| 37 | if (@default_profiles) { undef $profile }
|
|---|
| 38 | my $subdir;
|
|---|
| 39 | my $touch = 1;
|
|---|
| 40 |
|
|---|
| 41 | # parse command-line options
|
|---|
| 42 | GetOptions(
|
|---|
| 43 | 'cmd|c=s' => \$cmd,
|
|---|
| 44 | 'debug|d+' => \$debug,
|
|---|
| 45 | 'file|f' => \$file,
|
|---|
| 46 | 'help|h' => \$help,
|
|---|
| 47 | 'man|m' => \$man,
|
|---|
| 48 | 'notouch|n' => sub { $touch = 0 },
|
|---|
| 49 | 'oldroot|o=s' => \$oldroot,
|
|---|
| 50 | 'profile|p=s' => \$profile,
|
|---|
| 51 | 'subdir|s=s' => \$subdir,
|
|---|
| 52 | ) or pod2usage(2);
|
|---|
| 53 | pod2usage(1) if ($help);
|
|---|
| 54 | pod2usage(-exitstatus => 0, -verbose => 2) if ($man);
|
|---|
| 55 | defined $subdir or pod2usage("Error: -subdir is a mandatory argument\n");
|
|---|
| 56 |
|
|---|
| 57 | # the new root is constructed from the profile and the chosen subdirectory name
|
|---|
| 58 | my $newroot = "$profile/$subdir" if defined $profile;
|
|---|
| 59 |
|
|---|
| 60 | # debug mode overview
|
|---|
| 61 | if ($debug) {
|
|---|
| 62 | print <<EOF;
|
|---|
| 63 | DEBUG MODE, not doing anything, just printing
|
|---|
| 64 | --- current state ---
|
|---|
| 65 | debug = $debug
|
|---|
| 66 | cmd = $cmd
|
|---|
| 67 | oldroot = $oldroot
|
|---|
| 68 | profile = $profile
|
|---|
| 69 | subdir = $subdir
|
|---|
| 70 | newroot = $newroot (constructed)
|
|---|
| 71 | --- end ---
|
|---|
| 72 | EOF
|
|---|
| 73 | }
|
|---|
| 74 |
|
|---|
| 75 | # some sanity checks before proceeding
|
|---|
| 76 | system("$cmd </dev/null >/dev/null 2>/dev/null") == 0 or die <<EOF;
|
|---|
| 77 | Cannot run `$cmd' or locate it in your \$PATH!
|
|---|
| 78 |
|
|---|
| 79 | I need the program `formail' to process your mailboxes. You can provide the
|
|---|
| 80 | full path to the formail utility using the `-cmd' command-line switch.
|
|---|
| 81 |
|
|---|
| 82 | Perhaps `formail' is not installed on your system. Try installing the `formail'
|
|---|
| 83 | package using your distribution's package manager. The formail utility might be
|
|---|
| 84 | contained in the `procmail' package (e.g., Ubuntu 11.10), so you may need to
|
|---|
| 85 | look for the latter instead.
|
|---|
| 86 |
|
|---|
| 87 | Aborting ...
|
|---|
| 88 | EOF
|
|---|
| 89 | defined $oldroot or pod2usage(<<EOF);
|
|---|
| 90 | Cannot locate KMail mailboxes automatically. Please specify their location by
|
|---|
| 91 | rerunning the program with the -oldroot option.
|
|---|
| 92 | EOF
|
|---|
| 93 | -d $oldroot or die "cannot find mailbox root `$oldroot'";
|
|---|
| 94 | defined $profile or pod2usage(<<EOF);
|
|---|
| 95 | Cannot locate the default Thunderbird profile directory automatically. Please
|
|---|
| 96 | specify its location by rerunning the program with the -profile option.
|
|---|
| 97 | EOF
|
|---|
| 98 | -d $profile or die "cannot find Thunderbird profile directory `$profile'";
|
|---|
| 99 |
|
|---|
| 100 | # create destination path
|
|---|
| 101 | if ($debug) {
|
|---|
| 102 | print "TARGET DIR: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $file));
|
|---|
| 103 | print "CMD: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $file));
|
|---|
| 104 | } else {
|
|---|
| 105 | mkpath("$newroot",0, 0755) if ((not -d "$newroot") && (not $file));
|
|---|
| 106 | }
|
|---|
| 107 |
|
|---|
| 108 | # the main work is done here
|
|---|
| 109 | if ($debug) {
|
|---|
| 110 | print "DESCENDING INTO oldroot($oldroot)\n";
|
|---|
| 111 | }
|
|---|
| 112 | find(\&md2mb,($oldroot));
|
|---|
| 113 |
|
|---|
| 114 | # now go back again and create empty files corresponding to the `.sbd'
|
|---|
| 115 | # directories
|
|---|
| 116 | if ($touch) {
|
|---|
| 117 | print "DESCENDING AGAIN INTO oldroot($oldroot)\n" if ($debug);
|
|---|
| 118 | find(sub {
|
|---|
| 119 | return if (! -d); # consider only directories ...
|
|---|
| 120 | return if (! /\.sbd$/); # ... with the right name
|
|---|
| 121 | s/\.sbd//; # strip .sbd suffix
|
|---|
| 122 | if ($debug) {
|
|---|
| 123 | print "WOULD CREATE file($_) IF NEEDED\n";
|
|---|
| 124 | } else {
|
|---|
| 125 | open my $fh, '>>', $_ or die "cannot open $_: $!";
|
|---|
| 126 | }
|
|---|
| 127 | }, $newroot);
|
|---|
| 128 | }
|
|---|
| 129 |
|
|---|
| 130 | # rename `inbox' to `Inbox'
|
|---|
| 131 | if ((-z "$newroot/Inbox") || (! -e "$newroot/Inbox")) {
|
|---|
| 132 | if ($debug) {
|
|---|
| 133 | print "RENAMING inbox($newroot/inbox) INTO Inbox($newroot/Inbox)\n" if (-e "$newroot/inbox");
|
|---|
| 134 | } else {
|
|---|
| 135 | print "Renaming inbox into Inbox\n";
|
|---|
| 136 | move("$newroot/inbox","$newroot/Inbox") if (-e "$newroot/inbox");
|
|---|
| 137 | }
|
|---|
| 138 | }
|
|---|
| 139 |
|
|---|
| 140 | sub md2mb {
|
|---|
| 141 |
|
|---|
| 142 | if (-f $File::Find::name) {
|
|---|
| 143 | if (($File::Find::name =~ /\.ids$/) ||
|
|---|
| 144 | ($File::Find::name =~ /\.sorted$/) ||
|
|---|
| 145 | ($File::Find::name =~ /\.index$/)) {
|
|---|
| 146 | print "SKIP FILE: $File::Find::name\n" if ($debug);
|
|---|
| 147 | return;
|
|---|
| 148 | }
|
|---|
| 149 | }
|
|---|
| 150 | if (-d $File::Find::name) {
|
|---|
| 151 | if (($File::Find::name =~ /\/cur$/) ||
|
|---|
| 152 | ($File::Find::name =~ /\/new$/) ||
|
|---|
| 153 | ($File::Find::name =~ /\/tmp$/)) {
|
|---|
| 154 | print "SKIP DIR: $File::Find::name\n" if ($debug);
|
|---|
| 155 | return;
|
|---|
| 156 | }
|
|---|
| 157 | }
|
|---|
| 158 | my $destname = $File::Find::name;
|
|---|
| 159 | # Target name is under a different root dir
|
|---|
| 160 | $destname =~ s|^$oldroot||;
|
|---|
| 161 | # Target name is not under a .directory dir but under a .sdb one
|
|---|
| 162 | $destname =~ s|\.([^/]+)\.directory/|$1.sbd/|g;
|
|---|
| 163 | # Here we create the target dir and target name
|
|---|
| 164 | my $outputfile="$newroot/$destname";
|
|---|
| 165 | my $cdir = dirname("$outputfile");
|
|---|
| 166 | # Handle case where target file name is empty
|
|---|
| 167 | $outputfile="$newroot" if ($destname =~ /^\s*$/);
|
|---|
| 168 | # When we treat a dir, we will have to handle what it has below
|
|---|
| 169 | if (-d $File::Find::name) {
|
|---|
| 170 | if ($debug) {
|
|---|
| 171 | print "DIR SRC: $File::Find::name\n";
|
|---|
| 172 | }
|
|---|
| 173 | my @files = (bsd_glob("$File::Find::name/cur/*"),bsd_glob("$File::Find::name/new/*"));
|
|---|
| 174 | if (@files) {
|
|---|
| 175 | if ($debug) {
|
|---|
| 176 | print "DIR ($File::Find::name) DIR TARGET: mkdir -p $cdir\n" if (not -d "$cdir");
|
|---|
| 177 | } else {
|
|---|
| 178 | mkpath("$cdir",0, 0755) if (not -d "$cdir");
|
|---|
| 179 | }
|
|---|
| 180 | }
|
|---|
| 181 | foreach my $file (@files) {
|
|---|
| 182 | next unless -f $file; # skip non-regular files
|
|---|
| 183 | next unless -s $file; # skip empty files
|
|---|
| 184 | next unless -r $file; # skip unreadable files
|
|---|
| 185 | $file =~ s/'/'"'"'/g; # escape ' (single quote)
|
|---|
| 186 | # NOTE! The output file must not contain single quotes (')!
|
|---|
| 187 | my $run = "cat '$file' | $cmd >> '$outputfile'";
|
|---|
| 188 | if ($debug) {
|
|---|
| 189 | print "COPYING CONTENT maildir($file) to $outputfile\n";
|
|---|
| 190 | print "CMD: $run\n";
|
|---|
| 191 | } else {
|
|---|
| 192 | print "Copying maildir content from $file to $outputfile\n";
|
|---|
| 193 | system($run) == 0 or warn "cannot run \"$run\".";
|
|---|
| 194 | }
|
|---|
| 195 | }
|
|---|
| 196 | }
|
|---|
| 197 | if (-f $File::Find::name) {
|
|---|
| 198 | if (($File::Find::name =~ /\/cur\//) ||
|
|---|
| 199 | ($File::Find::name =~ /\/new\//) ||
|
|---|
| 200 | ($File::Find::name =~ /\/tmp\//)) {
|
|---|
| 201 | print "SKIP FILE: $File::Find::name\n" if ($debug);
|
|---|
| 202 | return;
|
|---|
| 203 | }
|
|---|
| 204 | if ($debug) {
|
|---|
| 205 | print "FILE ($File::Find::name) TARGET DIR: mkdir -p $cdir\n" if (not -d "$cdir");
|
|---|
| 206 | print "CMD: cp $File::Find::name $cdir\n";
|
|---|
| 207 | } else {
|
|---|
| 208 | print "Copying mailbox content from $File::Find::name to $cdir\n";
|
|---|
| 209 | mkpath("$cdir",0, 0755) if (not -d "$cdir");
|
|---|
| 210 | copy($File::Find::name,$cdir);
|
|---|
| 211 | }
|
|---|
| 212 | }
|
|---|
| 213 | }
|
|---|
| 214 | __END__
|
|---|
| 215 |
|
|---|
| 216 | =head1 SYNOPSIS
|
|---|
| 217 |
|
|---|
| 218 | md2mb.pl [options] -s name
|
|---|
| 219 |
|
|---|
| 220 | Options:
|
|---|
| 221 | -cmd | -c <cmd> command to process mail
|
|---|
| 222 | -debug | -d debug mode
|
|---|
| 223 | -file | -f whether $newroot is a file or a directory
|
|---|
| 224 | -help | -h brief help message
|
|---|
| 225 | -man | -m full documentation
|
|---|
| 226 | -notouch | -n do not create empty files corresponding to .sdb
|
|---|
| 227 | dirs
|
|---|
| 228 | -oldroot | -o <path> location of the KMail mailboxes
|
|---|
| 229 | -profile | -p <path> path to the Thunderbird profile to install to
|
|---|
| 230 | -subdir | -s <name> subdir that will be created to hold the
|
|---|
| 231 | imported mails
|
|---|
| 232 |
|
|---|
| 233 | =head1 OPTIONS
|
|---|
| 234 |
|
|---|
| 235 | =over 4
|
|---|
| 236 |
|
|---|
| 237 | =item B<-cmd> I<cmd>
|
|---|
| 238 |
|
|---|
| 239 | Use I<cmd> to process your maildirs. By default uses B<formail> in
|
|---|
| 240 | your C<$PATH>, but you can use this option to specify the full path to the
|
|---|
| 241 | executable to use instead.
|
|---|
| 242 |
|
|---|
| 243 | =item B<-debug>
|
|---|
| 244 |
|
|---|
| 245 | Enter debug mode. This will print what would be done. No commands are executed,
|
|---|
| 246 | so this is safe to use when testing.
|
|---|
| 247 |
|
|---|
| 248 | =item B<-file>
|
|---|
| 249 |
|
|---|
| 250 | Specifies that $newroot is a file. If this option is omitted, it is assumed
|
|---|
| 251 | that $newroot is a directory instead.
|
|---|
| 252 |
|
|---|
| 253 | =item B<-help>
|
|---|
| 254 |
|
|---|
| 255 | Print a brief help message and exits.
|
|---|
| 256 |
|
|---|
| 257 | =item B<-man>
|
|---|
| 258 |
|
|---|
| 259 | Prints the manual page and exits.
|
|---|
| 260 |
|
|---|
| 261 | =item B<-notouch>
|
|---|
| 262 |
|
|---|
| 263 | Do not create empty files corresponding to the F<.sbd> dirs created by this
|
|---|
| 264 | script. By default, those empty files are created to make KMail's subfolders
|
|---|
| 265 | show up in Thunderbird. You probably don't need to use this option, but it is
|
|---|
| 266 | here nevertheless in case you need it.
|
|---|
| 267 |
|
|---|
| 268 | =item B<-oldroot> I<path>
|
|---|
| 269 |
|
|---|
| 270 | Specify where your B<KMail> mailboxes are to be found. By default assumes a
|
|---|
| 271 | folder called F<.Mail> or F<Mail> in your homedir, preferring F<.Mail> if it
|
|---|
| 272 | exists.
|
|---|
| 273 |
|
|---|
| 274 | =item B<-profile> I<path>
|
|---|
| 275 |
|
|---|
| 276 | Specify the path to the Thunderbird profile. Your imported mails will go inside
|
|---|
| 277 | a directory in this profile. By default uses the default profile in the
|
|---|
| 278 | F<.thunderbird> directory in your home directory, if it is unique.
|
|---|
| 279 |
|
|---|
| 280 | =item B<-subdir> I<name>
|
|---|
| 281 |
|
|---|
| 282 | Specify the subdirectory I<name> that will be created inside the Thunderbird
|
|---|
| 283 | profile to hold the imported mails. This option is mandatory; there is no
|
|---|
| 284 | default.
|
|---|
| 285 |
|
|---|
| 286 | =back
|
|---|
| 287 |
|
|---|
| 288 | =head1 EXAMPLES
|
|---|
| 289 |
|
|---|
| 290 | # this will fetch all mails from the folder .Mail or Mail in your home
|
|---|
| 291 | # directory, and import them into your default Thunderbird profile, in
|
|---|
| 292 | # a directory called Mail/pop.home.musique-ancienne.org/
|
|---|
| 293 | #
|
|---|
| 294 | # usually, this is all you need to specify:
|
|---|
| 295 |
|
|---|
| 296 | perl md2mb.pl -s Mail/pop.home.musique-ancienne.org/
|
|---|
| 297 |
|
|---|
| 298 | # on your computer, the mails may end up in
|
|---|
| 299 | # /users/segolene/.thunderbird/qk2f4dl6.default/Mail/pop.home.musique-ancienne.org/
|
|---|
| 300 |
|
|---|
| 301 | # if md2mb.pl cannot figure out where your default Thunderbird profile
|
|---|
| 302 | # is, use the following:
|
|---|
| 303 |
|
|---|
| 304 | perl md2mb.pl -p ~/.thunderbird/qk2f4dl6.default -s Mail/pop.home.musique-ancienne.org/
|
|---|
| 305 |
|
|---|
| 306 | =head1 DESCRIPTION
|
|---|
| 307 |
|
|---|
| 308 | B<md2mb.pl> will import a B<kmail> maildir environment, and transform it into a
|
|---|
| 309 | B<thunderbird> one. It relies on B<formail> (or an equivalent utility) being
|
|---|
| 310 | available on your system.
|
|---|
| 311 |
|
|---|
| 312 | By default, B<md2mb.pl> assumes that your B<kmail> mailboxes are stored in a
|
|---|
| 313 | folder called F<.Mail> or F<Mail> in your homedir. If this assumption is
|
|---|
| 314 | incorrect, you need to specify the correct folder with B<-oldroot>.
|
|---|
| 315 |
|
|---|
| 316 | The mails will be imported into the Thunderbird profile that is either
|
|---|
| 317 | specified with B<-profile> or determined automatically. The script will try to
|
|---|
| 318 | determine the default Thunderbird profile automatically. If there is a folder
|
|---|
| 319 | that ends in F<.default> in the F<.thunderbird> directory in your home dir, and
|
|---|
| 320 | if it is unique, that one will be used.
|
|---|
| 321 |
|
|---|
| 322 | The mails finally end up in a subdirectory below the profile. You must specify
|
|---|
| 323 | the subdirectory on the command line with B<-subdir>, as shown in the examples
|
|---|
| 324 | above.
|
|---|
| 325 |
|
|---|
| 326 | If you have used a structure with subfolders in KMail, mails in subfolders
|
|---|
| 327 | should show up correctly in Thunderbird.
|
|---|
| 328 |
|
|---|
| 329 | =head1 AUTHOR
|
|---|
| 330 |
|
|---|
| 331 | =over 4
|
|---|
| 332 |
|
|---|
| 333 | =item *
|
|---|
| 334 |
|
|---|
| 335 | Bruno Cornec, http://brunocornec.wordpress.com
|
|---|
| 336 |
|
|---|
| 337 | =item *
|
|---|
| 338 |
|
|---|
| 339 | Edward Baudrez, C<< ebaudrez@cpan.org >>
|
|---|
| 340 |
|
|---|
| 341 | =back
|
|---|
| 342 |
|
|---|
| 343 | =head1 LICENSE
|
|---|
| 344 |
|
|---|
| 345 | Released under the GPLv2 or the Artistic license at your will.
|
|---|
| 346 | Cf: http://www.gnu.org/licenses/gpl2.html
|
|---|
| 347 | Cf: http://www.perlfoundation.org/artistic_license_1_0
|
|---|
| 348 | Remember that:
|
|---|
| 349 | 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.
|
|---|
| 350 |
|
|---|
| 351 | 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.
|
|---|
| 352 |
|
|---|
| 353 |
|
|---|
| 354 | =cut
|
|---|
