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