#!/usr/bin/perl -w
#
# Palm2mutt $Revision: 0.3.1.2 $
#
# This program is free software; you can do whatever the hell you
# want with it, as long as you give me credit for writing it, and
# as long as you take ABSOLUTELY ALL RESPONSIBILITY FOR ITS USE.


use strict;
use Getopt::Std;
use Palm::PDB;
use Palm::Address;


my %opts;
my $infile;
my $outfile;
my %addresses; # addresses we extract
my %conflicts; # addresses from other file
my %emails; # reverse hash containing all emails

sub hdr {
	print <<'EOF';
# Palm 2 Mutt - Converts from PalmPilot to mutt format.
# $Revision: 0.3.1.2 $
#
# Copyright (C) 2001  jason thaxter <codez\@ahab.com>

# Palm2mutt comes with ABSOLUTELY NO WARRANTY.

EOF
}

sub usage {
	print STDERR <<EOF;
Usage: $0 [-fhimq] [-c <aliases>] <infile>

Infile is a palm addressbook db file.  For each e-mail address,
an alias is created and printed to stdout in mutt alias format.

Options:
	-c      Don't allow clashes with this mutt aliases file
	-h      Print this help message.
	-i      Interactively select aliases if they don't look nice
	-m      Merge this mutt aliases file into the output
	-q      Do not print anything to stdout.
EOF
exit(1);
}


getopts('fhimqc:', \%opts);

if ($opts{h}){ &usage; }

# Need at least infile
if($#ARGV==0){
	$infile = $ARGV[0];
} else {
	print STDERR "Wrong number of arguments!\n";
	&usage;
}

if (!$opts{q}) { &hdr; }

# TODO: Load an existing aliases file to prevent clashes
if($opts{c}){
	open CONF, "<$opts{c}" or die "Can't open conflicts file $opts{c}: $!";
	while (<CONF>){
		if (/\s*alias\s+(\w*)\s+.*\s+<(.*)>/){
			my $n = $1;
			my $e = $2;
			print "# got alias $1 for email $2\n";
			$conflicts{$1} = $2;
			$emails{$2} = $1;
		}
	}
}

# TODO: Interactive mode for aliases

my $pdb = new Palm::PDB;
$pdb->Load($infile);

my @records = @{$pdb->{records}};

print "# Have $#records records in $infile\n" unless $opts{q};

my $n;

for ($n=0;$n<$#records;$n++){

	my $i;

	# Take any phone records that look like an email
	for($i=1;$i<6;$i++){
		if ($records[$n]->{fields}{"phone".$i} 
				&& $records[$n]->{fields}{"phone".$i}=~/([a-zA-Z0-9._\-]+)@([a-zA-Z0-9._\-]+)/){

			# PREPARATION
			my ($fn,$ln,$email,$to,$filn,$lnfn,$alias);
			$ln = ( $records[$n]->{fields}{name} ? $records[$n]->{fields}{name} : '');
			$fn = ( $records[$n]->{fields}{firstName} ? $records[$n]->{fields}{firstName} : '');
			$email = ( $records[$n]->{fields}{"phone".$i} ? $records[$n]->{fields}{"phone".$i} : '');
			$to = $1; # "Assume" this is OK
			$to =~ tr/A-Z/a-z/; # To lc
			$filn = $ln . ($fn?substr($fn,0,1):$fn); #First initial, last name
			$filn =~ tr/A-Za-z0-9.//cd; # clean it up
			$filn =~ tr/A-Z/a-z/;
			$lnfn = $ln  . $fn; #last name, first name
			$lnfn =~ tr/A-Za-z0-9.//cd; # clean it up
			$lnfn =~ tr/A-Z/a-z/; 
			$alias = '';
			# LOGIC

			# Don't do multiple aliases for same email: TODO: make option?
			if ($emails{$email}){ next; }
			else {$emails{$email} = 1;}

			# PICK A GOOD ALIAS
			# First try the first part of the email, if its shorter
			if((length($to) <= length($ln) || !length($ln)) && !$addresses{$to}){
				$alias = $to;
			}
			# Next, try first initial, last name
			elsif(!$addresses{$filn}){
				$alias = $filn;
			}
			# Try last name, first name
			elsif(!$addresses{$lnfn}){
				$alias = $lnfn;
			}
			else {
				# Last resort: lastname . record index
				$alias = "$ln$n";
			}


			if($alias){ 
				# Pump output into hash
				$addresses{$alias} = "\"$ln, $fn\" <$email>";
			} else {
				print STDERR "Can't make useful alias for $email\n";
			}

		}
	}
}

# Print out aliases
my $k;
if($outfile){ open FOUT,">$outfile" or die "Can't open outfile $outfile: $!"; }
foreach $k (sort keys %addresses){
	print FOUT "alias $k $addresses{$k}\n" if $outfile;
	print "alias $k $addresses{$k}\n" unless $opts{q};
}
close FOUT;