Fix possible resource leak
[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                         my $curdir = '';
147                         foreach (split('/',$targetdir)) {
148                                 $curdir .= $_ . '/';
149                                 ( -d $curdir) || mkdir $curdir;
150                         }
151                 }
152
153                 open (OUTFILE, ">".$targetdir.'/'.$mailname);
154                 foreach (@lines) { print OUTFILE "$_\n" ; }
155                 close (OUTFILE);
156
157                 if ($incl_attach) { 
158                         include_attachment($targetdir.'/'.$mailname);
159                 }
160         }
161 }
162
163 ################################################################################
164 # make inline attachment from external file
165 # uses MIME::Parser, LWP::MediaTypes from www.cpan.org
166 # (Currently leaves a blank attachment in converted mails. Feel free to
167 # improve this script)
168 sub include_attachment() {
169         my $mailname = shift ;
170         my $parser = new MIME::Parser ;
171         
172         my $entity ;
173         my %attachments ;
174         my %CID ;
175
176         $parser->output_to_core(1);             # dont save to harddisk
177         $entity = $parser->parse_open($mailname);
178
179         # look for external attachments
180         foreach ($entity->head->get('X-Attachment')) {
181                 if (m/["']?             # 1. start with " or ' (or none)
182                         ([^"';]+)       # word till quote or separator
183                         ["']?           # delete quote
184                         \s?;\s?         # separator ; (opt. spaces)
185                         ["']?           # 2. start (s.a.)
186                         ([^"';]+)       #
187                         ["']?
188                         /x ) {  $attachments{$1} = $2 ;
189                 }
190         }
191         foreach ($entity->head->get('X-CalypsoHtmlBody')) {
192                 if (m/["']?             # 1. start with " or ' (or none)
193                         ([^"';]+)       # word till quote or separator
194                         ["']?           # delete quote
195                         \s?;\s?         # separator ; (opt. spaces)
196                         ["']?           # 2. start (s.o.)
197                         ([^"';]+)       #
198                         ["']?
199                         /x ) {  $attachments{$1} = $2 ;
200                 }
201         }
202         foreach ($entity->head->get('X-CalypsoHtmlImg')) {
203                 if (m/["']?             # 1. start with " or ' (or none)
204                         ([^"';]+)       # word till quote or separator
205                         ["']?           # delete quote
206                         \s?;\s?         # separator ; (opt. spaces)
207                         ["']?           # 2. start (s.a.)
208                         ([^"';]+)       #
209                         ["']?
210                         \s?;\s?         # separator ; (opt. spaces)
211                         ["']?           # 3. start (s.a.)
212                         ([^"';]+)       #
213                         ["']?
214                         /x ) {  $attachments{$1} = $3 ;
215                                 $CID{$1} = $2 ;
216                 }
217         }
218         
219         if (%attachments) {
220                 # read attachment
221                 foreach my $key (keys (%attachments)) {
222                         our $attachdir;
223                         my $type ;
224                         my $enc ;
225                         my $fnam = $key;
226                         $fnam =~ tr#\\#/#       if -d '/' ; # correct path names on unix like OS
227                         $fnam = $mboxdir .'/'. $fnam ;
228                         $type = guess_media_type($fnam);
229
230                         if ( $type =~ m/text/i )  { $enc = "8bit" }
231                         else                      { $enc = "base64" }
232
233                         $entity->attach(Path     => $fnam,
234                                         Type     => $type,
235                                         Encoding => $enc,
236                                         Filename => $attachments{$key}
237                                         );
238                 }
239                 
240                 my $lines = $entity->as_string ;
241                 # correct images names in html messages
242                 foreach (keys (%CID)) {
243                         $lines =~ s/CID:$CID{$_}/$attachments{$_}/eg;
244                 }
245                 
246                 print $mailname."\n";
247                 # qx(mv $mailname $mailname.bak);
248                 open ( MAIL, ">".$mailname );
249                 print( MAIL $lines );
250                 close( MAIL );
251         }
252 }
253