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

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

do not hardcode $newroot

$newroot is composed of two elements: the Thunderbird profile, and a
directory inside this profile. Both can be specified on the command
line, but the profile will be determined automatically if possible. Note
that this commit also fixes a bug in the command-line handling of
$oldroot and $profile (oops!).

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