#!/usr/bin/perl -w

# Hasan Diwan <diwanh@rpi.edu>
# Charles Ritter <ritter@pobox.com>
# Troy A. Johnson <john1536@tc.umn.edu>

# Addressbook 0.3?
# VCard 3.0 [RFC 2426 (included)]- compliant with the exception of:
# non-internet email -- does anyone use this anymore?
# GEO -- don't see the need for this
# Organization types -- I don't need these, if you do, feel free to
#  add them and submit them to me for the next release
# Binary file inclusion -- above applies
# non-PGP authentication methods -- I'm trying to figure out how to
#  implement this
# Oh, yes, remember, this is released open-source for a reason.
#  Please suggest improvements, make fixes; but give credit where
#  credit is due. If you make a bugfix, kindly add your name and
#  email address before the blank line above the title of the program.

# global variables
$datadir = "$ENV{'HOME'}/.data";
$response = "";
$debug = 0;

# check if data directory exists and if not, create it
if (! -d $datadir)
{
	$response = mkdir($datadir, 0755);
	if (! $response) { die "Cannot create \"$datadir\": $!.\n"; }
}
# move to data directory
$response = chdir($datadir);
if (! $response) { die "Cannot change to \"$datadir\": $!.\n"; }

# run the program and exit
&main;
exit 0;

# main menu
sub main
{
	$choice = "";
	while ($choice !~ /[EeQq]/)
	{
		print "\n";
		print "\tAddressbook\n";
		print "\t===========\n";
		print "\t[I]nsert contact\n";
		print "\t[V]iew all\n";
		print "\t[E]xit\n";
		print "\t--> ";
		$choice = &getinput;
		if ($choice =~ /[Ii]/) { &insert; }
		elsif ($choice =~ /[Vv]/) { &view; }
	}
}

# standardize the retrieval of user input
# (and put newlines in the output files only where you want them to be)
sub getinput
{
	my $input = <STDIN>;
	chomp($input);
	return $input;
}


sub getdata
{
	my $recr = shift;

	print "New Record\n";
	print "==========\n";
	$recr->{'FN'} = "";
	while (! $recr->{'FN'})
	{
		print "Full name [prefix first middle last suffix]: ";
		$recr->{'FN'} = &getinput;
	}
	my @n = &nameparse($recr->{'FN'});
	$recr->{'N'} = "$n[3];$n[1];$n[2];$n[0];$n[4]";

	print "Nicknames (comma separated): ";
	$recr->{'NICK'} = &getinput;

	print "Birthday [YYYY-MM-DD]: ";
	$recr->{'BDAY'} = &getinput;

	print 'PO Box: ';
	$recr->{'pobox'} = &getinput;
	print "Street Address [Line 1]: ";
	$recr->{'street1'} = &getinput;
	print "Street Address [Line 2]: ";
	$recr->{'street2'} = &getinput;
	print "City: ";
	$recr->{'city'} = &getinput;
	print "State/Region: ";
	$recr->{'state'} = &getinput;
	print "Postal Code: ";
	$recr->{'zip'} = &getinput;
	print "Country: ";
	$recr->{'country'} = &getinput;
	$recr->{'addr'} = join (';',
		$recr->{'pobox'}, $recr->{'street2'}, $recr->{'street1'},
		$recr->{'city'}, $recr->{'state'}, $recr->{'zip'},
		$recr->{'country'});
	print "Address Type [dom|intl|post|parcel|home|work|pref] (comma separated): ";
	$recr->{'LABEL'} = &getinput;
	$recr->{'ADR'} = $recr->{'LABEL'} . ":" . $recr->{'addr'};

	print "Phone number [+[country_code]-[city]-[number]]: ";
	$recr->{'phone'} = &getinput;
	print "Phone Type [home|msg|work|pref|voice|data|cell|video|fax|pager|bbs|modem|car|isdn|pcs] (comma separated): ";
	$recr->{'ptype'} = &getinput;
	$recr->{'ptype'} = "voice" unless ($recr->{'ptype'});
	$recr->{'TEL'} = $recr->{'ptype'} . ":" . $recr->{'phone'};

	print "Electronic Mail: ";
	$recr->{'email'} = &getinput;
	print "EmailType [internet|x400|uucp][,pref] (comma separated): ";
	$recr->{'etype'} = &getinput;
	$recr->{'etype'} = "internet" unless ($recr->{'etype'});
	$recr->{'EMAIL'} = $recr->{'etype'} . ":" . $recr->{'email'};

	print "Time offset from GMT: ";
	$recr->{'TZ'} = &getinput;
	$recr->{'TZ'} = 0 unless ($recr->{'TZ'});
	if ($recr->{'TZ'} !~ /^[+-]/)
		{ $recr->{'TZ'} = '+' . $recr->{'TZ'}; }
	if ($recr->{'TZ'} !~ /:\d\d$/)
		{ $recr->{'TZ'} = $recr->{'TZ'} . ":00"; }

	print "Homepage [URL]: ";
	$recr->{'URL'} = &getinput;

	print "PGP key location [URL]: ";
	$recr->{'KEY'} = &getinput;

	return;
}


sub insert 
{
	my %rec =();
	&getdata(\%rec);
	if (! scalar %rec) { return; }

	opendir (D, $datadir);
	@entries = readdir(D);
	closedir(D);

	my $record = scalar(@entries) - 1; 
	$record .= ".vcf";

	open(O, "> $record") or die "$record: $!";

	print O "BEGIN:VCARD\n";
	print O "FN:$rec{'FN'}\n";
	print O "N:$rec{'N'}\n";
	print O "NICKNAME:$rec{'NICK'}\n" if ($rec{'NICK'});
	print O "BDAY:$rec{'BDAY'}\n" if ($rec{'BDAY'});
	print O "ADR;TYPE=$rec{'ADR'}\n" if ($rec{'LABEL'});
	print O "LABEL;TYPE=$rec{'LABEL'}\n" if ($rec{'LABEL'});
	print O "TEL;LABEL=$rec{'TEL'}\n" if ($rec{'phone'});
	print O "EMAIL;TYPE=$rec{'EMAIL'}\n" if ($rec{'email'});
	print O "TZ:$rec{'TZ'}\n";
	print O "URL:$rec{'URL'}\n" if ($rec{'URL'});
	print O "VERSION:3.0\n";
	print O "KEY;ENCODING=t:$rec{'KEY'}\n" if ($rec{'KEY'});
	print O "END:VCARD\n";
	close(O);

	return;
}


sub view
{
	my @entries = ();
	my $entry = "";
	my $file = "";
	my $choice = "";

	opendir (D, $datadir);
	while ($entry = readdir(D))
	{
		if ($entry =~ /\.vcf$/) { push @entries, $entry; }
	}
	closedir(D);

	foreach $file (@entries)
	{
		&viewone($file);

		print "\tPress O for Options\n";
		print "\t(any other key to continue)\n";
		print "\t--> ";
		$choice = &getinput;
		print "\n";
		if ($choice =~ /[Oo]/) { while (&options($file)) {} }
	}
}


sub viewone
{
	my $file = shift;
	if (! -r $file)
	{
		print "File $file unreadable or not found.\n";
		return 1;
	}
	
	print "-" x 50 . "\n";
	open(F, "< $file");
	while (<F>) { print; }
	close(F);
	print "-" x 50 . "\n";
}


sub rdelete
{
	my $rec = shift;
	my $oldrec = $rec . ".old";

	$response = rename $rec, $oldrec;

	if ($response) { print "Record deleted.\n"; }
	else { print "Record \"$rec\" NOT deleted.\n"; }

	print "\n";
}


sub rmodify
{
	my $rec = shift;
	
	open(O, "< $rec");
	my @lines = <O>;
	close(O);

	print "Modify function not yet implemented.\n";
}


sub options
{
	my $rec = shift;
	my $choice = "";

	print "\n";
	print "\tOptions\n";
	print "\t=======\n";
	print "\t[D]elete record\n";
	print "\t[M]odify record\n";
	print "\t[C]ontinue\n";
	print "\t--> ";

	$choice = &getinput;
	if ($choice =~ /[Cc]/) { return 0; }
	elsif ($choice =~ /[Mm]/) { &rmodify($rec); return 0; }
	elsif ($choice =~ /[Dd]/) { &rdelete($rec); return 0; } 
	return 1;
}


sub nameparse
{
	my ($prefix, $firstname, $middlename, $lastname, $suffix)
		= ("", "", "", "", "");
	my @prefixes = qw(
		mr mrs dr sr mdm msr 
		);
	my @suffixes = qw(
		jr sr esq phd md dvm
		art ctr gcs mcse phd bs
		ba ma ms nce nca aa
		); 

	my $name = shift;
	my @namepart = split /\s+/, $name;

	my $precheck = lc($namepart[0]);
	$precheck =~ s/\.//g;
	foreach $pre (@prefixes)
	{
		if ($precheck eq $pre) { $prefix = shift @namepart; last; }
	}

	my $sufcheck = lc($namepart[scalar(@namepart) - 1]);
	$sufcheck =~ s/\.//g;
	foreach $suf (@suffixes)
	{
		if ($sufcheck eq $suf) { $suffix = pop @namepart; last; }
	}

	if (@namepart) { $firstname = shift @namepart; }
	if (@namepart) { $lastname = pop @namepart; }
	$middlename = join " ", @namepart;

	if ($debug)
	{
		print "prefix = $prefix\n";
		print "firstname = $firstname\n";
		print "middlename = $middlename\n";
		print "lastname = $lastname\n";
		print "suffix = $suffix\n";
	}

	return ($prefix, $firstname, $middlename, $lastname, $suffix);
}