view release on metacpan or  search on metacpan

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

sub nil_or_list {                    # return nil if empty string
  return 'nil' if $_[0] eq '';       # otherwise quote it and add ()s
  return '(' . quoted_stringify(@_) . ')' ;
}

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

sub encode {
  my $self = shift;
  my ($first, $last, $aka, $company, 
      $phone, $address, $net, $notes) = @{$self->{'data'}};
  my ($i,@result,$s);
  push @result,nil_or_string($first);
  push @result,nil_or_string($last);

  if (@$aka) {
    my @aka;
    foreach $i (@$aka) {
      push @aka, quoted_stringify($i);
    }
    push @result, "(@aka)";
  } else {
    push @result, 'nil';
  }

  push @result,nil_or_string($company);

  if (@$phone) {
    my @phone;
    foreach $i (@$phone) {
      my $number;
      if ( $i->[1] =~ m/^\D?(\d{3})\D(\d{3})\D+(\d{4})\D?(\d*)$/ ) {
	$number = "$1 $2 $3 ";
	$number .= $4 ? $4 : '0';
      } else {
	$number = quoted_stringify($i->[1]);
      }
      push @phone,"[" . quoted_stringify($i->[0]) . " $number]";
      ;
    }
    push @result, "(@phone)";
  } else {
    push @result, 'nil';
  }
  if (@$address) {
    my @address;
    foreach $i (@$address) {
      my $zip = $i->[6];
      if ($zip =~ m/^(\d{5})\D?(\d{4})?$/) {
	$zip = $1;
	if ($2) {
	  $zip = "($zip $2)";
	}
      } elsif ($zip =~ m/^(\S+) (\S+)$/) {
	$zip = "(\"$1\" \"$2\")";
      } else {
	$zip = quoted_stringify($zip);
      }
      local($_);
      my @fields = map {quoted_stringify($_)} @$i[0..5];
      push @address, "[@fields $zip]";
    }
    push @result, "(@address)";
  } else {
    push @result, 'nil';
  }

  if (@$net) {
    my @net;
    foreach $i (@$net) {
      push @net, quoted_stringify($i);
    }
    push @result, "(@net)";
  } else {
    push @result, 'nil';
  }

  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
space.  I have added comments to the right

 ["Henry"                             The first name - a string
 "Laxen"                              The last name - a string
 ("Henry, Enrique")                   Also Known As - comma separated list
 "Elegant Solution"                   Business name - a string
 (["home" 415 789 1159 0]             Phone number field - US style
  ["fax" 415 789 1156 0]              Phone number field - US style
  ["mazatlan" "011-5269-164195"]      Phone number field - International style
 )
 (["mailing" "PMB 141"                Address field - There are 3 fields for
   "524 San Anselmo Ave." ""           for the street address, then one each
   "San Anselmo" "CA" (94960 2614)"     for City, State, and Zip Code
  ]
  ["mazatlan" "Reino de Navarra #757" Address field - Note that there is no
   "Frac. El Cid" ""                   field for Country.  That is unfortunate
   "Mazatlan" "Sinaloa, Mexico"        The zip code field is quoted if its
   ("CP" "82110")                      not an integer
  ]
  )
 ("nadine.and.henry@pobox.com"        The net addresses - a list of strings
  "maztravel@maztravel.com")
 ((creation-date . "1999-09-02")      The notes field - a list of alists
  (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: