minor change in the comments
[claws.git] / tools / calypso_convert.pl
1 #!/usr/bin/perl
2 # calypso_import.pl
3 # Author: Thorsten Maerz <info@netztorte.de>
4 # License: GPL
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.
8
9 use strict ;
10
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
14
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
18
19 ################################################################################
20 # no user servicable parts below :)
21
22 if ($incl_attach) {
23         use MIME::Parser;
24         use LWP::MediaTypes qw(guess_media_type);
25 }
26
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:';
33 my %mail_nr;
34 my $create_dirs = 1 ;           # create dirs from "X-Calypso-Folder:" header
35
36 ################################################################################
37 sub showhelp {
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"
44             );
45 }
46
47 ################################################################################
48 #
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
53 #
54 ################################################################################
55 my ($folder, $html, $html_full, $html_short,
56     $account, $attach, $attach_short, $attach_full);
57 my @lines ;
58
59 open (INBOX, "<".$mbox);
60 while (<INBOX>) {
61         s/\x0d\x0a//;
62         s/\x0d//;
63         s/\x0a//;
64         if (m/^$calypso_hdr/) {
65                 if (@lines) {
66                         $mail_nr{$folder}++ ;
67                         shift @lines ;          # remove blank line
68                         savemail();
69
70                         @lines = () ;
71                         $folder = $html = $html_full = $html_short = $account
72                                 = $attach = $attach_short = $attach_full = "";
73
74                 }
75         }
76         else {
77                 if (/^$hdr_Folder /)    {       $folder         = $' ;
78                                                 $folder         =~ s/"//eg ;
79                                                 $folder         =~ tr#\\#\/# ;
80                 } 
81                 if (/^$hdr_HTML /)      {       $html           = $' ;
82                                                 $html           =~ s/"//eg ;
83                                                 $html           =~ tr#\\#\/# ;
84                                                 if ($html       =~ /; /) {
85                                                         $html_full  = $` ;
86                                                         $html_short = $' ;
87                                                 }
88                 }
89                 if (/^$hdr_Account /)   {       $account        = $' ;
90                                                 $account        =~ s/"//eg ;
91                 }
92                 if (/^$hdr_Attach /)    {       $attach         = $' ;
93                                                 $attach         =~ s/"//eg ;
94                                                 $attach         =~ tr#\\#\/# ;
95                                                 if ($attach     =~ /; /) {
96                                                         $attach_full  = $` ;
97                                                         $attach_short = $' ;
98                                                 }
99                 }
100                 
101                 push (@lines, $_ );
102         }
103 }
104 close (INBOX);
105
106 ################################################################################
107 #
108 # sub:savemail
109 # Saves mail in @lines to $outdir/$folder/$mail_nr
110 # Folder is created unless $testonly or (not $create_dirs) is set
111 #
112 ################################################################################
113 sub savemail {
114         my $mailname = $mail_nr{$folder};
115         my %headers;
116         my $ishead=1;
117         my $lineno=0;
118         my $targetdir="";
119
120         # extract headers
121         foreach (@lines) {
122                 my ($hdr,$cnt);
123                 $lineno++;
124         
125                 m/^$/ and ($ishead="");
126                 if ( $ishead ) {
127                         if (m/: /) {
128                                 ($hdr,$cnt) = ($`,$');
129                                 $headers{$hdr}=$cnt;
130                         }
131                 }
132         }
133
134         if ($verbose) {
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);
140                 print "\n";
141         }
142         # write mail to folder
143         if (! $testonly ) {
144                 if ($create_dirs) {
145                         $targetdir = $outdir.'/'.$folder ;
146                         ( -d $outdir)    || mkdir $outdir;
147                         ( -d $targetdir) || mkdir $targetdir;
148                 }
149
150                 open (OUTFILE, ">".$targetdir.'/'.$mailname);
151                 foreach (@lines) { printf OUTFILE "$_\n" ; }
152                 close (OUTFILE);
153
154                 if ($incl_attach) { 
155                         include_attachment($targetdir.'/'.$mailname);
156                 }
157         }
158 }
159
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 ;
168         
169         my $entity ;
170         my %attachments ;
171         my %CID ;
172
173         $parser->output_to_core(1);             # dont save to harddisk
174         $entity = $parser->parse_open($mailname);
175
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
180                         ["']?           # delete quote
181                         \s?;\s?         # separator ; (opt. spaces)
182                         ["']?           # 2. start (s.a.)
183                         ([^"';]+)       #
184                         ["']?
185                         /x ) {  $attachments{$1} = $2 ;
186                 }
187         }
188         foreach ($entity->head->get('X-CalypsoHtmlBody')) {
189                 if (m/["']?             # 1. start with " or ' (or none)
190                         ([^"';]+)       # word till quote or separator
191                         ["']?           # delete quote
192                         \s?;\s?         # separator ; (opt. spaces)
193                         ["']?           # 2. start (s.o.)
194                         ([^"';]+)       #
195                         ["']?
196                         /x ) {  $attachments{$1} = $2 ;
197                 }
198         }
199         foreach ($entity->head->get('X-CalypsoHtmlImg')) {
200                 if (m/["']?             # 1. start with " or ' (or none)
201                         ([^"';]+)       # word till quote or separator
202                         ["']?           # delete quote
203                         \s?;\s?         # separator ; (opt. spaces)
204                         ["']?           # 2. start (s.a.)
205                         ([^"';]+)       #
206                         ["']?
207                         \s?;\s?         # separator ; (opt. spaces)
208                         ["']?           # 3. start (s.a.)
209                         ([^"';]+)       #
210                         ["']?
211                         /x ) {  $attachments{$1} = $3 ;
212                                 $CID{$1} = $2 ;
213                 }
214         }
215         
216         if (%attachments) {
217                 # read attachment
218                 foreach my $key (keys (%attachments)) {
219                         our $attachdir;
220                         my $type ;
221                         my $enc ;
222                         my $fnam = $key;
223                         $fnam =~ tr#\\#/#       if -d '/' ; # correct path names on unix like OS
224                         $fnam = $mboxdir .'/'. $fnam ;
225                         $type = guess_media_type($fnam);
226
227                         if ( $type =~ m/text/i )  { $enc = "8bit" }
228                         else                      { $enc = "base64" }
229
230                         $entity->attach(Path     => $fnam,
231                                         Type     => $type,
232                                         Encoding => $enc,
233                                         Filename => $attachments{$key}
234                                         );
235                 }
236                 
237                 my $lines = $entity->as_string ;
238                 # correct images names in html messages
239                 foreach (keys (%CID)) {
240                         $lines =~ s/CID:$CID{$_}/$attachments{$_}/eg;
241                 }
242                 
243                 print $mailname."\n";
244                 # qx(mv $mailname $mailname.bak);
245                 open ( MAIL, ">".$mailname );
246                 print( MAIL $lines );
247                 close( MAIL );
248         }
249 }
250