syncbbdb 2.6-1 / usr / share / perl5 / SyncBBDB / pilotBBDBMap.pm

#------------------------------------------------------------------------------
#   $Date: 2006/05/01 19:40:48 $
#   RCS: $Id: pilotBBDBMap.pm,v 1.3 2006/05/01 19:40:48 aaronkaplan Exp $
#------------------------------------------------------------------------------

package pilotBBDBMap;

use strict;

use bbdb::bbdb;
use bbdb::bbdbRecord;

use SyncBBDB::pilotBBDBRecMap;
use SyncBBDB::pilotBBDBFieldMap;

my @pilot_fields = ("Field1",  "Field2",  "Field3",  "Field4",  "Field5", 
		    "Custom1", "Custom2", "Custom3", "Custom4",
		    "Title", "Note");


# Regex for a quoted string...
my $qstrRE = "\"((?:[^\\\\\"]+|\\\\.)*)\"";

## Phone number stuff...
my $parea = '1?\s*[-.\(]?\s*([2-9][0-9][0-9])[-.\)\s]+';
my $pmain = '([1-9][0-9][0-9])[-.\s]*([0-9][0-9][0-9][0-9])';
my $pext  = '[-.x\s]+(\d+)';

my $phoneRE1 = "^\\s*" . $parea . $pmain . $pext . "\\s*\$";
my $phoneRE2 = "^\\s*" . $parea . $pmain . "\\s*\$";
my $phoneRE3 = "^\\s*" . $pmain . $pext  . "\\s*\$";
my $phoneRE4 = "^\\s*" . $pmain . "\\s*\$";
my $phoneRE5 = "^[-0-9 EeXxtT.()+]*\$";

sub new {
    my $type = shift;
    my $self = {};

    bless($self, $type);

    $self->{'bbdb'} = shift;
    $self->{'translate'} = shift;

    my $val = $self->{'bbdb'}{'notes'}{'pilot-id'} || "";
    $self->parse($val);
    
    return $self;
}

sub toString {
    my $self = shift;
    my $ret;
    
    foreach my $rec (@{$self->{'records'}}) {
	my $id = $rec->{'id'};
	my $cat = $rec->{'category'};
	my $name =  "-NO-ADDRESS-";
	if (defined $rec->{'name'}) {
	    $name =  $rec->{'name'};
	}
	$ret .= $id." \"".$cat."\" \"".$name."\"\n";
	my @ents;
	foreach my $ent (@{$rec->{'mappings'}}) {
	    push(@ents, "  \"".$ent->getPilot()."\" \"".$ent->getBBDB()."\"");
	}
	$ret .= join("\n", sort(@ents)) . "\n";
    }
    
    $self->updateSkipped();

    if (scalar(@{$self->{'skipped'}})) {
	$ret .= "  BBDB-Unused: \"";
	$ret .= join("\",\"",@{$self->{'skipped'}}) . "\"";
    } else {
	# Kill the 'extra' newline...
	chomp($ret);
    }

    return $ret;
}

sub parse {
    my $self = shift;
    my $str  = shift;

    $self->{'records'} = [];
    $self->{'skipped'} = [];

    my $recMap;
    my @lines = split(/\n/, $str);

    # print "\n\nStarting Parse\n";

    # This supports the new Quoted form as well as the unquoted form.
    # Eventually I will remove support for the unquoted form (it's dangerous)
    my $identRE = "(?:$qstrRE|([^\"\\s]+))";
    foreach my $l (@lines) {

	# print "Line: '$l'\n";

	if ($l =~ /^\s*([0-9]+)\s*$/) {
	    # Old style pilot-id...
	    my $id = $1;

	    my $name = undef;
	    foreach my $l (@{$self->{'bbdb'}{'addr'}}) {
		if ($l->{'name'} =~ m/^\*/) {
		    $name = $l->{'name'};
		    last;
		}
	    }

	    if ((!defined $name) &&
		(scalar (@{$self->{'bbdb'}{'addr'}}))) {
		$name = $self->{'bbdb'}{'addr'}[0]->{'name'};
	    }

	    my $cat = undef;
	    # Get the category mapping, and delete it when done.
	    if (defined $self->{'bbdb'}{'notes'}{'category'}) {
		my @cats = split(/\s+/,$self->{'bbdb'}{'notes'}{'category'});
		$cat = $cats[0];
	    }
	    elsif (defined $self->{'bbdb'}{'org'}) {
		## Special cases
		my $org = $self->{'bbdb'}{'org'};
		$cat = "Kodak"    if ($org eq "Eastman Kodak");
		$cat = "Business" if ($org eq "Sun Microsystems");
	    }
	    if ((!defined $cat) && defined $name) {
		# See if our address name is a category name...
		if (defined $self->{'CategoryHash'}{$name}) {
		    $cat = $self->{'CategoryHash'}{$name};
		}
	    }
	    $cat = "Unfiled" if (!defined $cat);
	    
	    if (defined $name) {
		$recMap = new pilotBBDBRecMap($id, $cat, $name);
	    } else {
		$recMap = new pilotBBDBRecMap($id, $cat);
	    }

	    push(@{$self->{'records'}}, $recMap);
	    last;
	}
	elsif ($l=~/^\s*([0-9]+)\s+$identRE\s+$identRE\s*$/) {
	    # start of new 
	    my $id   = $1;
	    my $cat  = $2 || $3;
	    my $name = $4 || $5;
	    if ($name ne "-NO-ADDRESS-") {
		$recMap = new pilotBBDBRecMap($id, $cat, $name);
	    } else {
		$recMap = new pilotBBDBRecMap($id, $cat);
	    }		
	    push(@{$self->{'records'}}, $recMap);
	}
	elsif ($l =~ m/^\s*BBDB-Unused:\s*"(.*)"/) {
	    # Quoted strings...
	    my $fields = "\"".$1."\"";
	    while ($fields =~ m/$qstrRE/) {
		$fields = $';
		my $field = $1;
		push(@{$self->{'skipped'}}, $field);
	    }
	}
	elsif ($l =~ m/^\s*BBDB-Unused:\s*/) {
	    # Unquoted strings...
	    my $fields = $';
	    push(@{$self->{'skipped'}}, split(/\s*,\s*/,$fields));
	}
	elsif ($l=~m/^\s*$identRE\s+$identRE\s*$/) {
	    my $pinfo = $1 || $2;
	    my $binfo = $3 || $4;

	    my $ent = undef;
	    if ($binfo =~ m/([^:]+):(.+)/) {
		my $btype = $1;
		my $bname = $2;
		if ($pinfo =~ m/([^:]+):(.+)/) {
		    my $pname = $1;
		    my $pval  = $2;
		    $ent = new pilotBBDBFieldMap($btype, $bname, 
						 $pname, $pval);
		} else {
		    $ent = new pilotBBDBFieldMap($btype, $bname, $pinfo);
		}
		if (!defined $recMap) {
		    print STDERR "Name: " . $self->{'bbdb'}{'fname'} .
			" " . $self->{'bbdb'}{'lname'} . "\n";
		} else {
		    $recMap->addMapping($ent);
		}
	    }
	    else { # Bad line.... What to do...
	    }
	}
    }
}

sub updateSkipped {
    my $self = shift;
    
    my %used = %{$self->getUsedBBDBFields(undef)};
    my %all  = %{$self->getAllBBDBFields()};

    foreach my $f (keys %used) {
	delete $all{$f};
    }

    my @skip = keys %all;
    $self->{'skipped'} = \@skip;
}

sub dup {
    my $self = shift;
    
}

sub getAllBBDBFields {
    my $self = shift;
    my $rec  = $self->{'bbdb'};

    my %fields;
    if (defined $rec->{'email'} && scalar(@{$rec->{'email'}})) {
	$fields{"net:0"} = 1;
    }

    if (defined $rec->{'aka'} && scalar(@{$rec->{'aka'}})) {
	$fields{"aka:0"} = 1;
    }

    foreach my $addr (@{$rec->{'addr'}}) {
	$fields{"addr:" . $addr->{'name'}} = 1;
    }

    foreach my $phone (@{$rec->{'phone'}}) {
	$fields{"phone:" . $phone->{'title'}} = 1;
    }

    foreach my $note (keys %{$rec->{'notes'}}) {
        next if $note eq 'notes';
	$fields{"note:$note"} = 1;
    }

    return \%fields;
}

sub getUsedBBDBFields {
    my $self = shift;
    my $incSkip = shift;

    my %ret;
    $ret{'note:pilot-id'} = 1;

    foreach my $rec (@{$self->{'records'}}) {
	if (defined $rec->{'name'}) {
	    $ret{"addr:" . $rec->{'name'}} = 1;
	}

	my %rec = %{$rec->getUsedBBDBFields()};

	foreach my $f (keys %rec) {
	    $ret{$f} = 1;
	}
    }

    if ($incSkip) {
	foreach my $f (@{$self->{'skipped'}}) {
	    $ret{$f} = 1;
	}
    }

    return \%ret;
}

sub getNewBBDBFields {
    my $self = shift;

    my %ret  = %{$self->getAllBBDBFields()};
    my %used = %{$self->getUsedBBDBFields(1)};
    
    foreach my $f (keys %used) {
	delete $ret{$f};
    }
    return \%ret;
}

sub getDeletedBBDBFields {
    my $self = shift;

    my %all  = %{$self->getAllBBDBFields()};
    my %used = %{$self->getUsedBBDBFields(1)};
    
    my %ret;
    foreach my $f (keys %used) {
	$ret{$f} = 1 if (!defined $all{$f});
    }
    return \%ret;
}

sub removeBBDBMapping {
    my $self = shift;
    my $field = shift;

    my @recs   = @{$self->{'records'}};
    my @result = ();
    foreach my $rec (@recs) {
	if ((defined $rec->{'name'}) &&
	    ($field eq "addr:" . $rec->{'name'})) {
	    # other addresses so non-address info will still
	    # exist in palm.
	    next if (scalar(@recs) > 1);

	    # No other addresses so we want to 'metamorphise'
	    # into a non-address record:
	    delete $rec->{'name'};
	} else {
	    $rec->removeBBDBMapping($field);
	}

	push(@result, $rec);
    }
    $self->{'records'} = \@result;
}

sub removePilotMapping {
    my $self = shift;
    my $field = shift;

    my @recs   = @{$self->{'records'}};
    foreach my $rec (@recs) {
	$rec->removePilotMapping($field);
    }
}

sub getAllPilotFields {
    my $pbbdb = shift;
    my $prec = shift;
    
    my %ret;
    foreach my $f (@pilot_fields) {
	my $val = $pbbdb->getField($prec, $f);
	next if (!defined $val || ! $val);
	$ret{$f} = 1;
    }
    return \%ret;
}

# Similar to getUsedPilotFields except it annontates Fields[1-5] with
# the label that is currently choosen.
sub getAllPilotFieldsAnnotated {
    my $pbbdb = shift;
    my $prec = shift;
    
    my %ret;
    foreach my $f (@pilot_fields) {
	my $val = $pbbdb->getField($prec, $f);
	next if (!defined $val || ! $val);
	if ($f !~ m/Field/) {
	    $ret{$f} = 1;
	} else {
	    my $idx = $'; $idx--;
	    my $lbl = $prec->{'phoneLabel'}[$idx];
	    $ret{$f . ":" . $lbl} = 1;
	}
    }
    return \%ret;
}

sub getUsedPilotFields {
    my $self  = shift;
    my $pbbdb = shift;
    my $id   = shift;
    my %ret;
    foreach my $rec (@{$self->{'records'}}) {
	next if ($rec->{'id'} ne $id);
	foreach my $ent (@{$rec->{'mappings'}}) {
	    if (defined $ent->{'pilot-label'}) {
		$ret{$ent->{'pilot'} . ":" . $ent->{'pilot-label'}} = 1;
	    } else  {
		$ret{$ent->{'pilot'}} = 1;
	    }
	}
    }
    return \%ret;
}

sub getNewPilotFields {
    my $self  = shift;
    my $pbbdb = shift;
    my $prec  = shift;
    
    my %ret  = %{getAllPilotFieldsAnnotated($pbbdb, $prec)};
    my %used = %{$self->getUsedPilotFields($pbbdb, $prec->{'id'})};

    foreach my $f (keys %used) {
	delete $ret{$f};
    }
    return \%ret;
}

sub getDeletedPilotFields {
    my $self  = shift;
    my $pbbdb = shift;
    my $prec  = shift;
    
    my %all  = %{getAllPilotFieldsAnnotated($pbbdb, $prec)};
    my %used = %{$self->getUsedPilotFields($pbbdb, $prec->{'id'})};
    
    my %ret;
    foreach my $f (keys %used) {
	$ret{$f} = 1 if (!defined $all{$f});
    }
    return \%ret;
}

sub getMapForID {
    my $self = shift;
    my $id   = shift;

    foreach my $rec (@{$self->{'records'}}) {
	return $rec if ($id eq $rec->{'id'});
    }
    return undef;
}

sub delMapForID {
    my $self = shift;
    my $id = shift;
    my $ret = undef;

    my @recs;
    foreach my $rec (@{$self->{'records'}}) {
	if ($id eq $rec->{'id'}) {
	    $ret = $rec;
	} else {
	    push(@recs, $rec);
	}
    }
    $self->{'records'} = \@recs;

    return $ret;
}
    

sub getMapForName {
    my $self = shift;
    my $name = shift;

    foreach my $rec (@{$self->{'records'}}) {
	return $rec if ($name eq $rec->{'name'});
    }
    return undef;
}

sub updateMappingFromBBDB {
    # BBDB record has changed update the mapping to the Pilot Record
    # to include any new fields in the BBDB record and to remove any
    # deleted fields from the BBDB record.
    my $self  = shift;
    my $pbbdb = shift;

    my %deleted = %{$self->getDeletedBBDBFields()};
    my %new     = %{$self->getNewBBDBFields()};

    foreach my $f (keys %deleted) {
	$self->removeBBDBMapping($f);
    }

    # print STDERR "New: " . join(", ", keys %new) . "\n";

    my @newRecs = ();
    foreach my $f (keys %new) {
	$f =~ m/([^:]+):(.*)/;
	my $type = $1;
	my $name = $2;
	if ($type eq "addr") {
	    my $mapRec = $self->newAddressFromBBDB($pbbdb, $name);

	    push(@newRecs, $mapRec) if (defined $mapRec);
	}
    }

    if ((scalar(@{$self->{'records'}}) == 0) &&
	(scalar(@newRecs)              == 0)) {
	# create a new pilot record with no associated address if we don't
	# have one by now.
	my $mapRec = $self->newAddressFromBBDB($pbbdb, undef);
	push(@newRecs, $mapRec) if (defined $mapRec);
    }

    foreach my $rec (@{$self->{'records'}}) {
	$self->addFieldsToRecord($pbbdb, $rec, \%new);
    }

    push(@{$self->{'records'}},@newRecs);
}

# Add a new address from BBDB which means creating a new Pilot record
# and adding field mappings to it...
sub newAddressFromBBDB {
    my $self  = shift;
    my $pbbdb = shift;
    my $name  = shift;

    # One pilot record with no associated addr.  
    # So associate the new addr with it...
    # I don't do this if there is more than one pilot rec since
    # if one (or more) of them aren't assoicated with BBDB addrs
    # it is probably intentional.
    if (scalar(@{$self->{'records'}}) == 1) {
	my $rec = $self->{'records'}[0];
	if (!defined $rec->{'name'}) {
	    $rec->{'name'} = $name;
	    return undef;  # no new record.
	}
    }

    # create a new pilot record to sync this address with...
    my $prec = $pbbdb->newRec();
    
    my $rec = new pilotBBDBRecMap($prec->{'id'}, "Unfiled", $name);
    $self->addFieldsToRecord($pbbdb, $rec, $self->getAllBBDBFields());
    return $rec;
}

sub addFieldsToRecord {
    my $self  = shift;
    my $pbbdb = shift;
    my $rec   = shift;
    my $tmp   = shift;
    my %new   = %{$tmp};

    if (defined $rec->{'name'}) {
	my $name  = $rec->{'name'};
	my $pname = $self->{'translate'}->getForPilot($name);

	if (defined $new{"phone:" . $name}) {
	    # Should become primary phone for this record...
	    $rec->addBBDB($pbbdb, "phone", $name, $pname, 1);
	}
	if (defined $new{"note:" . $name}) {
	    # Should become primary custom for this record...
	    $rec->addBBDB($pbbdb, "note", $name, $pname, 1);
	}
    }

    my $hasNet = (defined $new{"net:0"});

    foreach my $n (keys %new) {
	# Only One field left and we have a net, make sure we include it.
	last if (($hasNet) && $rec->leftFree($pbbdb) == 1);

	# Get the BBDB record type and the name..
	$n =~ m/^([^:]+):(.*)$/;
	my $type = $1;
	my $name = $2;

	# Don't handle net's right now...
	next if ($type eq "net");
	# Don't handle address here...
	next if ($type eq "addr");

	# check if we already handled this in the first pass...
	next if ((defined $rec->{'name'}) && 
		 ($rec->{'name'} eq $name));

	if ($type eq "aka") {
	    my $pname = $self->{'translate'}->getForPilot("aka");
	    $rec->addBBDB($pbbdb, "aka", "0", $pname);
	    next;
	}
	    

	# Try adding the field to the record.
	my $pname = $self->{'translate'}->getForPilot($name);
	$rec->addBBDB($pbbdb, $type, $name, $pname);
    }

    if ($hasNet) {
	my $pname = $self->{'translate'}->getForPilot("net");
	$rec->addBBDB($pbbdb, "net", "0", $pname, 1);
    }
}

sub updateMappingFromPilot {
    my $self  = shift;
    my $pbbdb = shift;
    
    my $lrec  = $self->{'bbdb'};

    my @recs;
    foreach my $rec (@{$self->{'records'}}) {
	my $prec = $pbbdb->getRec($rec->{'id'});

	# Record was deleted, so this mapping goes away...
	next if (!defined $prec);
	    
	my %deleted = %{$self->getDeletedPilotFields($pbbdb, $prec)};
	my %new     = %{$self->getNewPilotFields($pbbdb, $prec)};

	# print STDERR "Pilot New: " . join(", ", keys %new) . 
	#               "\n      Del:: " . join(", ", keys %deleted) . "\n";
    
	foreach my $f (keys %deleted) {
	    $self->removePilotMapping($f);
	}

	my @newEnt;

	foreach my $f (keys %new) {
	    my $pname = $f;
	    my $pval = undef;
	    if ($pname =~ m/(.*):(.*)/) {
		$pname = $1;
		$pval  = $2;
	    }
	    my $bname = $self->{'translate'}->getBBDBName($pbbdb, $f);
	    # print "Info: $pname->$bname\n";

	    if (($bname eq "title") || ($bname eq "note")){
		push(@newEnt, new pilotBBDBFieldMap("note", $bname, $pname));
		next;
	    }
	    if ($bname eq "net") {
		push(@newEnt, new pilotBBDBFieldMap("net", "0", 
						    $pname, $pval));
		next;
	    }
	    if ($bname eq "aka") {
		push(@newEnt, new pilotBBDBFieldMap("aka", "0", 
						    $pname, $pval));
		next;
	    }
	    
	    my $field = $pbbdb->getField($prec, $pname);
	    if ($field =~ m/$phoneRE5/) {
		push(@newEnt, new pilotBBDBFieldMap("phone", $bname,
						    $pname, $pval));
		next;
	    } else {
		# Make sure that bname is a valid lisp 'identifier' otherwise
		# BBDB won't be able to read it...
		$bname =~ s/[ ]/-/g;
		$bname =~ s/[\'\"]//g;
		$bname =~ s/[\?\[\]\\\(\)\;\#]/_/g;
		push(@newEnt, new pilotBBDBFieldMap("note", $bname,
						    $pname, $pval));
		next;
	    }
	}
	push(@{$rec->{'mappings'}}, @newEnt);
	push(@recs, $rec);
    }
    $self->{'records'} = \@recs;
}

1;