AddressBook

 view release on metacpan or  search on metacpan

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

$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 list
($address_pat) \\                # Address list
($net_pat)   \\                  # Net names list
($notes_pat) \\                  # Notes Alist
(?:nil\\ *)+                     # Always nil as far as I can tell
\\]                              # Closing vector ]
END

########################################################################
# I added some ()s inside the patterns above, to make it possible to 
# break out the sub fields of a bbdb record.  Once consequence of this 
# is to make it very difficult to figure out at what position the top
# level fields are, so the subroutine _figure_out_indices does exactly
# that.  It uses the sample data below, and searches the fields that are 
# matched by the $bbdb_entry_pat pattern above.  The results are stored
# in the %field_index hash so we can reference them by name, and perhaps
# change the ()s in the patterns above without breaking everything.
########################################################################

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

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

  if ($notes) {
    my @notes;
    foreach $i (@$notes) {
      push @notes, "(" . $i->[0] . " . " . quoted_stringify($i->[1]) . ")";
    }
    push @result, "(@notes)";
  } else {
    push @result, 'nil';
  }
  return "[@result nil]";
}

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

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

}

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

sub part {
  my ($self,$name,$data) = @_;
  my $result;
  if ($name eq 'all') {
    $result = $self->{data};
    $self->{data} = $data if @_ == 3;
  } else {
    croak "No such field $name" unless exists $field_names{$name};
    $result = $self->{data}->[$field_names{$name}];
    $self->{data}->[$field_names{$name}] = $data if @_ == 3;
  }
  return $result;
}

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

sub note_names {
  my $self = shift;
  my $notes = $self->part('notes');
  return () unless @$notes;
  local ($_);
  my @fields = map { $_->[0] } @$notes;
  return @fields;
}

sub simple {
  my ($file,$bbdb) = @_;
  local ($_);
  if (@_ == 1) {		#we're reading
    open(INFILE,$file) or croak "Error opening file: $!";
    <INFILE>;
    $_ = <INFILE>; s/\(([^)])\)/$1/;
    #@extra_fields = split(/\s+/, $_);
    my $count = 0;
    my @results;
    while (<INFILE>) {
      print STDERR "Read: $_" if $BBDB::debug;
      $count++;
      chomp;
      #    print STDERR "$count ";
      $bbdb = new BBDB();
      if ($bbdb->decode($_)) {
	push @results,$bbdb;
      } else {
	print STDERR "No match at record $count in $file\nData = $_\n";
      }
    }
    close INFILE;
    return \@results;
  } else {                   # we're writing
    open(OUTFILE,">$file") or croak "Error opening file for writing: $!";
    my $rec;
    my ($notes,@notes,%notes);
    foreach $rec (@$bbdb) {
      @notes{note_names($rec)} = 1;
    }
    local($_);
    @notes = grep !/^(creation-date|timestamp|notes)$/, keys %notes;
    print OUTFILE ";;; file-version: 3\n";
    print OUTFILE ";;; user-fields: ";
    print OUTFILE "(",join(' ',@notes),")" if @notes;
    print OUTFILE "\n";
    foreach $rec (@$bbdb) {
      print OUTFILE $rec->encode,"\n";
    }
    close OUTFILE;
  }
}

1;

__END__

=head1 NAME

bbdb - Perl extension for reading and writing bbdb files

=head1 SYNOPSIS

  use BBDB;
  my $x = new BBDB();
  $x->decode($string);
  my $str = $x->encode();
  # At this point, subject to the BUGS below
  # $str is the same as $string

  my $allR = BBDB::simple('/home/henry/.bbdb');
  map { print $_->part('first')} @$allR;   # print out all the first names


=head1 DESCRIPTION


=head2 Data Format

The following is the data layout for a BBDB record.  I have created a
sample record with my own data.  Each field is just separated by a

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

       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