view release on metacpan or  search on metacpan

lib/AddressBook/DB/BBDB.pm  view on Meta::CPAN

my @field_names = 
qw (first last aka company phone address net notes);
my %field_names;
@field_names{@field_names} = (0..$#field_names);

my $sample_data = <<END;
["first" "last" ("aka") "company" (["phone with integer" 123 456 789] ["phone with quotes" "123-456-789"]) (["address" "street1" "street2" "street3" "city" "state" ("zip")]) ("net") ((notes . "data")) nil]
END

my %field_index;
sub _figure_out_indices {
  my @fields = ($sample_data =~ m/^$bbdb_entry_pat$/ox);
  my @names = @field_names;
  my $i;
  for ($i=0; $i < @fields; $i++) {
    if ($fields[$i] =~ $names[0]) {
      $field_index{shift @names} = $i;
      last unless @names;
    }
  }
}
_figure_out_indices();

########################################################################

sub un_escape {
  my $s = shift;
  $s =~ s/\\(.)/$1/g;               # should just be " or \
  return $s;
}

########################################################################

sub decode {
  my ($self,$str) = @_;
  my @fields = ();
  unless (@fields = ($str =~ m/^$bbdb_entry_pat$/ox)) {
    if ($BBDB::debug) {
      my $pat = '';
      my @subpats = (
		     [ '\[', 'opening ['],
		     [ $nil_or_string_pat, 'First name'],
		     [ $nil_or_string_pat, 'Last name'],
		     [ $aka_pat, 'Also known as'],
		     [ $nil_or_string_pat, 'Company name'],
		     [ $phone_pat, 'Phone'],
		     [ $address_pat, 'Address'],
		     [ $net_pat, 'Net names' ],
		     [ $notes_pat, 'Notes'],
		     [ 'nil', 'Last nil'],
		     [ '\]', 'closing ]']
		    );
      my $i;
      foreach $i (@subpats) {
	$pat .= $i->[0];
	printf STDERR "No match at %s\n", $i->[1] and last unless
	  $str =~ m/^$pat/x;
	$pat .= '\ ' unless $i->[0] eq '\[' or $i->[0] eq 'nil' ;
      }
    }
    return undef;
  }


  my $i;
  local($_);

  foreach $i (@field_names) {
    $fields[$field_index{$i}] = ''
      if (!defined $fields[$field_index{$i}] or 
	  $fields[$field_index{$i}] eq 'nil');
  }

  my @aka = split(/$quoted_string_pat/ox,$fields[$field_index{aka}]);
  #    print "AKA=\n<",join(">\n<",@aka),">\nEND AKA\n";
  my $aka = [];
  for ($i=0; $i < @aka - 1; $i+=2) {
    push @$aka, un_escape($aka[$i+1]);
  }

  my @phone = split(/$single_phone_pat/ox,$fields[$field_index{phone}]);
  #    print "PHONE=\n<",join(">\n<",@phone),">\nEND PHONE\n";
  my $phone = [];
    for ($i=0; $i < @phone - 1; $i+=5) {
      push @$phone,[
		    un_escape($phone[$i+1]),
		     un_escape(defined $phone[$i+3] ? 
			       $phone[$i+3] : $phone[$i+4])
		   ];
    }

  my @address = split(/$single_address_pat/ox,$fields[$field_index{address}]);
  #    print "ADDRESS=\n<",join(">\n<",@address),">\nEND ADDRESS\n";
  my $address = [];
    for ($i=0; $i < @address - 1; $i+=9) {
      my $zip = $address[$i+7];
      $zip =~ s/^\((.*)\)$/$1/;   # remove ()
      if (defined $address[$i+8]) {  # we have quoted strings
	my @zip = split(/$quoted_string_pat/ox,$zip);
	#   print "ZIP = \n<",join(">\n<",@zip),">\nEND ZIP\n";
	$zip = join('',@zip);
      }
      push @$address,[
		      un_escape($address[$i+1]),
		      un_escape($address[$i+2]),
		      un_escape($address[$i+3]),
		      un_escape($address[$i+4]),
		      un_escape($address[$i+5]),
		      un_escape($address[$i+6]),
		      $zip
		     ];
    }

  my @net = split(/$quoted_string_pat/ox,$fields[$field_index{net}]);
  #    print "NET=\n<",join(">\n<",@net),">\nEND NET\n";
  my $net = [];
  for ($i=0; $i < @net - 1; $i+=2) {
    push @$net, un_escape($net[$i+1]);
  }

lib/AddressBook/DB/BBDB.pm  view on Meta::CPAN

  (timestamp . "1999-10-17")
  (notes . "Always split aces and eights")
  (birthday "6/15")
 )
 nil                                  The cache vector - always nil
 ]

After this is decoded it will be returned as a reference to a BBDB
object.  The internal structure of the BBDB object mimics the lisp
structure of the BBDB string.  It consists of a reference to an array
with 9 elements The Data::Dumper output of the above BBDB string would
just replaces all of the ()s with []s.  It can be accessed by using
the C<$bbdb->part('all')> method.

=head2 Methods

=over 4

=item new()

called whenever you want to create a new BBDB object.  
       my $bbdb = new BBDB();

=item part(name [value])

Called to get or set all or part of a BBDB object.  The parts of the
object are: 

       all first last aka company phone address net notes

any other value in the name argument results in death.  Some of these
parts, namely phone, address, net, and notes have an internal
structure and are returned as references to arrays.  The others are
returned just as strings.  The optional second argument sets the part
of this BBDB object to the value you provided.  There is no
consistency checking at this point, so be sure the value you are
setting this to is correct.

 my $first = $bbdb->part('first');    # get the value of the first field
 $bbdb->part('last','Laxen');         # set the value of the last field
 my $everything = $bbdb->part('all'); # get the whole record

=item BBDB::simple(file_name,[array_ref_of_bbdb])

This is a "simple" interface for reading or writing an entire BBDB
file. If called with one argument, it returns a reference to an array of BBDB
objects.  Each object contains the data from the file.  Thus the
number of BBDB entries equals C<scalar(@$bbdb)> if you use:

       $bbdb = BBDB::simple('/home/henry/.bbdb');

If called with two arguments, the first is the filename to create, and
the second is a reference to an array of BBDB objects, such as was
returned in the one argument version.  The objects are scanned for
unique user defined fields, which are written out as the 2nd line in
the BBDB file, and then the individual records are written out.

=item decode(string)

Takes a string as written in a BBDB file of a single BBDB record
and decodes it into its PERL representation.  Returns undef if
it couldn't decode the record for some reason, otherwise returns
true.  

       $bbdb->decode($entry);

=item encode()

This is the inverse of decode.  Takes an internal PERL version of
a BBDB records and returns a string which is a lisp version of the
data that BBDB understands.  There are some ambiguities, noted in
BUGS below.

       my $string = $bbdb->encode();


=back

=head2 Debugging

If you find that some records in your BBDB file are failing to be
recognized, trying setting C<$BBDB::debug = 1;> to turn on debugging.
We will then print out to STDERR the first field of the record that we
were unable to recognize.  Very handy for complicated BBDB records.

=head1 AUTHOR

Henry Laxen <nadine.and.henry@pobox.com>
http://www.maztravel.com/perl

=head1 SEE ALSO

BBDB texinfo documentation

=cut


=head1 BUGS

Phone numbers and zip codes may be converted from strings to integers
if they are decoded and encoded.  This should not affect the operation
of BBDB.  Also a null last name is converted from "" to nil, which
also doesn't hurt anything.

You might ask why I use arrays instead of hashes to encode the data in
the BBDB file.  The answer is that order matters in the bbdb file, and
order isn't well defined in hashes.  Also, if you use hashes, at least
in the simple minded way, you can easily find yourself with legitimate
duplicate keys.


=cut