package SyncAB;
# Address Book conduit for PilotManager
# 3/17/98,1/8/99 Alan.Harder@Sun.COM
# http://www.moshpit.org/pilotmgr
# Some assistance with vCard testing and
# coding from Steve.Swales@Sun.COM
#
use PilotSync;
use Tk;
use TkUtils;
use Data::Dumper;
use Carp;

use warnings;

# for vCard encoding
use MIME::Base64;
use MIME::QuotedPrint;

my $VERSION = '0.96 BETAp1';
my ($RCFILE, $APPINFO_FILE, $CANCEL);
my ($gConfigDialog, $gFileLabel, $gFileEntry);
my %gEntryMap = ( 'lastname' => 0,
		  'firstname' => 1,
		  'company' => 2,
		  'phone1' => 3,
		  'phone2' => 4,
		  'phone3' => 5,
		  'phone4' => 6,
		  'phone5' => 7,
		  'address' => 8,
		  'city' => 9,
		  'state' => 10,
		  'zip' => 11,
		  'country' => 12,
		  'title' => 13,
		  'custom1' => 14,
		  'custom2' => 15,
		  'custom3' => 16,
		  'custom4' => 17,
		  'note' => 18,
		  'whichphone' => 'showPhone',
		  'phonetypes' => 'phoneLabel',
		  'category' => 'category',
		  'rolo_id' => 'rolo_id',
		  'updatetop' => 'updatetop',
		  'private' => 'secret',
		  'fullname' => 'fullname',	# only for vcards
		 );
my @gCSVorder = ( 'rolo_id', 'lastname', 'firstname', 'company',
		  'phone1', 'phone2', 'phone3', 'phone4', 'phone5',
		  'address', 'city', 'state', 'zip', 'country', 'title',
		  'custom1', 'custom2', 'custom3', 'custom4', 'note',
		  'whichphone', 'phonetypes', 'category', 'private' );
my @gPhoneTypes = ( ['WORK', 0],	# Work
		    ['HOME', 1],	# Home
		    ['FAX', 2],		# Fax
		    ['PREF', 5],	# Main
		    ['PAGER', 6],	# Page
		    ['CELL', 7],	# Mobile
		    ['INTERNET', 4],	# (Email)
		  );

# set up for SyncAB compatability by default
my %gVCardOpts = (
                  pref => "PREF",
                  encode => "",
                 );

sub conduitInit
{
    $RCFILE = "SyncAB/SyncAB.prefs";
    $APPINFO_FILE = "SyncAB/pilot.appinfo";
    &loadPrefs;

    $PREFS->{'syncType'} = 'CSV'
	unless (defined $PREFS->{'syncType'});
    $PREFS->{'CSVFile'} = "$ENV{HOME}/.csvAddr"
	unless (defined $PREFS->{'CSVFile'});
    $PREFS->{'vCardFile'} = "$ENV{HOME}/.vCards"
	unless (defined $PREFS->{'vCardFile'});
    $PREFS->{'vCardDir'} = "$ENV{HOME}/.dt/Addresses"
	unless (defined $PREFS->{'vCardDir'});
    $PREFS->{'RoloFile'} = "$ENV{HOME}/.rolo"
	unless (defined $PREFS->{'RoloFile'});
    $PREFS->{'vCardStyle'} = "SyncAB"
      unless (defined $PREFS->{'vCardStyle'});

    if ( $PREFS->{'vCardStyle'} eq "SyncAB" ) {
        $gVCardOpts{pref} = "PREF";
        $gVCardOpts{encode} = "";
    } elsif ( $PREFS->{'vCardStyle'} eq "PalmOS 4" ) {
        $gVCardOpts{pref} = "X-PALM-MAIN";
        $gVCardOpts{encode} = ";CHARSET=ISO-8859-1";
#    } elsif ( $PREFS-{'vCardStyle'} eq "Strict 2.1" ) {
#        $gVCardOpts{pref} = "X-PALM-MAIN"; # XXX not sure
#        $gVCardOpts{encode} = ";ENCODING=QUOTED-PRINTABLE";
    }
}

sub conduitQuit
{
    &savePrefs;
}

sub conduitInfo
{
    return { 'database' =>
		{
		    'name' => 'AddressDB',
		    'creator' => 'addr',
		    'type' => 'DATA',
		    'flags' => 0,
		    'version' => 0,
		},
	     'version' => $VERSION,
	     'author' => 'Alan Harder',
	     'email' => 'Alan.Harder@Sun.COM' };
}

sub conduitConfigure
{
    my ($this, $wm) = @_;
    my ($frame, $obj, $subfr, @objs);

    unless (defined $gConfigDialog and $gConfigDialog->Exists)
    {
	$gConfigDialog = $wm->Toplevel(-title => "Configuring SyncAB");
	$gConfigDialog->withdraw;
	$gConfigDialog->transient($wm);
	$frame = $gConfigDialog->Frame(-relief => 'ridge', -bd => 2);

	$frame->Label(-text =>
			"SyncAB v$VERSION\n" . &conduitInfo->{'email'})->pack;

	$subfr = $frame->Frame;
	@objs = TkUtils::Radiobuttons($subfr, \$PREFS->{'syncType'},
				      'CSV', 'vCard single file',
				      'vCard one per file', 'Rolo');
	$objs[0]->configure(-command => sub{
	    $gFileLabel = 'CSV file:';
	    $gFileEntry->configure(-textvariable => \$PREFS->{'CSVFile'});
	});
	$objs[1]->configure(-command => sub{
	    $gFileLabel = 'vCard file:';
	    $gFileEntry->configure(-textvariable => \$PREFS->{'vCardFile'});
	});
	$objs[2]->configure(-command => sub{
	    $gFileLabel = 'vCard dir:';
	    $gFileEntry->configure(-textvariable => \$PREFS->{'vCardDir'});
	});
	$objs[3]->configure(-command => sub{
	    $gFileLabel = 'Rolo file:';
	    $gFileEntry->configure(-textvariable => \$PREFS->{'RoloFile'});
	});
	$subfr->pack(-fill => 'x', -expand => 1);

    $subfr = $frame->Frame;
	$obj = $subfr->Label(-text => "vCard Style:", -width => 12);
	$obj->pack(-side => 'left', -anchor => 'e');
    @objs = TkUtils::Radiobuttons($subfr, \$PREFS->{'vCardStyle'},
                                  'SyncAB', 'PalmOS 4' ); #, 'Strict 2.1');
    $subfr->pack(-fill => 'x', -expand => 1);

	$subfr = $frame->Frame;
	$obj = $subfr->Label(-textvariable => \$gFileLabel, -width => 10);
	$obj->pack(-side => 'left', -anchor => 'e');

	$gFileEntry = $subfr->Entry(-relief => 'sunken', -width => 40);
	$gFileEntry->pack(-fill => 'x', -expand => 1);
	$subfr->pack(-fill => 'x', -expand => 1);

	$obj = TkUtils::Button($frame, 'Dismiss',
			       sub{ $gConfigDialog->withdraw });
	$obj->pack;

	$frame->pack(-fill => 'x', -expand => 1, -anchor => 'n');
	PilotMgr::setColors($gConfigDialog);
    }

    if ($PREFS->{'syncType'} eq 'Rolo')
    {
	$gFileLabel = 'Rolo file:';
	$gFileEntry->configure(-textvariable => \$PREFS->{'RoloFile'});
    }
    elsif ($PREFS->{'syncType'} eq 'CSV')
    {
	$gFileLabel = 'CSV file:';
	$gFileEntry->configure(-textvariable => \$PREFS->{'CSVFile'});
    }
    elsif ($PREFS->{'syncType'} eq 'vCard single file')
    {
	$gFileLabel = 'vCard file:';
	$gFileEntry->configure(-textvariable => \$PREFS->{'vCardFile'});
    }
    elsif ($PREFS->{'syncType'} eq 'vCard one per file')
    {
	$gFileLabel = 'vCard dir:';
	$gFileEntry->configure(-textvariable => \$PREFS->{'vCardDir'});
    }

    $gConfigDialog->Popup(-popanchor => 'c', -overanchor => 'c',
			  -popover => $wm);
}

sub conduitSync
{
    my ($this, $dlp, $info) = @_;
    my ($idField, $file, $reader, $writer);

    if (!exists $PREFS->{'lastSyncType'} or
	$PREFS->{'syncType'} ne $PREFS->{'lastSyncType'})
    {
	# Full reset if changing sync type
	rename "SyncAB/addr.db", "SyncAB/addr.db.bak";
    }

    # if the vcard style has changed (assuming an unset vcard style
    # means you've been using SyncAB's style all along) the we need a
    # full sync as well.
    if ((!exists $PREFS->{'lastvCardStyle'} and
          $PREFS->{'vCardStyle'} ne "SyncAB" ) or
        $PREFS->{'vCardStyle'} ne $PREFS->{'lastvCardStyle'} ) {
    }

    $idField = 'rolo_id';
    if ($PREFS->{'syncType'} eq 'Rolo')
    {
	$file = $PREFS->{'RoloFile'};
	$reader = \&readRolo;
	$writer = \&writeRolo;
    }
    elsif ($PREFS->{'syncType'} eq 'CSV')
    {
	$file = $PREFS->{'CSVFile'};
	$reader = \&readCSV;
	$writer = \&writeCSV;
    }
    elsif ($PREFS->{'syncType'} eq 'vCard one per file')
    {
	$file = $PREFS->{'vCardDir'};
	$reader = \&readVCardsMultipleFiles;
	$writer = \&writeVCardsMultipleFiles;
    }
    elsif ($PREFS->{'syncType'} eq 'vCard single file')
    {
	$file = $PREFS->{'vCardFile'};
	$reader = \&readVCardsOneFile;
	$writer = \&writeVCardsOneFile;
    }
    else
    {
	PilotMgr::msg(
	    "SyncAB does not yet support type $PREFS->{'syncType'}\n");
	return;
    }

    $CANCEL = 0;

    PilotSync::doSync(	$dlp,                        # Dlp
			&conduitInfo->{'database'},              # DbInfo
			['entry', 'phoneLabel', 'showPhone',
			 'category', 'secret', 'id' ],           # ReqFields
			['categoryName', 'phoneLabel', 'label'], # InfoFields
			$idField,                 # IdField
			"SyncAB/addr.db",         # MasterFile
			$file,                    # Datafile
			\&titleString,            # NameHook( $recordhash )
			$reader,                  # ReadHook( $filename )
			$writer,                  # WriteHook( $filename, $recordhash )
			\&newRoloId,              # IdHook( $recordhash, $pilotrec )
			undef,                    # TranslateHook( $pilotrec, $direction )
            undef,                    # AppInfoHook  ( $appinfo, $direction )
            \$CANCEL);

    $PREFS->{'lastSyncType'} = $PREFS->{'syncType'} unless ($CANCEL);
    $PREFS->{'lastvCardStyle'} = $PREFS->{'vCardStyle'} unless ($CANCEL);
}

sub conduitCancel
{
    $CANCEL = 'SyncAB Cancelled!';
}

sub loadPrefs
{
    $PREFS = {}, return unless (-r "$RCFILE");
    use vars qw($PREFS);
    do "$RCFILE";
}

sub savePrefs
{
    $Data::Dumper::Purity = 1;
    $Data::Dumper::Deepcopy = 1;
    $Data::Dumper::Indent = 0;

    if (open(FD, ">$RCFILE"))
    {
	print FD Data::Dumper->Dumpxs([$PREFS], ['PREFS']), "1;\n";
	close FD;
    }
    else
    {
	PilotMgr::msg("Unable to save preferences to $RCFILE!");
    }
}

sub newRoloId
{
    my ($db) = @_;

    return $db->{'NEXT_ID'}++;
}

sub titleString
{
    my ($rec) = @_;
    my ($str, $str2) = ('');

    $str2 = $rec->{'entry'}->[$gEntryMap{'firstname'}];
    $str = $str2 if (&isgood($str2));

    $str2 = $rec->{'entry'}->[$gEntryMap{'lastname'}];
    if (&isgood($str2))
    {
	$str .= ' ' if (length $str);
	$str .= $str2;
    }
    return $str if (length $str);

    $str2 = $rec->{'entry'}->[$gEntryMap{'company'}];
    return $str2 if (&isgood($str2));

    return '-Unnamed-';
}

sub readAppInfoFile
{
    # AppInfo file used by Rolo and CSV formats
    #
    my ($ai, $s) =
	({ 'categoryName' => [], 'label' => [], 'phoneLabel' => [] });

    open(FD, "<$APPINFO_FILE") or return $ai;
    scalar(<FD>);	# read off comment line

    foreach (1..16)
    {
	chomp($s = <FD>);
	push(@{$ai->{'categoryName'}}, $s);
    }
    foreach (1..22)
    {
	chomp($s = <FD>);
	push(@{$ai->{'label'}}, $s);
    }
    foreach (1..8)
    {
	chomp($s = <FD>);
	push(@{$ai->{'phoneLabel'}}, $s);
    }

    close(FD);
    return $ai;
}

sub writeAppInfoFile
{
    my ($ai) = @_;

    open(FD, ">$APPINFO_FILE") or return;
    print FD <<EOW;
WARNING- If you edit this file it will modify your pilot on the next sync!
EOW

    foreach $_ (@{$ai->{'categoryName'}},
		@{$ai->{'label'}},
		@{$ai->{'phoneLabel'}})
    {
	print FD "$_\n";
    }

    close(FD);
}

sub readRolo
{
    my ($ROLOFILE) = @_;
    my ($db, $rec) = ({ 'nonPilot' => [],
			'isPilot' => [],
			'__RECORDS' => [],
			'NEXT_ID' => 0
		      });

    $db->{'__APPINFO'} = &readAppInfoFile;
    open(FD, "<$ROLOFILE") || return $db;

    while (<FD>)
    {
	$rec = { 'topsect' => '' };

	while ($_ !~ /^\*PILOT\*$/ && $_ !~ /^\014/)
	{
	    $rec->{'topsect'} .= $_;
	    $_ = <FD>;
	}

	if ( /^\014/ )
	{
	    push(@{$db->{'isPilot'}}, -1);
	    push(@{$db->{'nonPilot'}}, $rec);
	    next;
	}

	$rec->{'entry'} = [];
	$rec->{'entry'}->[18] = undef;  # ensure right array length
	$rec->{'phoneLabel'} = [0,1,2,3,4];
	$rec->{'showPhone'} = 0;

	for ($_ = <FD>; $_ !~ /^\014/; $_ = <FD>)
	{
	    if ($_ =~ /^([^:]*): ?(.*)$/)
	    {
		$field = $1;
		$value = $2;
		$field =~ tr/A-Z/a-z/;
		$value =~ s/\\n/\n/g;	# translate newlines

		unless (defined $gEntryMap{$field})
		{
		    print "skipping bad field '$field' in rolo record.\n";
		    next;
		}
		$field = $gEntryMap{$field};

		if ($field =~ /^\d+$/)
		{
		    $rec->{'entry'}->[$field] = $value;
		}
		elsif ($field eq 'phoneLabel')
		{
		    $rec->{$field} = [split(/ /, $value)];
		}
		else
		{
		    $rec->{$field} = $value;
		}
	    }
	}
	# 'secret' field value must be 1 or ''
	$rec->{'secret'} = (exists $rec->{'secret'} and $rec->{'secret'})?1:'';
	push(@{$db->{'isPilot'}}, $rec->{'rolo_id'});
	push(@{$db->{'__RECORDS'}}, $rec);
	$db->{ $rec->{'rolo_id'} } = $#{$db->{'__RECORDS'}};

	$db->{'NEXT_ID'} = $rec->{'rolo_id'} + 1
	    if ($rec->{'rolo_id'} >= $db->{'NEXT_ID'});
    }
    close(FD);
    return $db;
}

sub writeRolo
{
    my ($ROLOFILE, $db) = @_;
    my ($rec, $which);

    &writeAppInfoFile($db->{'__APPINFO'});
    unless (open(FD, ">$ROLOFILE"))
    {
	PilotMgr::msg("Unable to write to $ROLOFILE.  Help!");
	return;
    }

    foreach $which (@{$db->{'isPilot'}})
    {
	if ($which < 0)
	{
	    # non-pilot rec
	    $rec = shift @{$db->{'nonPilot'}};
	    print FD $rec->{'topsect'}, "\014\n";
	}

	next unless (defined $db->{'__RECORDS'}->[0] &&
		     $which eq $db->{'__RECORDS'}->[0]->{'rolo_id'});
	$rec->{'topsect'} = &makeTopSect($rec, $db->{'__APPINFO'})
	    unless exists $rec->{'topsect'};
	&writeRec(FD, shift @{$db->{'__RECORDS'}});
    }

    while (defined ($rec = shift @{$db->{'__RECORDS'}}))
    {
	$rec->{'topsect'} = &makeTopSect($rec, $db->{'__APPINFO'})
	    unless exists $rec->{'topsect'};
	&writeRec(FD, $rec);
    }

    close(FD);
}

sub writeRec
{
    my ($fd, $rec) = @_;
    my ($key, $val);

    print $fd $rec->{'topsect'} if defined ($rec->{'topsect'});
    print $fd "*PILOT*\n";
    foreach $key (keys %gEntryMap)
    {
        $val = $gEntryMap{$key};
        if ($val =~ /^\d+$/)
        {
            next unless (defined ($val = $rec->{'entry'}->[$val]));
            $val =~ s/\n/\\n/g; # translate newlines
            print $fd "$key: $val\n";
        }
        else
        {
            # shouldn't be any newlines to translate down here..
            next unless (defined ($val = $rec->{$val}));
            # for phoneLabel field:
            $val = join(' ', @$val) if (ref($val) eq 'ARRAY');
            print $fd "$key: $val\n";
        }
    }
    print $fd "\014\n";
}

sub isgood
{
    return (defined $_[0] and length($_[0]) > 0);
}

sub makeTopSect
{
    my ($rec, $ai) = @_;
    my ($topsect, $boo, $val, $val2, $i, @phonetypes) = ("", 0);

    $val = $rec->{'entry'}->[ $gEntryMap{'lastname'} ];
    $val2 = $rec->{'entry'}->[ $gEntryMap{'firstname'} ];
    $i = $rec->{'entry'}->[ $gEntryMap{'company'} ];
    if (&isgood($val))
    {
	$topsect .= "$val2 " if (&isgood($val2));
	$topsect .= $val;
    }
    elsif (&isgood($val2))
    {
	$topsect .= $val2;
    }
    elsif (&isgood($i))
    {
	$topsect .= $i;
	$boo = 1;
    }

    $topsect .= "\n";
    $val = $rec->{'entry'}->[ $gEntryMap{'title'} ];
    $topsect .= $val . "\n" if (&isgood($val));
    $val = $rec->{'entry'}->[ $gEntryMap{'company'} ];
    $topsect .= $val . "\n" if (!$boo and &isgood($val));
    $topsect .= "\n";

    $val = $rec->{ $gEntryMap{'phonetypes'} };
    @phonetypes = @$val if (defined $val and ref($val) eq 'ARRAY');

    foreach $i (1..5)
    {
	$val = $rec->{'entry'}->[ $gEntryMap{"phone$i"} ];
	if (&isgood($val))
	{
	    $topsect .= @phonetypes ? $ai->{'phoneLabel'}->[$phonetypes[$i-1]]
				    : "phone$i";
	    $topsect .= ": $val\n";
	}
    }
    $topsect .= "\n";

    $val = $rec->{'entry'}->[ $gEntryMap{'address'} ];
    $topsect .= $val . "\n" if (&isgood($val));
    $boo = 0;
    $val = $rec->{'entry'}->[ $gEntryMap{'city'} ];
    if (&isgood($val))
    {
	$topsect .= $val;
	$boo = 1;
    }
    $val = $rec->{'entry'}->[ $gEntryMap{'state'} ];
    if (&isgood($val))
    {
	$topsect .= ", " if ($boo);
	$boo = 0;
	$topsect .= "$val  ";
    }
    $val = $rec->{'entry'}->[ $gEntryMap{'zip'} ];
    if (&isgood($val))
    {
	$topsect .= ', ' if ($boo);
	$topsect .= $val;
    }
    $topsect .= "\n";
    $boo = 0;
    foreach $i (1..4)
    {
	$val = $rec->{'entry'}->[ $gEntryMap{"custom$i"} ];
	if (&isgood($val))
	{
	    $topsect .= $ai->{'label'}->[$i+13] . ": $val\n";
	    $boo++;
	}
    }
    $topsect .= "\n" if ($boo);

    $val = $rec->{'entry'}->[ $gEntryMap{'note'} ];
    $topsect .= $val . "\n" if (&isgood($val));

    return $topsect;
}

sub readCSV
{
    my ($CSVFILE) = @_;
    my ($max_id, $db) = (-1, { '__RECORDS' => [] , 'NEXT_ID' => 0 });
    my ($rec, $key, $fld, $val);

    $db->{'__APPINFO'} = &readAppInfoFile;
    unless (open(FD, "<$CSVFILE"))
    {
	# Don't do a sync if master data file exists (then we'll end up
	# deleting all records!)
	if (-f "SyncAB/addr.db")
	{
	    PilotMgr::msg(
		"**ERROR: Unable to open $CSVFILE.  Aborting SyncAB!");
	    croak("NODATA");
	}
	return $db;
    }

    while (<FD>)
    {
	$rec = { 'entry' => [],
		 'showPhone' => 0,
		 'phoneLabel' => [0,1,2,3,4] };
	$rec->{'entry'}->[18] = undef;  # ensure right array length

	foreach $key (@gCSVorder)
	{
	    $fld = $gEntryMap{$key};
	    ($val, $_) = &popCSV($_);
	    $val = &CSVToStr($val);
	    $val = undef if ($val eq '');

	    &setRecVal($rec, $fld, $val);
	}

	# Value for "secret" field must be '' or '1'.
	# Convert any perl "false" value to '' and any "true" value to 1:
	#
	$rec->{'secret'} =
	    (defined $rec->{'secret'} and $rec->{'secret'}) ? 1 : '';

	push(@{$db->{'__RECORDS'}}, $rec);
	$db->{ $rec->{'rolo_id'} } = $#{$db->{'__RECORDS'}};

	$max_id = $rec->{'rolo_id'} if ($rec->{'rolo_id'} > $max_id);
    }
    close(FD);
    $db->{'NEXT_ID'} = $max_id+1;
    return $db;
}

sub setRecVal
{
    my ($rec, $fld, $val) = @_;
    if ($fld =~ /^\d+$/)
    {
	$rec->{'entry'}->[$fld] = $val;
    }
    elsif ($fld eq 'phoneLabel')
    {
	$rec->{$fld} = [split(/ /, $val)];
    }
    else
    {
	$rec->{$fld} = $val;
    }
}

sub writeCSV
{
    my ($CSVFILE, $db) = @_;
    my ($rec, $key, $val, @fields);

    &writeAppInfoFile($db->{'__APPINFO'});
    unless (open(FD, ">$CSVFILE"))
    {
	PilotMgr::msg("Unable to write to $CSVFILE.  Help!");
	return;
    }

    foreach $rec (@{$db->{'__RECORDS'}})
    {
	@fields = ();
	foreach $key (@gCSVorder)
	{
	    $val = $gEntryMap{$key};
	    if ($val =~ /^\d+$/)
	    {
		if (defined ($val = $rec->{'entry'}->[$val]))
		{
		    $val = &StrToCSV($val);
		}
	    }
	    else
	    {
		if (defined ($val = $rec->{$val}))
		{
		    $val = join(' ', @$val) if (ref($val) eq 'ARRAY');
		    $val = &StrToCSV($val);
		}
	    }

	    $val = '' unless (defined $val);
	    push(@fields, $val);
	}

	print FD join(',', @fields), "\n";
    }

    close(FD);
}

sub StrToCSV
{
    my ($str) = @_;

    $str =~ s/(\\*)(n|\n)/'\\' x (2*length($1)) . ($2 eq 'n' ? 'n' : '\\n')/ge;
    if ($str =~ /[,"]/)
    {
	$str =~ s/"/""/g;
	$str = '"' . $str . '"';
    }

    return $str;
}

sub popCSV
{
    my ($str) = @_;

    if ($str =~ s/^("([^"]|"")*")(,|$)//)
    {
	return($1, $str);
    }
    elsif ($str =~ s/^(.*?)(,|$)//)
    {
	return($1, $str);
    }

    return($str, '');
}

sub CSVToStr
{
    my ($str) = @_;

    if ($str =~ /^"(.*)"$/)
    {
	$str = $1;
	$str =~ s/""/"/g;
    }
    $str =~ s/((\\\\)*)(\\)?n/'\\' x (length($1)\/2) . ($3 ? "\n" : 'n')/ge;

    return $str;
}

sub writeVCardsOneFile
{
    my ($VCARDFILE, $db) = @_;
    my ($rec);

    &writeAppInfoFile($db->{'__APPINFO'});

    unless (open(FD, ">$VCARDFILE"))
    {
	PilotMgr::msg("Unable to write to $VCARDFILE.  Help!");
	return;
    }

    foreach $rec (@{$db->{'__RECORDS'}})
    {
        if ( $PREFS->{'vCardStyle'} eq "SyncAB" ) {
            &writeVCard($rec, FD);
        } else {
            writePalmVCard($rec, FD, $db );
        }
	print FD "\n" if $PREFS->{'vCardStyle'} eq "SyncAB";
    }

    close(FD);
}

sub writeVCardsMultipleFiles
{
    my ($VCARDDIR, $db) = @_;
    my ($rec, $cat, $fn, @dirlist, $dir, @filelist, $file);

    &writeAppInfoFile($db->{'__APPINFO'});

    # yikes, scary! delete all old files!
    # vCard files are stored in subdirectories named by category.
    # Each SyncAB owned directory has a ".pilotmgr" file in it.
    #
    opendir DIR, "$VCARDDIR";
    @dirlist = readdir DIR;
    closedir DIR;
    foreach $dir (@dirlist)
    {
	next if ($dir =~ /^\.\.?$/);		# skip . and ..
	if (-d "$VCARDDIR/$dir" and -f "$VCARDDIR/$dir/.pilotmgr")
	{
	    opendir DEL, "$VCARDDIR/$dir";
	    @filelist = readdir DEL;
	    closedir DEL;
	    foreach $file (@filelist)
	    {
		if ($file ne '.pilotmgr' and -f "$VCARDDIR/$dir/$file")
		{
		    unlink "$VCARDDIR/$dir/$file";
		}
	    }
	}
    }

    foreach $rec (@{$db->{'__RECORDS'}})
    {
	($cat, $fn) = &vCardFileName($rec, $db->{'__APPINFO'});
	unless (-d "$VCARDDIR/$cat")
	{
	    mkdir "$VCARDDIR/$cat", 0755;
	    open(FD, ">$VCARDDIR/$cat/.pilotmgr") and close(FD);
	}
	if (-f "$VCARDDIR/$cat/$fn")
	{
	    # file already exists
	    $_ = 1;
	    while (-f "$VCARDDIR/$cat/${fn}_$_") { $_++ }
	    $fn .= "_$_";
	}
	unless (open(FD, ">$VCARDDIR/$cat/$fn"))
	{
	    PilotMgr::msg("** Error opening $VCARDDIR/$cat/$fn for write!");
	    next;
	}
    if ( $PREFS->{'vCardStyle'} eq "SyncAB" ) {
        &writeVCard($rec, FD);
    } else {
        writePalmVCard($rec, FD, $db );
    }
	close(FD);
    }
}

sub vCardFileName
{
    my ($rec, $appinfo) = @_;

    my $fn = $rec->{'fullname'};
    $fn = &titleString($rec) unless (&isgood($str));

    # remove newlines, and anything after them.
    $fn =~ s/\n.*//g;
    # remove spaces from beginning and end of line.
    $fn =~ s/^\s*(.*?)\s*$/$1/;
    # replace multiple spaces with a single space.
    $fn =~ s/\s\s+/ /g;
    # replace characters we don't want in filenames.
    $fn =~ tr|'"<>[]/|_______|s;

    my $cat = $appinfo->{'categoryName'}->[ $rec->{$gEntryMap{'category'}} ];
    $cat = 'PilotDB' unless (&isgood($cat));

    $cat =~ s/\n.*//g;
    $cat =~ s/^\s*(.*?)\s*$/$1/;
    $cat =~ s/\s\s+/ /g;
    $cat =~ tr|'"<>[]/|_______|s;

    return ($cat, $fn);
}

sub writeVCard
{
    my ($rec, $FD) = @_;
    my ($val, $val2, $i);

    #XXX: need to handle newlines or semicolons in ADR and N fields!!

    #sdtname requires a ADR type, HOME/WORK.. we'll default to HOME
    my $defaultAddrPlace = 'HOME';

    print $FD "BEGIN:VCARD\n";

    # FN is just for looks, doesn't store actual data:
    &printEncodedString('FN',
	defined($rec->{'fullname'}) ? $rec->{'fullname'} : &titleString($rec),
	$FD);

    ($val = $rec->{'entry'}->[$gEntryMap{'lastname'}]) =~ s/;/\\;/g;
    ($val2 = $rec->{'entry'}->[$gEntryMap{'firstname'}]) =~ s/;/\\;/g;
    if (defined $val || defined $val2)
    {
	#XXX: use &printEncodedString here?
	print $FD 'N:';
	print $FD $val if (defined $val);
	print $FD ';';
	print $FD $val2 if (defined $val2);
	print $FD "\n";
    }

    $val = $rec->{'entry'}->[$gEntryMap{'company'}];
    &printEncodedString('ORG', $val, $FD) if (defined $val);

    $val = $rec->{'entry'}->[$gEntryMap{'title'}];
    &printEncodedString('TITLE', $val, $FD) if (defined $val);

    print $FD 'ADR;';
    $val = $rec->{'addrTypeInfo'};		# vCard info like HOME or WORK
    $val = $defaultAddrPlace unless (defined $val);
    print $FD "$val;X-pilot-field=addr:;;";

    ($val = $rec->{'entry'}->[$gEntryMap{'address'}]) =~ s/;/\\;/g;
    $val =~ s/\n/\\n/g;		#XXX- not right- what to do with newlines?
    print $FD $val if (defined $val);
    print $FD ';';

    ($val = $rec->{'entry'}->[$gEntryMap{'city'}]) =~ s/;/\\;/g;
    print $FD $val if (defined $val);
    print $FD ';';

    ($val = $rec->{'entry'}->[$gEntryMap{'state'}]) =~ s/;/\\;/g;
    print $FD $val if (defined $val);
    print $FD ';';

    ($val = $rec->{'entry'}->[$gEntryMap{'zip'}]) =~ s/;/\\;/g;
    print $FD $val if (defined $val);
    print $FD ';';

    ($val = $rec->{'entry'}->[$gEntryMap{'country'}]) =~ s/;/\\;/g;
    print $FD $val if (defined $val);
    print $FD "\n";

    foreach $i (1..5)
    {
	$val = $rec->{'entry'}->[$gEntryMap{"phone$i"}];
	$val2 = $rec->{'phoneLabel'}->[$i-1];

	# Unless phonetype is equal to default, need to record even empty
	# value, to get phonetype recorded..
	next if (!defined $val and $val2 == ($i-1));
	$val = '' unless (defined $val);

	#XXX: might want to look at prefs and see what types these
	#     *really* are in case they've been changed..
	if ($val2 == 4)
	{
	    print $FD 'EMAIL;INTERNET';
	}
	else
	{
	    print $FD 'TEL;',
		      (@_=grep($_->[1] == $val2, @gPhoneTypes))?$_[0]->[0]:'';
	}

	&printEncodedString(";X-pilot-field=phone$i", $val, $FD);
    }

    foreach $i (1..4)
    {
	$val = $rec->{'entry'}->[$gEntryMap{"custom$i"}];
	next unless (defined $val);

	&printEncodedString("NOTE;X-pilot-field=custom$i", $val, $FD);
    }

    $val = $rec->{'entry'}->[$gEntryMap{'note'}];
    &printEncodedString('NOTE;X-pilot-field=note', $val, $FD)
	if (defined $val);

    print $FD "UID:" . $rec->{id} . "\n";
    print $FD "X-pilot-id:$rec->{rolo_id}\n",
	      "X-pilot-category:$rec->{category}\n",
	      "X-pilot-show-phone:$rec->{showPhone}\n";
    print $FD "X-pilot-private:$rec->{secret}\n"
	if (exists $rec->{'secret'} and length $rec->{'secret'});

    print $FD "END:VCARD\n";
}

# Write a vcard in the same format as a Palm Vx/Palm OS 4 beams it
sub writePalmVCard
{
    my ( $rec, $FD, $db ) = @_;
    my ( $tmp, $lastname, $firstname );

    binmode( $FD ); # no clever stuff, thanks
    print $FD "BEGIN:VCARD\r\n";
    print $FD "VERSION:2.1\r\n"; # mandatory
    print $FD "X-PALM:4.0\r\n"; # should be detectable?

    print $FD "N"; # mandatory

    $lastname = $rec->{'entry'}->[$gEntryMap{'lastname'}];
    $firstname = $rec->{'entry'}->[$gEntryMap{'firstname'}];
    $lastname ||= "";
    $firstname ||= "";

    # none? let's assume it's a resource or place, then.
    if ( !$lastname and !$firstname ) {
        # NB this will cause the company name to appear twice in the
        # record. Which is apparently what the Palm does.
        $lastname = $rec->{'entry'}->[$gEntryMap{'company'}];
    }

    # Still nothing?
    $lastname ||= "\x96Unnamed\x96"; # that's &ndash;

    # encoding tag, if required
    $tmp = csencode( $lastname );
    $tmp ||= csencode( $firstname );
    print $FD $tmp;
    print $FD ":";

    $lastname =~ s/;/\\;/gs;
    $firstname =~ s/;/\\;/gs if $firstname;
    $lastname =~ s/\n/\\\r\n/gs;
    $firstname =~ s/\n/\\\r\n/gs if $firstname;

    print $FD $lastname;
    print $FD ";$firstname" if $firstname;

    print $FD "\r\n";

    # FN: we could determine FN from the Palm settings on how things
    # are listed. If we really wanted to, that is. The Palm doesn't
    # appear to care. On import, the palm tries to use FN in place of
    # a missing N field.

    # ADR: If you put things in a category called Work, the address
    # will be marked as a work address. Anything else seems to mark it
    # as a home address, although further investigation is
    # required. Note, this isn't in the sample addressbook code.
    my $loc = 'HOME';

    if ( $db->{__APPINFO}->{'categoryName'}->[$rec->{$gEntryMap{category}}]
         =~ /^work$/i ) {
        $loc = 'WORK';
    }

    # before printing anything, figure out if there's anything to print
    $tmp = "";
    for my $field ( qw(address city state zip country)) {
        my $f = $rec->{'entry'}->[$gEntryMap{$field}];
        $tmp .= $f if defined( $f );
    }

    if ( length( $tmp )) {
        print $FD "ADR";
        if ( !defined( $rec->{'entry'}->[$gEntryMap{country}]) or
             !($rec->{'entry'}->[$gEntryMap{country}])) {
            print $FD ";DOM";
        }
        print $FD ";$loc";
        print $FD "" . csencode( $tmp );
        print $FD ":;;";

        # fixme: merge this with loop above
        for my $field ( qw(address city state zip country)) {
            $tmp = $rec->{'entry'}->[$gEntryMap{$field}];
            if ( defined( $tmp )) {
                $tmp =~ s/;/\\;/gs;
                $tmp =~ s/\n/\\\r\n/gs;
                print $FD $tmp;
            }
            if ( $field ne "country" ) {
                print $FD ";";
            }
        }
        print $FD "\r\n";
    }

    # ORG:
    $tmp = $rec->{'entry'}->[$gEntryMap{'company'}];
    if ( defined( $tmp )) {
        print $FD "ORG";
        print $FD qpencode( $tmp );
        print $FD "\r\n";
    }

    # TITLE:
    $tmp = $rec->{'entry'}->[$gEntryMap{'title'}];
    if ( defined( $tmp )) {
        print $FD "TITLE";
        print $FD qpencode( $tmp );
        print $FD "\r\n";
    }

    # NOTE:
    $tmp = $rec->{entry}->[$gEntryMap{"note"}];
    if ( defined( $tmp )) {
        print $FD "NOTE";
        print $FD qpencode( $tmp, 1 );
        print $FD "\r\n";
    }

    # TEL:
    # in theory, these mappings can change. in practice, I'm not sure
    # the Palm code cares, so I probably shouldn't.

    # see if we should use HOME/WORK tags
    my ( $homeOnly, $workOnly ) = ( 0, 0 );
    for my $phone ( 1..5 ) {
        $tmp = $rec->{entry}->[$gEntryMap{"phone$phone"}];
        next unless defined( $tmp );
        my $ptype = (@_ = grep( $_->[1] == $rec->{phoneLabel}->[$phone - 1],
                                @gPhoneTypes ))?$_[0]->[0]:'';
        if ( $ptype eq "HOME" ) {
            if ( $workOnly ) {
                $workOnly = 0;
            } else {
                $homeOnly = 1;
            }
        } elsif ( $ptype eq "WORK" ) {
            if ( $homeOnly ) {
                $homeOnly = 0;
            } else {
                $workOnly = 1;
            }
        }
    }

    # now dump out the phone fields
    for my $phone ( 1..5 ) {
        $tmp = $rec->{entry}->[$gEntryMap{"phone$phone"}];
        next unless defined( $tmp );
        my $ptype = (@_ = grep( $_->[1] == $rec->{phoneLabel}->[$phone - 1],
                                @gPhoneTypes ))?$_[0]->[0]:'';
        if ( $ptype ne "INTERNET" ) {
                print $FD "TEL";
                if ( $rec->{showPhone} == $phone -1 ) {
                    print $FD ";PREF";
                }

                if ( $ptype ne "" ) { # other
                    if ( $homeOnly or $ptype eq "HOME" ) {
                        print $FD ";HOME";
                    } elsif ( $workOnly or $ptype eq "WORK" ) {
                        print $FD ";WORK";
                    }
                }

                if ( $ptype =~ /^(WORK|HOME|PREF|)$/ ) {
                    if ( $ptype eq "PREF" ) {
                        print $FD ";" . $gVCardOpts{pref};
                    }
                    print $FD ";VOICE";
                } else {
                    print $FD ";$ptype";
                }

                # now the data
                print $FD qpencode( $tmp );
                print $FD "\r\n";
            } else {
                # email. this is a bit redundant, but hey.
                print $FD "EMAIL";

                if ( $rec->{showPhone} == $phone -1 ) {
                    print $FD ";PREF";
                }

                if ( $homeOnly ) {
                    print $FD ";HOME";
                } elsif ( $workOnly ) {
                    print $FD ";WORK";
                }

                if ( $tmp !~ /@/ ) {
                    if ( $tmp =~ /^\d/ ) {
                        if ( $tmp =~ /,/ ) {
                            print $FD ";CIS";
                        } elsif ( substr( $tmp, 3, 1 ) eq "-" ) {
                            print $FD ";MCI";
                        }
                    }
                } else {
                    print $FD ";INTERNET";
                }

                print $FD qpencode( $tmp );
                print $FD "\r\n";
            } # email check
    } # phoneloop

    # Other stuff
    for my $extra ( 1..4 ) {
        # data is X-PALM-CUSTOM;$extra;$name:DATA
        $tmp = $rec->{entry}->[$gEntryMap{"custom$extra"}];
        if ( defined( $tmp )) {
            print $FD "X-PALM-CUSTOM;$extra";

            my $tag = $db->{'__APPINFO'}->{label}->[$gEntryMap{"custom$extra"}];
            if ( defined( $tag )) {
                # removed, not escaped (per palm code). no \n handling.
                $tag =~ s/[;:]//gs;
                print $FD ";$tag" if $tag;
            }

            print $FD qpencode( $tmp );
            print $FD "\r\n";
        }
    }

    print $FD "UID:" . $rec->{id} . "\r\n";

    # outputting category is conditionally defined in the palm
    # code. If we leave it out of the file, however, we lose out when
    # we resync later.
    # possible fixes:
    # - in file-per-vcard mode, rely on the directory name
    # - in single-file mode, include the X-PALM-CATEGORY field
    print $FD "X-PALM-CATEGORY:";
    $tmp = $db->{__APPINFO}->{'categoryName'}->[$rec->{$gEntryMap{category}}];
    # again, stripped, not escaped
    $tmp =~ s/[;:]//gs;
    print $FD "$tmp\r\n";

    # End!
    print $FD "END:VCARD\r\n";
}

# determine a charset for the specified string
sub csencode
{
    my $string = shift;
    $string = "" unless $string;

    # make sure that semis are escaped (fixme colons as well?)
    $string =~ s/;/\\;/gs;

    # fixme: check if it's exactly ascii (0x00 - 0x7f)
    # fixme: check what the behaviour for strict vcard compliance is
    if ( $string =~ /[\x80-\x9f]/) {
        return ";CHARSET=Windows-1252";
    } elsif ( $string =~ /[\xa0-\xff]/ ) {
        return ";CHARSET=ISO-8859-1";
    } else {
        return "";
    }
}

sub qpencode
{
    my $string = shift;
    my $force = shift; # if this is set, then put in a QP header regardless
    $string = "" unless $string;
    my $encoded = "";

    # charset tag
    $encoded = csencode( $string );

    # next, qp-encoding tag if required
    if ( $string =~ /[\x00-\x1f\x7f-\xff]/ ) {
        $encoded .= ";ENCODING=QUOTED-PRINTABLE:=\n";
        # MIME::QuotedPrint doesn't handle \n's as we'd like, alas.
        while ( $string =~ /\n/s ) {
            my $bit;
            ( $bit, $string ) = $string =~ m/^(.*?)\n(.*)$/s;

            $encoded .= encode_qp( $bit );

            # fixme: QP rule #5 (lines must be shorter than 76 chars,
            # but we are not allowed to break =XX escapes.
            # fixme: check that this is indeed correct (i.e. send a
            # bare newline to the pilot and see what it shows up as.
            $encoded .= "=0D=0A=";

            $encoded .= "\n"; # will get fixed below
        }
        $encoded .= encode_qp( $string ) if $string;
        $encoded =~ s/\n/\r\n/sg; # MIME:QP, grr.
    } else {
        if ( $force ) {
            $encoded .= ";ENCODING=QUOTED-PRINTABLE:=\n";
        } else {
            $encoded .= ":";
        }
        $encoded .= $string;
    }

    $encoded;
}

sub printEncodedString
{
    # print string value to vcard. use Quoted-Printable if necessary
    # XXX: this needs to be more complete to encode all control chars,etc too
    #
    my ($hdr, $val, $fd) = @_;

    print $fd $hdr if ($hdr);
    if ($val =~ /\n/)
    {
	$val =~ s/=/=3D/g;
	$val =~ s/\n/=0A/g;
	print $fd ";ENCODING=QUOTED-PRINTABLE";
    }
    print $fd ":$val\n";
}

sub readVCardsOneFile
{
    my ($VCARDFILE) = @_;
    my ($max_id, $db, $rec, $i) = (-1, { '__RECORDS' => [], 'NEXT_ID' => 0 });

    $db->{'__APPINFO'} = &readAppInfoFile;
    unless (open(FD, "<$VCARDFILE"))
    {
	# Don't do a sync if master data file exists (then we'll end up
	# deleting all records!)
	if (-f "SyncAB/addr.db")
	{
	    PilotMgr::msg(
		"**ERROR: Unable to open $VCARDFILE.  Aborting SyncAB!");
	    croak("NODATA");
	}
	return $db;
    }

    while (<FD>)
    {
	if ( /^\s*BEGIN\s*:\s*VCARD\s*$/ )
	{
	    $rec = &readVCard(FD,$db);
	    push(@{$db->{'__RECORDS'}}, $rec);

	    if (defined $rec->{'rolo_id'})
	    {
		$db->{ $rec->{'rolo_id'} } = $#{$db->{'__RECORDS'}};
		$max_id = $rec->{'rolo_id'} if ($rec->{'rolo_id'} > $max_id);
	    }
	}
    }
    close(FD);
    $db->{'NEXT_ID'} = $max_id+1;

    foreach $i ($[..$#{$db->{'__RECORDS'}})
    {
	$rec = $db->{'__RECORDS'}->[$i];
	unless (defined $rec->{'rolo_id'})
	{
	    $rec->{'rolo_id'} = $db->{'NEXT_ID'}++;
	    $db->{ $rec->{'rolo_id'} } = $i;
	}
    }

    return $db;
}

sub readVCardsMultipleFiles
{
    my ($VCARDDIR) = @_;
    my ($max_id, $db, $rec, @dirlist, $dir, @filelist, $file, $cat) =
	(-1, { '__RECORDS' => [], 'NEXT_ID' => 0 });

    $db->{'__APPINFO'} = &readAppInfoFile;

    # make one attempt to create the directory
    -d "$VCARDDIR" or mkdir "$VCARDDIR", 0755;

    # vCard files are stored in subdirectories named by category.
    # Each SyncAB owned directory has a ".pilotmgr" file in it.
    unless (opendir DIR, "$VCARDDIR")
    {
	PilotMgr::msg(
	    "**ERROR: Unable to open dir $VCARDDIR.  Aborting SyncAB!");
	croak("BADDIR");
    }
    @dirlist = readdir DIR;
    closedir DIR;
    foreach $dir (@dirlist)
    {
	next if ($dir =~ /^\.\.?$/);		# skip . and ..
	if (-d "$VCARDDIR/$dir" and -f "$VCARDDIR/$dir/.pilotmgr")
	{
	    opendir DAT, "$VCARDDIR/$dir";
	    @filelist = readdir DAT;
	    closedir DAT;
	    foreach $file (@filelist)
	    {
		if ($file ne '.pilotmgr' and -f "$VCARDDIR/$dir/$file")
		{
		    unless (open(FD, "<$VCARDDIR/$dir/$file"))
		    {
			PilotMgr::msg("** Unable to read $VCARDDIR/$dir/$file");
			next;
		    }
		    do { $_ = <FD> }
			until (/^\s*BEGIN\s*:\s*VCARD\s*$/i or eof(FD));
		    close(FD), next if (eof(FD));
		    $rec = &readVCard(FD,$db);
		    close(FD);
		    push(@{$db->{'__RECORDS'}}, $rec);

		    if (defined $rec->{'rolo_id'})
		    {
			$db->{ $rec->{'rolo_id'} } = $#{$db->{'__RECORDS'}};
			$max_id = $rec->{'rolo_id'}
			    if ($rec->{'rolo_id'} > $max_id);
		    }
		}
	    }
	}
    }
    $db->{'NEXT_ID'} = $max_id+1;

    foreach $i ($[..$#{$db->{'__RECORDS'}})
    {
	$rec = $db->{'__RECORDS'}->[$i];
	unless (defined $rec->{'rolo_id'})
	{
	    $rec->{'rolo_id'} = $db->{'NEXT_ID'}++;
	    $db->{ $rec->{'rolo_id'} } = $i;
	}
    }

    return $db;
}

sub readVCard
{
    my ($FD,$db) = @_;
    my $encodeMatch = '(^|;)\s*ENCODING\s*=\s*QUOTED-PRINTABLE\s*(;|$)';
    my $pilotMatch = '(^|;)\s*X-pilot-field\s*=\s*(\S+?)\s*(;|$)';
    my $charsetMatch = '(^|;)\s*CHARSET=(ISO-8859-1|WINDOWS-1252)\s*(;|$)';
    my %fieldMap = ('FN'	=> 'fullname',
		    'ORG'	=> 'company',
		    'TITLE'	=> 'title',
		    'id'	=> 'rolo_id',
		    'category'  => 'category',
		    'show-phone'=> 'whichphone',
		    'private'   => 'private');

    my ($rec, $field, $extra, $item);
    $rec = { 'entry' => [],
	     'showPhone' => 0,
	     'phoneLabel' => [0,1,2,3,4],
	     'secret' => '' };
    $rec->{'entry'}->[18] = undef;  # ensure right array length
    my $phone = 0; # index for keeping track of how many we've read

    while (<$FD>)
    {
	s/\015?\n$//;
	last if ( /^\s*END\s*:\s*VCARD\s*$/ );

	if ( /^\s*(FN|ORG|TITLE)\s*(;[^:]*)?:(.*)$/i )
	{
	    ($field = $1) =~ tr/a-z/A-Z/;
	    $extra = $2;
	    $val = $3;
        $extra = "" if !defined( $extra );
        $extra =~ s/$charsetMatch//i; # don't really care
	    $val = &decodeQuotedPrintable($val, $FD)
		if ($extra =~ /$encodeMatch/i);

	    &setRecVal($rec, $gEntryMap{$fieldMap{$field}}, $val) if $val;
	}
	elsif ( /^\s*N\s*(;[^:]*)?:(.*)$/i )
	{
	    $extra = $1;
	    $val = $2;

        # catch embedded newlines in the name, not that they should be
        # there in the first place... this is ugly, and I'd much
        # rather have a smarter chunk of reading code, but this will
        # work for now.
        # this block is for SyncAB-style records
        my $fn = $rec->{fullname};
        if ( defined( $fn )) {
            while ( $fn =~ /\n/ ) {
                $fn =~ s/\n//;
                $val .= "\n";
                my $nl = <$FD>;
                last if !defined( $nl );
                $nl =~ s/\r?\n//;
                $val .= $nl;
            }
        }

        # and this is for PalmOS-style records, which put a trailing \
        # to indicate a continuation.
        while ( $val =~ /\\$/ ) {
            $val = substr( $val, 0, -1 ) . "\n";
            my $nl = <$FD>;
            last if !defined( $nl );
            $nl =~ s/\r?\n//;
            $val .= $nl;
        }

	    &popFields($rec, $val, 'lastname', 'firstname');
	    #XXX: do anything with remaining fields? (ie suffix, etc)
	}
	elsif ( /^\s*ADR\s*(;[^:]*)?:(.*)$/i )
	{
	    $extra = $1;
	    $val = $2;

        # Read in PalmOS vCard embedded newlines
        while ( $val =~ /\\$/ ) {
            $val = substr( $val, 0, -1 ) . "\n";
            my $nl = <$FD>;
            last if !defined( $nl );
            $nl =~ s/\r?\n//;
            $val .= $nl;
        }

        # old behaviour
        if ($extra =~ /$pilotMatch/i and ($field=$2) =~ /^addr$/i)
          {
              &popFields($rec, $val, 'SKIP', 'SKIP',  #XXX use first values?
                         'address', 'city', 'state', 'zip', 'country');

          }
        else
          {
            # we can only snarf one address. PalmOS appears to parse
            # all and only keep the last.
            &popFields( $rec, $val, "po", "extaddr", "address", "city",
                        "state", "zip", "country" );

            # per the palm code. these are indeed the wrong way around
            if ( defined( $rec->{po})) {
                $rec->{address} = "" if !defined( $rec->{address});
                $rec->{address} = $rec->{po} . "\n" . $rec->{address};
                delete $rec->{po};
            }
            if ( defined( $rec->{extaddr})) {
                $rec->{address} = "" if !defined( $rec->{address});
                $rec->{address} = $rec->{extaddr} . "\n" . $rec->{address};
                delete $rec->{extaddr};
            }
        }
	}
	elsif ( /^\s*(TEL|EMAIL|NOTE)\s*(;[^:]*)?:(.*)$/i )
	{
        my $tag = $1;
	    $extra = $2;
	    $val = $3;
        $extra =~ s/$charsetMatch//;
	    $val = &decodeQuotedPrintable($val, $FD)
		if ($extra =~ /$encodeMatch/i);

	    unless ($extra =~ /$pilotMatch/i)
	    {
		# Not a pilot entry
		#XXX: save this somewhere so it won't be lost,
		#     or maybe assign to a pilot entry...

            # check for PalmOS 4-formatted vcard stuff
            # we'll have already handled QP-decoding, apparently
            if ( $tag =~ /(TEL|EMAIL)/ ) {
                if ( $phone > 4 ) {
                    PilotMgr::msg( "**WARNING: all phone slots full, skipping" );
                }

                # should probably check if we'v already got one of these
                if ( $extra =~ s/(;|^)PREF(;|$)/;/ ) {
                    $rec->{showPhone} = $phone;
                }

                # figure out what kind of thing it is
                if ( $tag eq "EMAIL" ) {
                    # 3 == OTHER. Not happy.
                    my $ptype = (@_ = grep( $_->[0] eq "INTERNET",
                                            @gPhoneTypes ))?$_[0]->[1]:3;

                    $rec->{phoneLabel}->[$phone] = $ptype;
                } else {
                    # patch extra into a shape that we can recognise
                    $extra =~ s/VOICE//;
                    $extra =~ s/X-PALM-MAIN/PREF/;
                    $extra =~ s/(HOME|WORK);(.+)/$2/g;
                    $extra =~ s/;//g;
                    $extra =~ s/CAR/CELL/g; # palm compat

                    # 3 == OTHER. Not happy.
                    my $ptype = (@_ = grep( $_->[0] eq $extra,
                                            @gPhoneTypes ))?$_[0]->[1]:3;
                    $rec->{phoneLabel}->[$phone] = $ptype;
                }
                $phone++;
                # 1-based, so goes after the increment
                setRecVal($rec, $gEntryMap{"phone$phone"}, $val);
            } else {
                # note
                &setRecVal($rec,$gEntryMap{'note'}, $val )
                  if ( length( $val ));
            }

		next;
	    }
	    ($field = $2) =~ tr/A-Z/a-z/;

	    &setRecVal($rec, $gEntryMap{$field}, $val) if (length $val);

	    if ($field =~ /^phone(\d)$/)
	    {
		$val = $1;
		@_ = grep($extra =~ /(^|;)\s*$_->[0]\s*(;|$)/i, @gPhoneTypes);
		$rec->{'phoneLabel'}->[$val-1] = @_ ? $_[0]->[1] : 3;
						  # default val == 3 == OTHER
	    }
	}
	elsif ( /^\s*X-pilot-(.*)\s*(;[^:]*)?:(.*)$/i )
	{
	    $field = $fieldMap{$1};
	    next unless (defined $field);
	    $val = $3;
	    # Value for private must be 1 or ''
	    $val = $val ? 1 : ''  if ($field eq 'private');

	    $rec->{$gEntryMap{$field}} = $val;
	}
    elsif ( /UID:(\d+)$/i )
    {
        $rec->{id} = $1;

        # now pull the rolo_id out of the appinfo database, if
        # possible.  this is needlessly horrible due to the
        # use of rolo_id as the IdField
        my $master_db = PilotSync::readMaster( "SyncAB/addr.db" );

        # $master_db will always be a hash, albeit an empty one if the
        # master file doesn't exist.
        for my $r ( keys %{$master_db} ) {
            if ( $r =~ /^rolo_id_(\d+)$/) {
                if ( $master_db->{$r} == $rec->{id}) {
                    $rec->{rolo_id} = $1;
                    last;
                }
            }
        }
    }
    elsif ( /^X-PALM-CATEGORY:(.*)$/ )
    {
        # NB category is written destructively, so this may cause a mismatch
        # on resync. Also, it's never encoded (no charset, no qp, no escaping)
        # fixes:
        # - go through category list and find the closest match
        # - check the old record's category
        my $cat = $1;
        my @categories = @{$db->{'__APPINFO'}->{'categoryName'}};

        for my $c ( 0..$#categories ) {
            if ( $categories[$c] eq $cat ) {
                $rec->{$gEntryMap{category}} = $c;
                $cat = $c;
                last;
            }
        }

        # fixme: no match for category: try and create the category.
        if ( $cat !~ /^d+$/) {
            PilotMgr::msg( "Cannot find a match for $cat\n" );
        }
    }
    elsif ( /^X-PALM-CUSTOM([^:]*):(.*)$/ )
    {
        $extra = $1;
        $val = $2;

	    $val = &decodeQuotedPrintable($val, $FD)
		if ($extra =~ /$encodeMatch/i);

        # figure out which custom field it is
        if ( $extra =~ m/^;(\d);(.*$)/ ) {
            $extra = $1; # just the number
            my $rest = $2;
            if ( $rest =~ s/$encodeMatch// ) {
                # if this is QP data, then check for more
                while ( $val =~ /=$/ ) {
                    $val = substr( $val, 0, -1 );
                    my $nl = <$FD>;
                    last if !defined( $nl );
                    $nl =~ s/\r?\n//;
                    $val .= $nl;
                }

                $val = decode_qp( $val );
            }
            # fixme: we could do some smart matching based on $2 here
            $rec->{entry}->[$gEntryMap{"custom$extra"}] = $val;
        } else {
            # xxx disregard
            print "Can't handle $extra as there's no leading number\n";
        }
    }
    elsif ( /^(X-PALM|VERSION):/ )
    {
        # ok to skip for now.
    }
	else
	{
	    #XXX: save data somewhere so it won't be lost
        print STDERR "WARNING: Skipping line $_\n";
	}
    }

    if ( defined( $rec->{entry}->[$gEntryMap{company}]) and
         defined( $rec->{entry}->[$gEntryMap{lastname}] )) {
        if ( $rec->{entry}->[$gEntryMap{company}] eq
             $rec->{entry}->[$gEntryMap{lastname}]) {
            $rec->{entry}->[$gEntryMap{lastname}] = undef;
        }
    }

    return $rec;
}

sub popFields
{
    my ($rec, $val, @fields) = @_;
    my ($field, $item);

    foreach $field (@fields)
    {
	($item = $1) =~ s/\\;/;/g  if ($val =~ s/^(.*?(^|[^\\]))(;|$)//s);

	next if ($field eq 'SKIP');
	$item = undef unless (length $item);	#XXX I think I want this
    if ( defined( $item )) {
        $item =~ s/\\n/\n/g;
    }
    if ( defined( $gEntryMap{$field})) {
        &setRecVal($rec, $gEntryMap{$field}, $item);
    } else {
        &setRecVal($rec, $field, $item) if defined( $item );
    }
    }
}

sub decodeQuotedPrintable
{
    my ($val, $FD) = @_;

    while ($val =~ s/=$//)
    {
	$val .= <$FD>;

    # Palm craziness (quite possibly correct, mind you)
    $val =~ s/=0D=0A=\r?\n/\n=\r\n/gs;

	$val =~ s/\015?\n$//;
    }

    $val = decode_qp( $val );

    return $val;
}

1;