added calypso import script
authorThorsten Maerz <torte@netztorte.de>
Fri, 19 Jul 2002 15:49:28 +0000 (15:49 +0000)
committerThorsten Maerz <torte@netztorte.de>
Fri, 19 Jul 2002 15:49:28 +0000 (15:49 +0000)
ChangeLog.claws
tools/Makefile.am
tools/README
tools/calypso_convert.pl [new file with mode: 0644]

index df2a5a3..714a942 100644 (file)
@@ -1,3 +1,13 @@
+2002-07-19 [thorsten]  0.7.8claws78
+
+       * tools/calypso_import.pl       ** NEW FILE **
+         tools/README
+         tools/Makefile.am
+               script to import mbox files exported
+               by calypso
+               o generates folder structure
+               o includes attachments
+
 2002-07-19 [melvin]    0.7.8claws77
 
        * src/selective_download.[ch]
index fc63948..18a41d8 100644 (file)
@@ -1,4 +1,5 @@
 EXTRA_TOOLS = \
+       calypso_import.pl \
        eud2gc.py \
        filter_conv.pl \
        gif2xface.pl \
index d4aae6c..bb01dbf 100644 (file)
@@ -1,3 +1,30 @@
+* calypso_import.pl
+
+  WHAT IT DOES
+
+  This perl script imports mbox files that are exported by Calypso.
+  It recreates the folder structure by scanning the "X-CalypsoFolder"
+  header and reincludes the attachments referenced in the
+  "X-CalypsoHtmlBody" "X-CalypsoAccount" "X-Attachment" headers.
+  
+  HOW TO USE IT
+
+  Export the Calypso mailbox by selecting "Save to archive" and check
+  the "Save attachments" box.
+  Edit the script to set following variables (at the top of the file):
+    $mboxdir  : path to the exported mbox, e.g. 'Archive' or '.'
+    $mboxfile : name of exported mbox, e.g. 'mail.txt'
+    $outdir   : name of the MH folder to create, e.g. 'Calypso'
+  Run the script using
+    perl calypso_import.pl
+  Finally, import that folder by either selecting "New mailbox" or
+  moving it into your existing directory and recreate the folder
+  structure manually (contentmenu from folderview).
+
+  Any questions, comments or problems, contact Thorsten Maerz <torte@netztorte.de>
+
+-----------------------------------------------------------------------
+
 * eud2gc.py
 
   WHAT IT DOES
diff --git a/tools/calypso_convert.pl b/tools/calypso_convert.pl
new file mode 100644 (file)
index 0000000..19ddc89
--- /dev/null
@@ -0,0 +1,250 @@
+#!/usr/bin/perl
+# calypso_import.pl
+# Author: Thorsten Maerz <info@netztorte.de>
+# License: GPL
+# Dependencies: MIME::Parser, LWP::MediaTypes from www.cpan.org
+# Converts mbox files as exported from Calypso to MH format. Regenerates
+# Calypso's folder structure and optionally includes the attachments.
+
+use strict ;
+
+our $mboxdir   = ''            || showhelp();  # enter path to exported mbox
+our $mboxfile  = ''            || showhelp();  # enter name of exported mbox
+our $outdir    = ''            || showhelp();  # enter destination path
+
+my $incl_attach        = 1 ;           # include attachments (needs CPAN modules)
+my $verbose    = 1 ;           # show some headers of processed mail
+my $testonly   = 0 ;           # dont create any files
+
+################################################################################
+# no user servicable parts below :)
+
+if ($incl_attach) {
+       use MIME::Parser;
+       use LWP::MediaTypes qw(guess_media_type);
+}
+
+my $mbox       = "$mboxdir/$mboxfile";
+my $calypso_hdr = 'From \?\?\?@\?\?\? ';  #Mon Apr 17 00:37:38 2000
+my $hdr_Folder = 'X-CalypsoFolder:';
+my $hdr_HTML   = 'X-CalypsoHtmlBody:';
+my $hdr_Account        = 'X-CalypsoAccount:';
+my $hdr_Attach = 'X-Attachment:';
+my %mail_nr;
+my $create_dirs        = 1 ;           # create dirs from "X-Calypso-Folder:" header
+
+################################################################################
+sub showhelp {
+       die ( "You have not yet configured this script.\n"
+           . "Please provide the correct path and file names, e.g\n"
+           . "\tour \$mboxdir  = 'Archive'\n"
+           . "\tour \$mboxfile = 'mail.txt'\n"
+           . "\tour \$outdir   = 'Calypso'\n"
+           . "at the top of $0\n"
+           );
+}
+
+################################################################################
+#
+# MAIN : scan $mbox linewise
+# Create a separate message for each $calypso_hdr found (MH format)
+# $attach_full = filename with path, $attach_short = original attachment name 
+# $folder = Calypso folder
+#
+################################################################################
+my ($folder, $html, $html_full, $html_short,
+    $account, $attach, $attach_short, $attach_full);
+my @lines ;
+
+open (INBOX, "<".$mbox);
+while (<INBOX>) {
+       s/\x0d\x0a//;
+       s/\x0d//;
+       s/\x0a//;
+       if (m/^$calypso_hdr/) {
+               if (@lines) {
+                       $mail_nr{$folder}++ ;
+                       shift @lines ;          # remove blank line
+                       savemail();
+
+                       @lines = () ;
+                       $folder = $html = $html_full = $html_short = $account
+                               = $attach = $attach_short = $attach_full = "";
+
+               }
+       }
+       else {
+               if (/^$hdr_Folder /)    {       $folder         = $' ;
+                                               $folder         =~ s/"//eg ;
+                                               $folder         =~ tr#\\#\/# ;
+               } 
+               if (/^$hdr_HTML /)      {       $html           = $' ;
+                                               $html           =~ s/"//eg ;
+                                               $html           =~ tr#\\#\/# ;
+                                               if ($html       =~ /; /) {
+                                                       $html_full  = $` ;
+                                                       $html_short = $' ;
+                                               }
+               }
+               if (/^$hdr_Account /)   {       $account        = $' ;
+                                               $account        =~ s/"//eg ;
+               }
+               if (/^$hdr_Attach /)    {       $attach         = $' ;
+                                               $attach         =~ s/"//eg ;
+                                               $attach         =~ tr#\\#\/# ;
+                                               if ($attach     =~ /; /) {
+                                                       $attach_full  = $` ;
+                                                       $attach_short = $' ;
+                                               }
+               }
+               
+               push (@lines, $_ );
+       }
+}
+close (INBOX);
+
+################################################################################
+#
+# sub:savemail
+# Saves mail in @lines to $outdir/$folder/$mail_nr
+# Folder is created unless $testonly or (not $create_dirs) is set
+#
+################################################################################
+sub savemail {
+       my $mailname = $mail_nr{$folder};
+       my %headers;
+       my $ishead=1;
+       my $lineno=0;
+       my $targetdir="";
+
+       # extract headers
+       foreach (@lines) {
+               my ($hdr,$cnt);
+               $lineno++;
+       
+               m/^$/ and ($ishead="");
+               if ( $ishead ) {
+                       if (m/: /) {
+                               ($hdr,$cnt) = ($`,$');
+                               $headers{$hdr}=$cnt;
+                       }
+               }
+       }
+
+       if ($verbose) {
+               print "MAIL : $mailname\n";
+               print "FOLDER   : $folder\n"                            if ($folder);
+               print "HTML     : $html_short ($html_full)\n"           if ($html);
+               print "ACCOUNT  : $account\n"                           if ($account);
+               print "ATTACH   : $attach_short ($attach_full)\n"       if ($attach);
+               print "\n";
+       }
+       # write mail to folder
+       if (! $testonly ) {
+               if ($create_dirs) {
+                       $targetdir = $outdir.'/'.$folder ;
+                       ( -d $outdir)    || mkdir $outdir;
+                       ( -d $targetdir) || mkdir $targetdir;
+               }
+
+               open (OUTFILE, ">".$targetdir.'/'.$mailname);
+               foreach (@lines) { printf OUTFILE "$_\n" ; }
+               close (OUTFILE);
+
+               if ($incl_attach) { 
+                       include_attachment($targetdir.'/'.$mailname);
+               }
+       }
+}
+
+################################################################################
+# make inline attachment from external file
+# uses MIME::Parser, LWP::MediaTypes from www.cpan.org
+# (Currently leaves a blank attachment in converted mails. Feel free to
+# improve this script)
+sub include_attachment() {
+       my $mailname = shift ;
+       my $parser = new MIME::Parser ;
+       
+       my $entity ;
+       my %attachments ;
+       my %CID ;
+
+       $parser->output_to_core(1);             # dont save to harddisk
+       $entity = $parser->parse_open($mailname);
+
+       # look for external attachments
+       foreach ($entity->head->get('X-Attachment')) {
+               if (m/["']?             # 1. start with " or ' (or none)
+                       ([^"';]+)       # word till quote or separator
+                       ["']?           # delete quote
+                       \s?;\s?         # separator ; (opt. spaces)
+                       ["']?           # 2. start (s.a.)
+                       ([^"';]+)       #
+                       ["']?
+                       /x ) {  $attachments{$1} = $2 ;
+               }
+       }
+       foreach ($entity->head->get('X-CalypsoHtmlBody')) {
+               if (m/["']?             # 1. start with " or ' (or none)
+                       ([^"';]+)       # word till quote or separator
+                       ["']?           # delete quote
+                       \s?;\s?         # separator ; (opt. spaces)
+                       ["']?           # 2. start (s.o.)
+                       ([^"';]+)       #
+                       ["']?
+                       /x ) {  $attachments{$1} = $2 ;
+               }
+       }
+       foreach ($entity->head->get('X-CalypsoHtmlImg')) {
+               if (m/["']?             # 1. start with " or ' (or none)
+                       ([^"';]+)       # word till quote or separator
+                       ["']?           # delete quote
+                       \s?;\s?         # separator ; (opt. spaces)
+                       ["']?           # 2. start (s.a.)
+                       ([^"';]+)       #
+                       ["']?
+                       \s?;\s?         # separator ; (opt. spaces)
+                       ["']?           # 3. start (s.a.)
+                       ([^"';]+)       #
+                       ["']?
+                       /x ) {  $attachments{$1} = $3 ;
+                               $CID{$1} = $2 ;
+               }
+       }
+       
+       if (%attachments) {
+               # read attachment
+               foreach my $key (keys (%attachments)) {
+                       our $attachdir;
+                       my $type ;
+                       my $enc ;
+                       my $fnam = $key;
+                       $fnam =~ tr#\\#/#       if -d '/' ; # correct path names on unix like OS
+                       $fnam = $mboxdir .'/'. $fnam ;
+                       $type = guess_media_type($fnam);
+
+                       if ( $type =~ m/text/i )  { $enc = "8bit" }
+                       else                      { $enc = "base64" }
+
+                       $entity->attach(Path     => $fnam,
+                                       Type     => $type,
+                                       Encoding => $enc,
+                                       Filename => $attachments{$key}
+                                       );
+               }
+               
+               my $lines = $entity->as_string ;
+               # correct images names in html messages
+               foreach (keys (%CID)) {
+                       $lines =~ s/CID:$CID{$_}/$attachments{$_}/eg;
+               }
+               
+               print $mailname."\n";
+               # qx(mv $mailname $mailname.bak);
+               open ( MAIL, ">".$mailname );
+               print( MAIL $lines );
+               close( MAIL );
+       }
+}
+