3 # Author: Thorsten Maerz <info@netztorte.de>
5 # Dependencies: MIME::Parser, LWP::MediaTypes from www.cpan.org
6 # Converts mbox files as exported from Calypso to MH format. Regenerates
7 # Calypso's folder structure and optionally includes the attachments.
11 our $mboxdir = '' || showhelp(); # enter path to exported mbox
12 our $mboxfile = '' || showhelp(); # enter name of exported mbox
13 our $outdir = '' || showhelp(); # enter destination path
15 my $incl_attach = 1 ; # include attachments (needs CPAN modules)
16 my $verbose = 1 ; # show some headers of processed mail
17 my $testonly = 0 ; # dont create any files
19 ################################################################################
20 # no user servicable parts below :)
24 use LWP::MediaTypes qw(guess_media_type);
27 my $mbox = "$mboxdir/$mboxfile";
28 my $calypso_hdr = 'From \?\?\?@\?\?\? '; #Mon Apr 17 00:37:38 2000
29 my $hdr_Folder = 'X-CalypsoFolder:';
30 my $hdr_HTML = 'X-CalypsoHtmlBody:';
31 my $hdr_Account = 'X-CalypsoAccount:';
32 my $hdr_Attach = 'X-Attachment:';
34 my $create_dirs = 1 ; # create dirs from "X-Calypso-Folder:" header
36 ################################################################################
38 die ( "You have not yet configured this script.\n"
39 . "Please provide the correct path and file names, e.g\n"
40 . "\tour \$mboxdir = 'Archive'\n"
41 . "\tour \$mboxfile = 'mail.txt'\n"
42 . "\tour \$outdir = 'Calypso'\n"
43 . "at the top of $0\n"
47 ################################################################################
49 # MAIN : scan $mbox linewise
50 # Create a separate message for each $calypso_hdr found (MH format)
51 # $attach_full = filename with path, $attach_short = original attachment name
52 # $folder = Calypso folder
54 ################################################################################
55 my ($folder, $html, $html_full, $html_short,
56 $account, $attach, $attach_short, $attach_full);
59 open (INBOX, "<".$mbox);
64 if (m/^$calypso_hdr/) {
67 shift @lines ; # remove blank line
71 $folder = $html = $html_full = $html_short = $account
72 = $attach = $attach_short = $attach_full = "";
77 if (/^$hdr_Folder /) { $folder = $' ;
79 $folder =~ tr#\\#\/# ;
81 if (/^$hdr_HTML /) { $html = $' ;
89 if (/^$hdr_Account /) { $account = $' ;
92 if (/^$hdr_Attach /) { $attach = $' ;
94 $attach =~ tr#\\#\/# ;
95 if ($attach =~ /; /) {
106 ################################################################################
109 # Saves mail in @lines to $outdir/$folder/$mail_nr
110 # Folder is created unless $testonly or (not $create_dirs) is set
112 ################################################################################
114 my $mailname = $mail_nr{$folder};
125 m/^$/ and ($ishead="");
128 ($hdr,$cnt) = ($`,$');
135 print "MAIL : $mailname\n";
136 print "FOLDER : $folder\n" if ($folder);
137 print "HTML : $html_short ($html_full)\n" if ($html);
138 print "ACCOUNT : $account\n" if ($account);
139 print "ATTACH : $attach_short ($attach_full)\n" if ($attach);
142 # write mail to folder
145 $targetdir = $outdir.'/'.$folder ;
146 ( -d $outdir) || mkdir $outdir;
147 ( -d $targetdir) || mkdir $targetdir;
150 open (OUTFILE, ">".$targetdir.'/'.$mailname);
151 foreach (@lines) { printf OUTFILE "$_\n" ; }
155 include_attachment($targetdir.'/'.$mailname);
160 ################################################################################
161 # make inline attachment from external file
162 # uses MIME::Parser, LWP::MediaTypes from www.cpan.org
163 # (Currently leaves a blank attachment in converted mails. Feel free to
164 # improve this script)
165 sub include_attachment() {
166 my $mailname = shift ;
167 my $parser = new MIME::Parser ;
173 $parser->output_to_core(1); # dont save to harddisk
174 $entity = $parser->parse_open($mailname);
176 # look for external attachments
177 foreach ($entity->head->get('X-Attachment')) {
178 if (m/["']? # 1. start with " or ' (or none)
179 ([^"';]+) # word till quote or separator
181 \s?;\s? # separator ; (opt. spaces)
182 ["']? # 2. start (s.a.)
185 /x ) { $attachments{$1} = $2 ;
188 foreach ($entity->head->get('X-CalypsoHtmlBody')) {
189 if (m/["']? # 1. start with " or ' (or none)
190 ([^"';]+) # word till quote or separator
192 \s?;\s? # separator ; (opt. spaces)
193 ["']? # 2. start (s.o.)
196 /x ) { $attachments{$1} = $2 ;
199 foreach ($entity->head->get('X-CalypsoHtmlImg')) {
200 if (m/["']? # 1. start with " or ' (or none)
201 ([^"';]+) # word till quote or separator
203 \s?;\s? # separator ; (opt. spaces)
204 ["']? # 2. start (s.a.)
207 \s?;\s? # separator ; (opt. spaces)
208 ["']? # 3. start (s.a.)
211 /x ) { $attachments{$1} = $3 ;
218 foreach my $key (keys (%attachments)) {
223 $fnam =~ tr#\\#/# if -d '/' ; # correct path names on unix like OS
224 $fnam = $mboxdir .'/'. $fnam ;
225 $type = guess_media_type($fnam);
227 if ( $type =~ m/text/i ) { $enc = "8bit" }
228 else { $enc = "base64" }
230 $entity->attach(Path => $fnam,
233 Filename => $attachments{$key}
237 my $lines = $entity->as_string ;
238 # correct images names in html messages
239 foreach (keys (%CID)) {
240 $lines =~ s/CID:$CID{$_}/$attachments{$_}/eg;
243 print $mailname."\n";
244 # qx(mv $mailname $mailname.bak);
245 open ( MAIL, ">".$mailname );
246 print( MAIL $lines );