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