AddressBook

 view release on metacpan or  search on metacpan

ChangeLog  view on Meta::CPAN

      - LDIF: add, read, reset, truncate
      - Text: add
      - DBI: search, add, truncate
      - HTML: show 
    - Internally, I moved all knowledge of the field name translations to the Entry
      object.  Instead of backend having to do forward and reverse field name
      lookups in the configuration hashes, now they can request an attribute hash
      with the appropriate key names from the Entry object.  In other words,
      $entry->get(db=>LDAP) returns a hash whose keys are those defined for the
      LDAP backend.  This ended up making backend functions much easier to write &
      debug.

0.01  8/13/2000
   - original version; created by h2xs 1.19

examples/abook.palm  view on Meta::CPAN

use AddressBook;

$ldap=AddressBook->new(source => "LDAP:localhost"
		       ) || die;

$pilot=AddressBook->new(source => "PDB",
			port=>"/dev/pilot",
		        config=>$ldap->{config},	
			);

AddressBook::sync(master=>$ldap,slave=>$pilot,debug=>1);

lib/AddressBook.pm  view on Meta::CPAN

    $self->{db_name}=$type;
  } else {
    bless ($self,$class);
  }
  return $self;
}

=head2 sync

  AddressBook::sync(master=>$master_db, slave=>$slave_db)
  AddressBook::sync(master=>$master_db, slave=>$slave_db,debug=>1)

Synchronizes the "master" and "slave" databases.  The "master" database type must be
one that supports random-access methods.  The "slave" database type must
be one that supports sequential-access methods.

When the 'debug' option is true, debug messages will be printed to stdout.  The 
msg_function paramater, if included, should be a subroutine reference which will
be called with a status message is the argument.

=over 4

=item 1

For each record in the slave, look for a corresponding record in the master, using
the key_fields of each.

lib/AddressBook.pm  view on Meta::CPAN

  foreach ($slave->get_cannonical_attribute_names) {
    push (@slave_only,$_) unless exists $seen{$_};
  }
  while ($entry = $slave->read) {
    $filter = AddressBook::Entry->new(config=>$slave->{config},
                                      attr=>$entry->{attr});
    $filter->delete(attrs=>\@non_keys,db=>$slave->{db_name});
    $count = $master->search(filter=>$filter->{attr});
    $msg = join "\n", $filter->dump;
    $msg .= "matched: $count\n";
    if ($args{debug}) {print $msg}
    if ($args{msg_function}) {&{$args{msg_function}}($msg)}
    if ($count == 1) {
      $master_entry = $master->read;
      $master_tmp = $master_entry;
      $master_tmp->delete(attrs=>\@master_only);
      $slave_tmp = $entry;
      $slave_tmp->delete(attrs=>\@slave_only);
      if (AddressBook::Entry::compare($slave_tmp,$master_tmp)) {
	$msg = "**entries match**\n";
	if ($args{debug}) {print $msg}
	if ($args{msg_function}) {&{$args{msg_function}}($msg)}
      } else {
	$msg = "slave entry timestamp: " . $entry->{timestamp} . "\n";
	$msg .= "master entry timestamp: " . $master_entry->{timestamp} . "\n";
	if ($args{debug}) {print $msg}
	if ($args{msg_function}) {&{$args{msg_function}}($msg)}
	$flag = Date_Cmp($entry->{timestamp},$master_entry->{timestamp});
	if ($flag < 0) {
	  $msg = "**master is newer**\n";
	  if ($args{debug}) {print $msg}
	  if ($args{msg_function}) {&{$args{msg_function}}($msg)}
	} else {
	  $msg = "**slave is newer - updating master**\n";
	  if ($args{debug}) {print $msg}
	  if ($args{msg_function}) {&{$args{msg_function}}($msg)}
	  $slave_entry_attrs = $entry->get(values_only=>1);
	  $master_entry->replace(attr=>$slave_entry_attrs);
	  $master->update(entry=>$master_entry,filter=>$filter->{attr}) || croak $master->code;
	}
      }
    } elsif ($count == 0) {
      $msg = "**Entry not found in master - adding**:\n".$entry->dump."\n";
      if ($args{debug}) {print $msg}
      if ($args{msg_function}) {&{$args{msg_function}}($msg)}
      $master->add($entry) || croak $master->code;;
    } else {croak "Error: entry matched multiple entries in master!\n"}
  }
  $msg = "Truncating slave\n";
  if ($args{debug}) {print $msg}
  if ($args{msg_function}) {&{$args{msg_function}}($msg)}
  $slave->truncate;
  $master->reset;
  $msg = "Adding master's records to slave\n";
  if ($args{debug}) {print $msg}
  if ($args{msg_function}) {&{$args{msg_function}}($msg)}
  while ($entry = $master->read) {
    $slave->write($entry);
  }
}

=head2 search

  $abook->search(attr=>\%filter);
  while ($entry=$abook->read) {

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

  $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' ],

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

  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";
      }
    }

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

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

lib/AddressBook/Entry.pm  view on Meta::CPAN

    }
  }
  $self->delete(attrs=>\@delete_list);
}

=head2 dump

    print $entry->dump

Returns the (cannonical) attribute names and values.  Primarily used for 
debugging purposes.

=cut

sub dump {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  return map {"$_ -> ". join(", ", @{$self->{attr}->{$_}}). "\n"}
    keys %{$self->{attr}}
}
1;

t/04-ldif-sync-csv.t  view on Meta::CPAN

$entry=AddressBook::Entry->new( config=>$labook->{config},
	  			   attr=>{
					  fullname=>"user one",
					  email => "user1\@one.mail.net",
				         },
			         ) || die;

$cabook->update(entry=>$entry,filter=>{fullname=>"user one"})||die;

AddressBook::sync(master=>$cabook,slave=>$new_labook,debug=>1);

print "not " unless 1;
print "ok 1\n";
$result=1;