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

Last change on this file since 1391 was 1391, checked in by Bruno Cornec, 12 years ago
  • Adding a license to md2mb.pl
File size: 3.6 KB
Line 
1#!/usr/bin/perl -w
2#
3# Program to import a maildir kmail environement into a thunderbird one.
4#
5# Released under the GPLv2 or the Artistic license at your will.
6
7use strict;
8use File::Find;
9use File::Copy;
10use File::Basename;
11use File::Path;
12use File::Glob ':glob';
13
14my $cmd="formail";
15# CHANGE AS YOU WISH
16my $oldroot = "/users/segolene/.Mail";
17my $newroot = "/users/segolene/.thunderbird/qk2f4dl6.default/Mail/pop.home.musique-ancienne.org/";
18# Is the newroot a file (1) or a dir (0)
19my $nrisfile = 0;
20my $debug = 0;
21# END CHANGE
22
23$debug++ if ((defined $ARGV[0]) && ($ARGV[0] eq "-v"));
24print "DEBUG MODE, not doing anything, just printing\n" if ($debug);
25if ($debug) {
26 print "TARGET DIR: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $nrisfile));
27 print "CMD: mkdir -p $newroot\n" if ((not -d "$newroot") && (not $nrisfile));
28} else {
29 mkpath("$newroot",0, 0755) if ((not -d "$newroot") && (not $nrisfile));
30}
31system("$cmd </dev/null >/dev/null 2>/dev/null") == 0 or die "cannot find formail on your \$PATH!\nAborting";
32
33find(\&md2mb,($oldroot));
34
35if ((-z "$newroot/Inbox") || (! -e "$newroot/Inbox")) {
36 print "Renaming inbox into Inbox\n";
37 move("$newroot/inbox","$newroot/Inbox") if (-e "$newroot/inbox");
38}
39
40sub md2mb {
41
42if (-f $File::Find::name) {
43 if (($File::Find::name =~ /\.ids$/) ||
44 ($File::Find::name =~ /\.sorted$/) ||
45 ($File::Find::name =~ /\.index$/)) {
46 print "SKIP FILE: $File::Find::name\n" if ($debug);
47 return;
48 }
49}
50if (-d $File::Find::name) {
51 if (($File::Find::name =~ /\/cur$/) ||
52 ($File::Find::name =~ /\/new$/) ||
53 ($File::Find::name =~ /\/tmp$/)) {
54 print "SKIP DIR: $File::Find::name\n" if ($debug);
55 return;
56 }
57}
58my $destname = $File::Find::name;
59# Target name is under a different root dir
60$destname =~ s|^$oldroot||;
61# Target name is not under a .directory dir but under a .sdb one
62$destname =~ s|\.([^/]+)\.directory/|$1.sbd/|g;
63# Here we create the target dir and target name
64my $cdir = dirname("$newroot/$destname");
65my $outputfile="$newroot/$destname";
66# Handle case where target file name is empty
67$outputfile="$newroot" if ($destname =~ /^\s*$/);
68# When we treat a dir, we will have to handle what it has below
69if (-d $File::Find::name) {
70 if ($debug) {
71 print "DIR SRC: $File::Find::name\n";
72 }
73 my @files = (bsd_glob("$File::Find::name/cur/*"),bsd_glob("$File::Find::name/new/*"));
74 if (@files) {
75 if ($debug) {
76 print "DIR ($File::Find::name) DIR TARGET: mkdir -p $cdir\n" if (not -d "$cdir");
77 } else {
78 mkpath("$cdir",0, 0755) if (not -d "$cdir");
79 }
80 }
81 foreach my $file (@files) {
82 next unless -f $file; # skip non-regular files
83 next unless -s $file; # skip empty files
84 next unless -r $file; # skip unreadable files
85 $file =~ s/'/'"'"'/g; # escape ' (single quote)
86 # NOTE! The output file must not contain single quotes (')!
87 my $run = "cat '$file' | $cmd >> '$outputfile'";
88 if ($debug) {
89 print "COPYING CONTENT maildir($file) to $outputfile\n";
90 print "CMD: $run\n";
91 } else {
92 print "Copying maildir content from $file to $outputfile\n";
93 system($run) == 0 or warn "cannot run \"$run\".";
94 }
95 }
96}
97if (-f $File::Find::name) {
98 if (($File::Find::name =~ /\/cur\//) ||
99 ($File::Find::name =~ /\/new\//) ||
100 ($File::Find::name =~ /\/tmp\//)) {
101 print "SKIP FILE: $File::Find::name\n" if ($debug);
102 return;
103 }
104 if ($debug) {
105 print "FILE ($File::Find::name) TARGET DIR: mkdir -p $cdir\n" if (not -d "$cdir");
106 print "CMD: cp $File::Find::name $cdir\n";
107 } else {
108 print "Copying mailbox content from $File::Find::name to $cdir\n";
109 mkpath("$cdir",0, 0755) if (not -d "$cdir");
110 copy($File::Find::name,$cdir);
111 }
112}
113}
Note: See TracBrowser for help on using the repository browser.