[Thread Prev][Thread Next][Thread Index]
[PilotMgr] Version of SyncAB with support for Sync'ing BBDB
- To: pilotmgr@xxxxxxxxxxxxxxxxx
- Subject: [PilotMgr] Version of SyncAB with support for Sync'ing BBDB
- From: Dinesh Dutt <ddutt@xxxxxxxxx>
- Date: Sun, 30 Jan 2000 20:29:34 -0800 (PST)
- Comments: Hyperbole mail buttons accepted, v04.18.
- Sender: owner-pilotmgr@xxxxxxxxxxxxxxxxxxxx
Folks,
I am enclosing a modified copy of SyncAB.pm which includes support for BBDB. It
sync data both ways and updates the BBDB with the records from the AB on
Palm. I've tried it with a few things and it looks fine, but I'd love to hear
from you folks about any problems, suggestions for improvements etc. Please
remember to back up both the BBDB and Palm AB before trying out this stuff.
One potential improvement is to store the actual category name instead of the
category id in the BBDB field. I'm working on a fix for this. I also have to
write code to update the AppInfo with any new Categories created in BBDB that
maybe missing from the Palm.
Supported BBDB file versions are 2 and 3.
For safety's sake, I've called BBDB's file as ".bbdb.sync". You can rename
configure it to use ".bbdb", if you wish.
Enjoy,
Dinesh
P.S: SyncAB version 0.96p1 was used as the base version to modify.
--
package SyncAB;
# Address Book conduit for PilotManager
# 3/17/98,1/8/99 Alan.Harder@xxxxxxx
# http://www.moshpit.org/pilotmgr
# Some assistance with vCard testing and
# coding from Steve.Swales@xxxxxxx
#
# BBDB support added by Dinesh G Dutt (ddutt@xxxxxxxxx). Code for parsing
# BBDB borrowed from Seth Golub's BBDB parser (seth@xxxxxxxxxxxx).
#
use PilotSync;
use Tk;
use TkUtils;
use Data::Dumper;
use Carp;
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)
);
my $PhoneInvLabels = {
'work' => 0,
'home' => 1,
'fax' => 2,
'other' => 3,
'email' => 4,
'main' => 5,
'pager' => 6,
'mobile' => 7
};
my @PhoneLabels = ("work", "home", "fax", "other", "email", "main", "pager", "mobile");
my @userFields = ("custom1", "custom2", "custom3", "custom4", "category", "recordId", "showPhone",
"work", "home", "fax", "other", "main", "pager", "mobile");
my $BbdbFileVersion = 3;
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->{'BbdbFile'} = "$ENV{HOME}/.bbdb.sync"
unless (defined $PREFS->{'BbdbFile'});
}
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@xxxxxxx' };
}
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', 'BBDB');
$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'});
});
$objs[0]->configure(-command => sub{
$gFileLabel = 'BBDB:';
$gFileEntry->configure(-textvariable => \$PREFS->{'BbdbFile'});
});
$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'});
}
elsif ($PREFS->{'syncType'} eq 'BBDB') {
$gFileLabel = 'BBDB:';
$gFileEntry->configure(-textvariable => \$PREFS->{'BbdbFile'});
}
$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";
}
$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;
}
elsif ($PREFS->{'syncType'} eq 'BBDB')
{
$file = $PREFS->{'BbdbFile'};
$reader = \&readBbdb;
$writer = \&writeBbdb;
}
else
{
PilotMgr::msg(
"SyncAB does not yet support type $PREFS->{'syncType'}\n");
return;
}
$CANCEL = 0;
PilotSync::doSync( $dlp,
&conduitInfo->{'database'},
['entry', 'phoneLabel', 'showPhone',
'category', 'secret'],
['categoryName', 'phoneLabel', 'label'],
$idField,
"SyncAB/addr.db",
$file,
\&titleString,
$reader,
$writer,
\&newRoloId,
undef, undef, \$CANCEL);
$PREFS->{'lastSyncType'} = $PREFS->{'syncType'} 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'}})
{
&writeVCard($rec, FD);
print FD "\n";
}
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;
}
&writeVCard($rec, FD);
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 "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";
}
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);
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;
# 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);
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) = @_;
my $encodeMatch = '(^|;)\s*ENCODING\s*=\s*QUOTED-PRINTABLE\s*(;|$)';
my $pilotMatch = '(^|;)\s*X-pilot-field\s*=\s*(\S+?)\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
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;
$val = &decodeQuotedPrintable($val, $FD)
if ($extra =~ /$encodeMatch/i);
&setRecVal($rec, $gEntryMap{$fieldMap{$field}}, $val);
}
elsif ( /^\s*N\s*(;[^:]*)?:(.*)$/i )
{
$extra = $1;
$val = $2;
&popFields($rec, $val, 'lastname', 'firstname');
#XXX: do anything with remaining fields? (ie suffix, etc)
}
elsif ( /^\s*ADR\s*(;[^:]*)?:(.*)$/i )
{
$extra = $1;
$val = $2;
unless ($extra =~ /$pilotMatch/i and ($field=$2) =~ /^addr$/i)
{
# Not the ADR entry for pilot
#XXX: save this somewhere so it won't be lost,
# or maybe select it for pilot data if there is none
next;
}
&popFields($rec, $val, 'SKIP', 'SKIP', #XXX use first values?
'address', 'city', 'state', 'zip', 'country');
}
elsif ( /^\s*(TEL|EMAIL|NOTE)\s*(;[^:]*)?:(.*)$/i )
{
$extra = $2;
$val = $3;
$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...
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;
}
else
{
#XXX: save data somewhere so it won't be lost
}
}
return $rec;
}
sub popFields
{
my ($rec, $val, @fields) = @_;
my ($field, $item);
foreach $field (@fields)
{
($item = $1) =~ s/\\;/;/g if ($val =~ s/^(.*?(^|[^\\]))(;|$)//);
next if ($field eq 'SKIP');
$item = undef unless (length $item); #XXX I think I want this
&setRecVal($rec, $gEntryMap{$field}, $item);
}
}
sub decodeQuotedPrintable
{
my ($val, $FD) = @_;
while ($val =~ s/=$//)
{
$val .= <$FD>;
$val =~ s/\015?\n$//;
}
#XXX: should decode all =## things
$val =~ s/=0[Aa]/\n/g;
$val =~ s/=3[Dd]/=/g;
return $val;
}
sub readBbdb {
my ($BBDBFile) = @_;
my ($max_id, $db, $rec, $i) = (-1, { '__RECORDS' => [], 'NEXT_ID' => 0 });
my ($deleted, $archived, @bbdb, $local_id, $i, $recId, $showPhone);
my (@phones, @phoneLabel, $k);
$db->{'__APPINFO'} = &readAppInfoFile;
unless (open(FD, "<$BBDBFile")) {
# 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 $BBDBFile. Aborting SyncAB!");
croak("NODATA");
}
return $db;
}
while (<FD>) {
last if !/^;;; /;
last if /^;;; user-fields: \(.*\)/;
if (/^;;; file-version: (.*)$/) {
if (($1 ne "2") && ($1 ne "3")) {
print "ERROR: Can currently only work with version 2 & 3 files\n";
close FD;
PilotMgr::msg("**ERROR: Unsupported Version of BBDB $1. Aborting SyncAB!");
croak("NODATA");
}
else {
$BbdbFileVersion = $1;
}
}
}
@bbdb = <FD>; # Read in the rest of the database
@bbdb = grep(!/^;/, @bbdb); # Filter out the comments now;
$local_id = 1;
for ($i=0; $i <= $#bbdb; $i++) {
$rec = &readBbdbRec ($bbdb[$i], @userFields);
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 readBbdbRec {
my ($bbdbRec, @userFields) = @_;
my ($phoneNo, $ext, $customField, $category, $field);
my (@entry, $alias, $org, $phone, $address, $email, $notes);
my ($street, $city, $zipcode, $state, $country, $rec);
my ($emailSet, $emailField, $k, $phField);
$rec = { 'entry' => [],
'showPhone' => 0,
'phoneLabel' => [0,1,2,3,4],
'secret' => '' };
$rec->{'entry'}->[19] = undef; # ensure right array length
$phField = 3;
($rec->{'entry'}->[1], $rec->{'entry'}->[0], $alias, $rec->{'entry'}->[2], $phone, $address, $email, $notes, undef)
= &GetFields($bbdbRec);
$rec->{'entry'}->[0] =~ s/\"//g;
$rec->{'entry'}->[1] =~ s/\["*(.*)"*/$1/g;
$rec->{'entry'}->[1] =~ s/\"//g;
$rec->{'entry'}->[0] = "" if ($rec->{'entry'}->[0] eq "nil");
$rec->{'entry'}->[1] = "" if ($rec->{'entry'}->[1] eq "nil");
$rec->{'entry'}->[2] = "" if ($rec->{'entry'}->[2] eq "nil");
# Replace the quotes with ", " if there are multiple email addresses
if ($email eq "nil") {
$email = "";
}
else {
$email =~ s/\"//g;
$email =~ s/ /, /g;
$email =~ s/, $//;
}
# Extract telephone number in xxx-xxx-xxxxX<extension> format
if ($phone ne "nil") {
($phoneNo, $ext) = &GetNumberFromPhoneFieldBbdb ($phone);
if (!defined ($phoneNo)) {
$rec->{'entry'}->[3] = $phone;
}
else {
$rec->{'entry'}->[$phField] = $phoneNo;
$rec->{'phoneLabel'}->[$phField-3] = $PhoneInvLabels->{work};
if (defined ($ext) && ($ext != 0)) {
$rec->{'entry'}->[$phField] = $phoneNo."-".$ext;
}
}
$phField++;
}
else {
$rec->{'entry'}->[$phField] = "";
}
# BBDB's address stores everything from street address to zipcode in
# one string. Split it up for merging with Palm Pilot's format
if ($address ne "nil") {
($rec->{'entry'}->[8], $rec->{'entry'}->[9], $rec->{'entry'}->[10], $rec->{'entry'}->[11]) =
GetAddressFieldsBbdb ($address);
$rec->{'entry'}->[8] = "" if (!defined ($rec->{'entry'}->[8]));
$rec->{'entry'}->[9] = "" if (!defined ($rec->{'entry'}->[9]));
$rec->{'entry'}->[10] = "" if (!defined ($rec->{'entry'}->[10]));
$rec->{'entry'}->[11] = "" if (!defined ($rec->{'entry'}->[11]));
# Strip the quotes from the zipcode field
$rec->{'entry'}->[11] =~ s/"//g;
# Strip the leading & trailing "["
$address =~ s/^\[//;
$address =~ s/\]$//;
}
else {
$rec->{'entry'}->[8] = $rec->{'entry'}->[9] = $rec->{'entry'}->[10] = $rec->{'entry'}->[11] = "";
}
# The Notes field can consist of not just not notes, but also names
# and values for user-defined fields. Extract these.
if ($notes ne "nil") {
$userNotes = &GetNotesBbdb ($notes);
$userNotes = "nil" if (!defined ($userNotes));
# Extract user-configured fields
if ($notes =~ m/^\(/) {
foreach $userFieldKey (@userFields) {
$customField = &GetCustomFieldBbdb ($notes, $userFieldKey);
next if (!defined ($customField));
if ($userFieldKey eq "category") {
$category = $customField;
}
elsif ((($userFieldKey eq "home") ||
($userFieldKey eq "fax") ||
($userFieldKey eq "pager") ||
($userFieldKey eq "main") ||
($userFieldKey eq "other") ||
($userFieldKey eq "mobile")) &&
(defined ($customField))) {
($phoneNo, $ext) =
&GetNumberFromPhoneFieldBbdb ($customField);
if (!defined ($phoneNo)) {
$rec->{'entry'}->[$phField] = $customField;
$rec->{'entry'}->[$phField] =~ s/"//g;
}
else {
$rec->{'entry'}->[$phField] = $phoneNo;
if (defined ($ext) && ($ext != 0)) {
$rec->{'entry'}->[$phField] = $phoneNo."x".$ext;
}
}
$rec->{'phoneLabel'}->[$phField-3] = $PhoneInvLabels->{$userFieldKey};
$phField++;
}
elsif (($userFieldKey eq "showphone") &&
(defined ($customField))) {
$rec->{'showPhone'} = $customField;
$showphone = $customField;
}
elsif (($userFieldKey eq "custom1") &&
(defined ($customField))) {
$rec->{'entry'}->[14] = $customField;
}
elsif (($userFieldKey eq "custom2") &&
(defined ($customField))) {
$rec->{'entry'}->[15] = $customField;
}
elsif (($userFieldKey eq "custom3") &&
(defined ($customField))) {
$rec->{'entry'}->[16] = $customField;
}
elsif (($userFieldKey eq "custom4") &&
(defined ($customField))) {
$rec->{'entry'}->[17] = $customField;
}
elsif (($userFieldKey eq "attributes") &&
(defined ($customField))) {
}
}
if (!defined ($userNotes)) {
$rec->{'entry'}->[18] = "";
}
else {
$rec->{'entry'}->[18] = $customField;
}
}
}
else {
$userNotes = "nil";
$category = $DefaultCategory;
}
if ($showphone == $ShowPhoneUndef) {
$showphone = $PhoneInvLabels->{email};
$rec->{'showphone'} = $PhoneInvLabels->{email};
}
# Determine where the email field needs to go
if ($phField < 8) {
$rec->{'entry'}->[$phField] = $email;
$rec->{'phoneLabel'}->[$phField-3] = $PhoneInvLabels->{email};
}
return $rec;
}
sub writeBbdb {
my ($BbdbFile, $db) = @_;
my ($rec, $field);
&writeAppInfoFile($db->{'__APPINFO'});
unless (open(FD, ">$BbdbFile"))
{
PilotMgr::msg("Unable to write to $BbdbFile. Help!");
return;
}
print FD ";;; file-version: $BbdbFileVersion\n";
print FD ";;; user-fields: (@userFields)\n";
foreach $rec (sort SortBbdb @{$db->{'__RECORDS'}}) {
&writeBbdbRec($rec, FD);
}
close(FD);
}
sub writeBbdbRec {
my ($rec, $BBDB) = @_;
my ($areacode, $no1, $no2, $ext, $firstBrace, $email, $address);
my ($home, $pager, $mobile, $main, $fax, $k, $temp);
# Sort entries by last name, organization or email
$firstBrace = 0;
foreach $k (0 .. 18) {
$rec->{'entry'}->[$k] =~ s/\n/ /g;
}
print $BBDB "[";
BbdbPrintField ($rec->{'entry'}->[1], "\"", "\" ", $BBDB);
BbdbPrintField ($rec->{'entry'}->[0], "\"", "\" ", $BBDB);
BbdbPrintField ("nil", "(", ") ", $BBDB);
BbdbPrintField ($rec->{'entry'}->[2], "\"", "\" ", $BBDB);
if (($rec->{'entry'}->[3] ne "") &&
($rec->{'showphone'}->[0] == 0)) {
($areacode, $no1, $no2, $ext) =
split (/[-x]/, $rec->{'entry'}->[3]);
$ext = 0 if (!defined ($ext));
$areacode = 0 if (!defined ($areacode));
$no1 = 0 if (!defined ($no1));
$no2 = 0 if (!defined ($no2));
print $BBDB "([";
if ($rec->{'entry'}->[9] ne "") {
BbdbPrintField ("\"$rec->{'entry'}->[9]\" ", "", "", $BBDB);
}
else {
BbdbPrintField (" ", "\"", "\" ", $BBDB);
}
BbdbPrintField ($areacode." ".$no1." ".$no2." ".$ext, "", "]) ", $BBDB);
}
else {
BbdbPrintField ("nil", "", " ", $BBDB);
}
$address = "nil";
# Construct the address field in the format of BBDB
if (($rec->{'entry'}->[8] ne "") && ($rec->{'entry'}->[9] ne "")) {
if ($rec->{'entry'}->[10] ne "") {
$address = "\"$rec->{entry}->[9], $rec->{entry}->[10]\" \"$rec->{entry}->[8]\" \"\" \"\" \"$rec->{entry}->[9]\" \"$rec{entry}->[10]\"";
}
else {
$address = "\"$rec->{entry}->[9]\" \"$rec->{entry}->[8]\" \"\" \"\" \"$rec->{entry}->[9]\" \"\"";
}
if ($rec->{entry}->[11] ne "") {
$address .= " $rec->{entry}->[11]";
}
else {
$address .= " 0";
}
}
$address =~ s/\n//g;
# Concatenate all the email fields into one
$email = "";
foreach $k (3 .. 7) {
next if ($rec->{'entry'}->[$k] eq "");
if ($rec->{'phoneLabel'}->[$k-3] == 4) {
$temp = $rec->{'entry'}->[$k];
$temp =~ s/, /" "/g;
$email .= "\"".$temp."\" ";
}
}
$email = "nil" if ($email eq "");
$address = "nil" if ($address eq "");
BbdbPrintField ($address, "([", "]) ", $BBDB);
BbdbPrintField ($email, '(', ') ', $BBDB);
# BBDB cannot handle newlines in the notes field. Replace newlines with
# spaces.
if (($rec->{'entry'}->[18] ne "") &&
($rec->{'entry'}->[18] ne "nil")) {
$notes = $rec->{'entry'}->[18];
$notes =~ s/\n/ /g;
BbdbPrintField ("\"$notes\"", "((notes . ", ")", $BBDB);
$firstBrace = 1;
}
# Remaining fields are user-defined fields
foreach $k (3 .. 7) {
next if (($rec->{'phoneLabel'}->[$k-3] == 0) ||
($rec->{'phoneLabel'}->[$k-3] == 4));
next if ($rec->{'entry'}->[$k] eq "");
next if ($rec->{'entry'}->[$k] eq "nil");
if ($rec->{entry}->[$k] =~ m/^\d+/) {
($areacode, $no1, $no2, $ext) =
split (/[-x]/, $rec->{entry}->[$k]);
$ext = 0 if (!defined ($ext));
$areacode = 0 if (!defined ($areacode));
$no1 = 0 if (!defined ($no1));
$no2 = 0 if (!defined ($no2));
$value = $areacode." ".$no1." ".$no2." ".$ext;
}
else {
$value = $rec->{entry}->[$k];
}
$label = $PhoneLabels[$rec->{phoneLabel}->[$k-3]];
if ($firstBrace) {
BbdbPrintField ($value, " ($label . \"", "\") ", $BBDB);
}
else {
BbdbPrintField ($value, " (($label . \"", "\") ", $BBDB);
$firstBrace = 1;
}
}
# Add the Custom fields
foreach $k (1 .. 4) {
$labelName = "custom".$k;
if (($rec->{'entry'}->[13+$k] ne "") &&
($rec->{'entry'}->[13+$k] ne "nil")) {
if ($firstBrace) {
BbdbPrintField ($rec->{entry}->[13+$k],
" ($labelName . \"", "\") ", $BBDB);
}
else {
BbdbPrintField ($rec->{entry}->[13+$k],
" (($labelName . \"", "\")", $BBDB);
$firstBrace = 1;
}
}
}
# Add the category as a user-defined field
if (($rec->{category} ne "") && ($rec->{category} ne "nil")) {
if ($firstBrace) {
BbdbPrintField ($rec->{category}, " (category . \"", "\") ", $BBDB);
}
else {
BbdbPrintField ($rec->{category}, " ((category . \"", "\")", $BBDB);
$firstBrace = 1;
}
}
# Add the record ID as a user-defined field
if ($firstBrace) {
BbdbPrintField ($rec->{rolo_id}, " (recordID . \"", "\") ", $BBDB);
}
else {
BbdbPrintField ($rec->{rolo_id}, " ((recordID . \"", "\")", $BBDB);
$firstBrace = 1;
}
# Add the showphone field
if ($firstBrace) {
BbdbPrintField ($rec->{'showPhone'}, " (showphone . \"", "\") ", $BBDB);
}
else {
BbdbPrintField ($rec->{'showPhone'}, " ((showphone . \"", "\")", $BBDB);
$firstBrace = 1;
}
if ($firstBrace) {
print $BBDB ") ";
}
else {
# nil Notes field and so print nil.
print $BBDB "nil ";
}
print $BBDB "nil]\n";
}
sub BbdbPrintField {
my ($field, $prefix, $suffix, $BBDB) = @_;
if (!defined ($field) || $field eq "nil") {
print $BBDB "nil ";
}
else {
print $BBDB $prefix, $field, $suffix;
}
}
sub GetFields {
my ($i) = 0;
my (@field);
my ($j) = 0;
$j = 0;
while ($j < length($_[0])) {
if (substr($_[0], $j, 1) eq '"') { # ;"
($j, $field[$i++]) = &MatchString($_[0], $j);
}
elsif (substr($_[0], $j, 1) eq '(') {
($j, $field[$i++]) = &MatchParent($_[0], $j);
}
elsif (substr($_[0], $j, 1) ne ' ') {
($j, $field[$i++]) = &MatchWord($_[0], $j);
}
else {
$j ++;
}
}
return @field;
}
sub MatchString {
my ($i) = $_[1];
$i++;
for (; $i < length($_[0]); $i++) {
if (substr($_[0], $i, 1) eq '"') { # ;"
$i++;
return ($i, substr($_[0], $_[1]+1, $i - $_[1] - 2));
}
}
return ($i, substr($_[0], $_[1]+1));
}
sub MatchWord {
my ($i) = $_[1];
my ($startQuote) = 0;
for (; $i < length($_[0]); $i++) {
if (substr($_[0], $i, 1) eq ' ' && !$startQuote) {
return ($i, substr($_[0], $_[1], $i - $_[1]));
}
elsif (substr($_[0], $i, 1) eq '"') {
$startQuote = !$startQuote;
}
}
return ($i, substr($_[0], $_[1]));
}
sub MatchParent {
my ($i) = $_[1];
my ($skip) ;
$stack = 1;
$i++;
for (; $i < length($_[0]); $i++) {
if (substr($_[0], $i, 1) eq '"') { # ;"
($i, $skip) = &MatchString($_[0], $i);
$i --;
}
elsif (index("([", substr($_[0], $i, 1)) >= 0) {
$stack++;
}
elsif (index("])", substr($_[0], $i, 1)) >= 0) {
$stack--;
if ($stack == 0) {
$i++;
return ($i, substr($_[0], $_[1]+1, $i - $_[1] - 2));
}
}
}
return ($i, substr($_[0], $_[1]+1));
}
###############################################################################
# The BBDB representation of phone is not the way we like it to be. Convert it
# into the format xxx-xxx-xxxx add in case of an extension, add the trailing
# x<extension #>.
###############################################################################
sub GetNumberFromPhoneFieldBbdb {
my ($phoneNo, $extension);
($phoneNo, $extension) =
($_[0] =~ m/[^0-9]*(\d+ \d+ \d+) (\d+).*$/);
if (!defined ($phoneNo)) {
# The phone was not in a North American number format.
($phoneNo) = ($_[0] =~ m/[^0-9]*([0-9 -]+).*$/);
}
# BBDB converts numbers such as 0400 to 400. Fix this - TBD
if (defined ($phoneNo)) {
$phoneNo =~ s/ /-/g;
}
return ($phoneNo, $extension);
}
###############################################################################
# The BBDB address is stored with the street address, city, state and zipcode
# all clumped together. Split them apart into a format similar to the way the
# PalmPilot stores it.
###############################################################################
sub GetAddressFieldsBbdb {
my ($address) = @_;
my ($streetAddr, $st1, $st2, $st3, $city, $state, $zipcode, $zip);
# BBDB's address format is as follows:
# ["location" "street addr 1" "street addr 2" "street addr 3" "city" "state"
# zipcode]
# Our regexp below assumes that there are no " within the individual fields
($st1, $st2, $st3, $city, $state, $zip) = ($address =~ m/\[\"[^"]*\" \"([^"]*)\" \"([^"]*)\" \"([^"]*)\" \"([^"]*)\" \"([^"]*)\" (\d+)/);
$st1 = "" if (!defined ($st1));
$st2 = "" if (!defined ($st2));
$st3 = "" if (!defined ($st3));
$streetAddr = $st1." ".$st2." ".$st3;
$zipcode = "\"$zip\"";
return ($streetAddr, $city, $state, $zipcode);
}
###############################################################################
# The BBDB field extraction routine clumps the notes field and the user-defined
# fields under a single variable. This routine xtracts just the notes part
# from this variable.
###############################################################################
sub GetNotesBbdb {
my ($notes) = @_;
my ($justNotes);
if ($notes =~ m/^\(/) {
if ($notes =~ m/^\(notes . /) {
(undef, $justNotes) = &MatchParent ($_[0], 0);
if (!defined ($justNotes)) {
$justNotes = "nil";
}
}
else {
$justNotes = "nil";
}
}
else {
$justNotes = $notes;
}
$justNotes =~ s/^\"//;
$justNotes =~ s/\"$//;
$justNotes =~ s/^notes . "//;
return $justNotes;
}
###############################################################################
# This routine extracts the value for a specified custom field from the generic
# notes variable created by the BBDB field extraction routine.
###############################################################################
sub GetCustomFieldBbdb {
my ($notes, $fieldName) = @_;
my ($customField);
if ($notes =~ m/^\(/) {
($customField) = ($notes =~ m/\($fieldName . "([^)]*)"\)/);
}
return (defined ($customField) ? $customField : undef);
}
sub SortBbdb {
$a->{'entry'}->[0] cmp $b->{'entry'}->[0];
}
#XXX test code XXX
#my $db = &readVCardsMultipleFiles("$ENV{HOME}/.dt/Addresses");
#foreach (@{$db->{'__RECORDS'}}) { print Dumper($_) }
1;
--
Within yourself deliverance must be searched for, because each man makes his
own prison. - Sir Edwin Arnold
------------------------------------------------------------------------
***********************************************************
* This is a public mailing list! *
* Please do not publish Sun proprietary information here! *
* - - - - - - - - - - - - - - *
* MoreInfo/Unsubscribe @ http://www.moshpit.org/pilotmgr *
***********************************************************