#!/usr/bin/perl
###########################################################################
# Best viewed with tab stops set to 4 spaces.
###########################################################################

###########################################################################
# upgrade_from_eudora 
###########################################################################
# This script gathers the mailboxes and filter information from 
# Eudora (4.3, maybe earlier) and makes the data available for the Mail app
# from OSX PB.  Use it like this
#   upgrade_from_eudora /Users/me/Documents/my_Eudora
#   upgrade_from_eudora [uses the current dir]
# 
###########################################################################
# Author   : Randal Cox
# email    : randal@IntegratedGenomics.com
# Date     : 10/9/2000
# Liscence : Freeware, but you may not modify this and then redistribute it.
#          : Do not distribute it in any commercial archives without my 
#          : permission
###########################################################################

use strict;
main(@ARGV);

###########################################################################
# Get and translate the filters
###########################################################################
sub main {
	my ($eudora) = @_;
	my (
		$filter,	$efilter,		@efilters,
		$mbox,		$embox,			@emboxes,		$dmbox,
	);
	if (!$eudora) {$eudora = `pwd`;}
	FILTERS:
		goto MBOXES;
		print "Transfering filters\n===================\n";
		# get the old mail filters, if any
		$filter = "/Users/$ENV{USER}/Library/Mail/MessageSorting.plist";
		if (-e $filter) {
			$filter = loadfile("/Users/$ENV{USER}/Library/Mail/MessageSorting.plist");
			$filter = substr(substr($filter,0,-2),2);
			$filter .= ",";
		}
		$filter .= translate_filters(loadfile("$eudora/Eudora Filters"));
		$filter = "(\n$filter)";
		savefile("/Users/$ENV{USER}/Library/Mail/MessageSorting.plist",$filter);
	
	MBOXES:
		print "Transfering Mailboxes\n=====================\n";
		@emboxes = loaddir("$eudora/Mail Folder");
		foreach $embox (@emboxes) {
			$embox = substr($embox,length("$eudora/Mail Folder")+1);
			print "$embox\n";
			$mbox = uniquename("/Users/$ENV{USER}/Mailboxes/$embox") . '/mbox';
			$dmbox = loadfile("$eudora/Mail Folder/$embox");
			$dmbox =~ s/(\015|\012)/\n/g;
			savefile($mbox,$dmbox);
		}

	DONE:
	print "done!\n";
}

###########################################################################
sub uniquename ($;$) {
	my ($path) = @_;
	my $n = 0;
	sub _n {if ($_[1]==0) {return "$_[0].mbox";} return "$_[0].$_[1].mbox";}
	while (-e _n($path,$n)) {$n++;}
	return _n($path,$n);
}
sub loadfile ($) {
	my ($file) = @_;
	my ($d,$c);
	
	if (!open(IN,$file)) {
		print "failed to load $file: $!\n";
		return '';
	}
	$d = $/;	$/ = undef;	$c = <IN>;	$/ = $d;
	return $c;
}
sub savefile ($$) {
	my ($file,$data) = @_;
	$file =~ m/(.*)\/([^\/]+)$/;
	if (!dir_create($1)) {return undef;}
	if (!open(OUT,">$file")) {
		print "failed to save to $file: $!\n";
		return '';
	}
	print OUT $data;
	close OUT;
	chmod 0700, $file;
	return 1;
}
sub dir_create ($) {
	my ($dir) = @_;
	my ($path,$leaf,$e,$d);
	if (-e($dir) && -d($dir)) {return 1;}
	# check the dir above this one
	$dir =~ m/(.*)\/([^\/]+)$/;
	($path,$leaf) = ($1,$2);
	$e = -e($path);
	$d = -d($path);
	if ($e && !$d) {return undef;}
	if (!$e) {if (!dir_create($path)) {return undef;}}
	if (!mkdir($dir,0777)) {return undef;}
	chmod 0744, $dir;
	return 1;
}
sub loaddir ($) {
	my ($dir) = @_;
	my ($d,@sub,@res);
	if (!opendir(DIR,$dir)) {
		print "couldn't open dir $dir: $!\n";
		return ();
	}
	@res = readdir DIR;
	close DIR;
	@sub = ();
	foreach $d (@res) {
		if (substr($d,0,1) eq '.') {next;}
		if (-d "$dir/$d") 	{push @sub,loaddir("$dir/$d");}
		else 				{push @sub,"$dir/$d";}
	}
	return @sub;
}
sub translate_filters ($) {
	my ($efilter) = @_;
	my (@efilters,$filter,$rule,$hdr,$exp,$mbox);
	$filter = '';
	$efilter =~ s/(\012|\015)/\n/g;
	$efilter = substr($efilter,4);
	@efilters = split "\nrule",$efilter;
	foreach $efilter (@efilters) {
		# get the name of the filter
		$efilter =~ m/^\s+(.+)/;				$rule = $1;		
		chomp $rule;							$rule =~ s/ÇAny (Header|Recipient)È://g;	
		# get the header lines to match against
		$efilter =~ m/header\s+([^\n]+)/;		$hdr = $1;
		chomp $hdr;								$hdr =~ s/ÇAny (Header|Recipient)È/From or To/g;	
		# get the matching\expression
		$efilter =~ m/value\s+([^\n]+)/;		$exp = $1;
		chomp $exp;							
		# and where to put it
		$efilter =~ m/transfer\s+([^\n]+)/;		$mbox = $1;
		chomp $mbox;							$mbox =~ s/:/\//g;
		printf "Rule: %-20s\n      if '%s' matches '%s',\n      transfer to mailbox '%s'\n",$rule,$hdr,$exp,$mbox;
		# save the results
		$filter .= "    {\n";
		$filter .= "        Active = 1; \n";
		$filter .= "        CaseSensitive = 0; \n";
		$filter .= "        Expression = \"$exp\"; \n";
		$filter .= "        Header = \"$hdr\"; \n";
		$filter .= "        Mailbox = \"~/Mailboxes$mbox\"; \n";
		$filter .= "        RuleName = \"$rule\"; \n";
		$filter .= "    }, \n";
	}
		return $filter;
}