package AddressBook::DB::LDAP;

=head1 NAME

AddressBook::DB::LDAP - Backend for AddressBook to use LDAP.

=head1 SYNOPSIS

  use AddressBook;
  $a = AddressBook->new(source => "LDAP:hostname/ou=People,dc=example,dc=com",
                        username => "user", password => "pass");
  $a->add($entry) || die $a->code;

=head1 DESCRIPTION

The Net::LDAP library module is required in order to use this package.

AddressBook::DB::LDAP supports random access backend database methods.

Behavior can be modified using the following options:

=over 4

=item key_fields

A list of LDAP attribute names (not cannonical names) which can be used to
uniquely identify an entry.

=item hostname

The LDAP host to which to connect.

=item base

The base for LDAP queries.

=item objectclass

The objectclass for AddressBook entries.

=item username

An LDAP dn to use for accessing the server.

=item password

=item dn_calculate

A perl expression which, when eval'd returns a valid LDAP "dn" 
(omitting the "base" part of the dn).  Other attributes may be referenced as "$<attr>".  

For example, if LDAP entries have a dn like: "cn=John Doe,mail=jdoe@mail.com", then use
the following:

  dn_calculate="'cn=' . $cn . ',mail=' . $mail"

=back

Any of these options may be specified in the constructor, or in the configuration file.

=cut

use strict;
use Net::LDAP;
use Net::LDAP::Util qw(ldap_error_text);
use AddressBook;
use Date::Manip;
use Carp;
use vars qw(@ISA $VERSION);

$VERSION = '0.13';

@ISA = qw(AddressBook);

=head2 new

  $a = AddressBook->new(source => "LDAP");
  $a = AddressBook->new(source => "LDAP:localhost/ou=People,dc=example,dc=com");
  $a = AddressBook->new(source => "LDAP",
			hostname=>"localhost",
			base=>"o=test"
			);

Any or all options may be specified in the constructor, or in the configuration file.

=cut

sub new {
  my $class = shift;
  my $self = {};
  bless ($self,$class);
  my %args = @_;
  foreach (keys %args) {
    $self->{$_} = $args{$_};
  }
  my ($hostname,$base,$mesg);
  if ($self->{dsn}) {
    ($hostname,$base) = split "/", $self->{dsn};
  }
  $self->{hostname} = $hostname || $self->{hostname};
  $self->{base} = $base || $self->{base};
  $self->{ldap} = Net::LDAP->new($self->{hostname}, async => 1 || croak $@);
  unless ($self->{anonymous}) {
    $mesg = $self->{ldap}->bind($self->{username}, password => $self->{password});
  } else {
    $mesg = $self->{ldap}->bind;
  }
  if ($mesg->is_error) {
    croak "could not bind to LDAP server: " . $mesg->error;
  }
  return $self;
}

sub search {
  my $self = shift;
  my $class = ref $self || croak "Not a method call.";
  my @ret;
  my %arg = @_;
  my $max_size = $arg{entries} || 0;
  my $max_time = $arg{time} || 0;
  my $fuzzy = $arg{fuzzy} || 0;
  if (exists $arg{strict}) {
    warn "The 'strict' parameter to LDAP backend searches has been removed";
  } 
  delete $arg{entries};
  delete $arg{time};

  if(defined $arg{filter}) {
    # We have stuff to look for;
    if (ref($arg{filter}) ne "ARRAY") {$arg{filter} = [$arg{filter}]}
    my $evalstring = "=";
    my ($entry,$filter,$filter_element,$subfilter,$value);
    foreach $filter_element (@{$arg{filter}}) {
      $entry = AddressBook::Entry->new(attr=>$filter_element,
				       config => $self->{config},
				       );
      #$entry->calculate;
      $entry = $entry->get(db=>$self->{db_name},values_only=>'1');
      $subfilter="";
      foreach (keys %{$entry}) { 
	$value = $entry->{$_}->[0];
	$value =~ s/\(/\\(/g;
	$value =~ s/\)/\\)/g;
        if ($fuzzy) {
	  $value = "*" . $value . "*";
	}
	$subfilter .= "(" . $_ . $evalstring . $value . ")";
      }
      $filter .= "(& $subfilter)";
    }
    $filter = "(| $filter)";
    $self->{so} = $self->{ldap}->search(base => $self->{base} || '',
				      async => 1,
				      sizelimit => $max_size,
				      timelimit => $max_time,
				      filter => "(&(objectclass=" .
				      $self->{objectclass} .')' .
				      $filter . ')');
    if ($self->{so}->code) {
      $self->{code} = ldap_error_text($self->{so}->code); 
      return 0;
    }
  } else {
    # We need to return everything;
    $self->{so} = $self->{ldap}->search(base => $self->{base} || '',
				      async => 1,
				      filter => "objectclass=" . $self->{objectclass});
    if ($self->{so}->code) {
      $self->{code} = ldap_error_text($self->{so}->code) ;
      return 0;
    }
  }
  undef $self->{code};
  return $self->{so}->count;
}

sub read {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  if (! defined $self->{so}) {
    $self->reset;  
  } 
  if (defined (my $entry = $self->{so}->shift_entry)) {
    my $attr;
    my $ret = AddressBook::Entry->new(config=>$self->{config});
    foreach $attr ($entry->attributes) {
      if (exists $self->{config}->{db2generic}->{$self->{db_name}}->{$attr}) {
	$ret->add(db=>$self->{db_name},attr=>{$attr=>[$entry->get_value($attr)]});
      }
    }
    $ret->{timestamp} = _get_timestamp($entry);
    undef $self->{code};
    return $ret;
  } else {
    $self->{code} = ldap_error_text($self->{so}->code) ;
    return undef;
  }
}

sub _get_timestamp {
  my $entry=shift;
  my $timestamp;
  if ($entry->exists("modifytimestamp")) {
    ($timestamp) = $entry->get_value("modifytimestamp");
  } elsif ($entry->exists("createtimestamp")) {
    ($timestamp) =  $entry->get_value("createtimestamp");
  } else {
    $timestamp="today";
  }
  return ParseDate($timestamp);
}

sub reset {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  $self->search;
}

sub update {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my %args = @_;
  my $count = $self->search(filter=>$args{filter});
  if ($count == 0){
    $self->{code} = "Update Error: filter did not match any entries";
    return 0;
  } elsif ($count > 1) {
    $self->{code} = "Update Error: filter matched multiple entries";
    return 0;
  }
  my $entry = $args{entry};
  $entry->calculate;
  my $old_entry=$self->read;
  my $rdn = $self->_rdn_from_entry($entry);
  my $old_rdn = $self->_rdn_from_entry($old_entry);
  my $result;
  if ($rdn ne $old_rdn) {
    $result=$self->{ldap}->moddn("$old_rdn," . $self->{base},deleteoldrdn=>1,newrdn=>$rdn);
    if ($result->code) {
      $self->{code} =  ldap_error_text($result->code) ;
      return 0;
    }
  }
  my %attr = %{$entry->get(db=>$self->{db_name},values_only=>'1')};
  $result=$self->{ldap}->modify("$rdn," . $self->{base},replace=>[%attr]);
  if ($result->code) {
    $self->{code} =  ldap_error_text($result->code) ;
    return 0;
  }
  undef $self->{code};
  return 1;
}

sub add {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $entry = shift;
  $entry->calculate;
  my $dn = $self->_rdn_from_entry($entry) . "," . $self->{base};
  my %attr = %{$entry->get(db=>$self->{db_name},values_only=>'1')};
  $attr{objectclass} = [$self->{objectclass}];
  my $result = $self->{ldap}->add($dn, attrs => [%attr]);
  if ($result->code) {
    $self->{code} =  ldap_error_text($result->code) ;
    return 0;
  }
  undef $self->{code};
  return 1;
}

sub write {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  return $self->add(@_);
}

sub delete {
  my $self = shift;
  my $class = ref $self || croak "Not a method call.";
  my $entry=shift;
  $entry->calculate;
  my $dn = $self->_rdn_from_entry($entry) . "," . $self->{base};
  my $result = $self->{ldap}->delete($dn);
  if ($result->code) {
    $self->{code} = ldap_error_text($result->code) ;
    return 0;
  }
  undef $self->{code};
  return 1;
}

sub code {
  my $self = shift;
  my $class = ref $self || croak "Not a method call.";
  return $self->{code};
}

sub _rdn_from_entry {
  my $self = shift;
  my $class = ref $self || croak "Not a method call";
  my $entry = shift || croak "Need an entry";
  my ($dn,$dn_calculate);
  my %attr = %{$entry->get(db=>$self->{db_name},values_only=>'1')};
  ($dn_calculate=$self->{dn_calculate}) =~ s/\$(\w*)/\$attr{$1}->[0]/g;
  eval qq{\$dn = $dn_calculate}; warn "Syntax error in dn_calculate: $@" if $@;
  return $dn;
}

1;
__END__

=head2 Timestamps

For syncronization purposes, all records are timestamped using the "modifytimestamp"
LDAP attribute.  If the record has no "modifytimestamp", "createtimestamp" is used.
If there is no "createtimestamp", the current time is used.

=head1 AUTHOR

Mark A. Hershberger, <mah@everybody.org>
David L. Leigh, <dleigh@sameasiteverwas.net>

=head1 SEE ALSO

L<AddressBook>,
L<AddressBook::Config>,
L<AddressBook::Entry>.

Net::LDAP

=cut