source: projects/md2mb/devel/md2mb/bin/md2mb.pl @ 1450

Last change on this file since 1450 was 1450, checked in by ebaudrez, 7 years ago

turned $nrfile into a command-line option as well

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