claws-mail/tools/calypso_convert.pl

#!/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 ;
			my $curdir = '';
			foreach (split('/',$targetdir)) {
				$curdir .= $_ . '/';
				( -d $curdir) || mkdir $curdir;
			}
		}

		open (OUTFILE, ">".$targetdir.'/'.$mailname);
		foreach (@lines) { print 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 );
	}
}