package LiCoM::Person;

use strict;
use warnings;

use Net::LDAP;
use Net::LDAP::Filter;

=head1 NAME

Person - High level interface for address books using an LDAP-backend.

=cut

our %Config =
(
	base_dn		=> undef
);

our %ValidFields =
(
	telephoneNumber			=> 1,
	facsimileTelephoneNumber	=> 1,
	sn				=> 0,
	cn				=> 0,
	givenName			=> 0,
	homePhone			=> 1,
	homePostalAddress		=> 1,
	labeledURI			=> 1,
	mail				=> 1,
	mobile				=> 1,
	o				=> 1,
	userPassword			=> 0
);

our %ExternalNames =
(
	officephone	=> 'telephoneNumber',
	fax		=> 'facsimileTelephoneNumber',
	lastname	=> 'sn',
	name		=> 'cn',
	firstname	=> 'givenName',
	homephone	=> 'homePhone',
	address		=> 'homePostalAddress',
	uri		=> 'labeledURI',
	mail		=> 'mail',
	cellphone	=> 'mobile',
	group		=> 'o',
	password	=> 'userPassword'
);

our $Ldap;

return (1);

=head1 METHODS

=over 4

=item Person-E<gt>B<connect> (I<$server>, I<$bind_dn>, I<$password>, I<$base_dn>, [I<$port>])

Connects to the LDAP-Server given.

=cut

sub connect
{
	my $pkg = shift;
	my %opts = @_;

	my $bind_dn = $opts{'bind_dn'};
	my $base_dn = $opts{'base_dn'};
	my $uri     = $opts{'uri'};
	my $passwd  = $opts{'password'};

	my $msg;

	$Ldap = Net::LDAP->new ($uri);

	$msg = $Ldap->bind ($bind_dn, password => $passwd);
	if ($msg->is_error ())
	{
		warn ('LDAP bind failed: ' . $msg->error_text ());
		return (0);
	}

	$Config{'base_dn'} = $base_dn;

	return (1);
}

=item Person-E<gt>B<disconnect> ()

Disconnect from the LDAP-Server.

=cut

sub disconnect
{
	$Ldap->unbind ();
	$Ldap = undef;
}

=item Person-E<gt>B<new> (I<$ldap_entry>)

Created a new I<Person>-object from the passed I<Net::LDAP::Entry>-object.

=cut

sub new
{
	my $pkg = shift;
	my $entry = shift;
	my $obj = {};

	$obj->{'dn'} = $entry->dn ();
	$obj->{'ldap'} = $entry;

	for (keys %ValidFields)
	{
		my $key = $_;
		$obj->{$key} = $entry->get_value ($key, asref => $ValidFields{$key});
	}

	return (bless ($obj, $pkg));
}

=item Person-E<gt>B<load> (I<$cn>)

Loads the given CN and returns the B<Person>-object.

=cut

sub load
{
	my $pkg = shift;
	my $cn = shift;

	my ($retval) = search ($pkg, [[cn => $cn]]);

	if (!$retval)
	{
		warn ("CN '$cn' could not be found");
		return (undef);
	}
	
	return ($retval);
}

=item Person-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)

Create a new I<Net::LDAP::Entry>-object and return it's corresponding
I<Person>-object.

=cut

sub create
{
	my $pkg = shift;

	my %hash = @_;
	my $entry = Net::LDAP::Entry->new ();
	my $dn;
	my $ou;

	$entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]);

	for (keys %hash)
	{
		my $key = $_;
		my $val = $hash{$key};
		my $field = defined ($ExternalNames{$key}) ? $ExternalNames{$key} : $key;
		
		if (!defined ($ValidFields{$field}))
		{
			warn ("Invalid field $field");
			next;
		}

		if ($ValidFields{$field})
		{
			if (ref ($val) eq 'ARRAY')
			{
				$entry->add ($field => [@$val]) if (@$val);
			}
			elsif (!ref ($val))
			{
				$entry->add ($field => [$val]) if ($val);
			}
			else
			{
				warn ("You cannot pass ref-type " . ref ($val));
			}
		}
		else
		{
			my $temp;
			if (ref ($val) eq 'ARRAY')
			{
				$temp = $val->[0];
			}
			elsif (!ref ($val))
			{
				$temp = $val;
			}
			else
			{
				warn ("You cannot pass ref-type " . ref ($val));
			}

			$entry->add ($field => $val) if (defined ($val) and $val);
		}
	}

	my $sn = $entry->get_value ('sn');
	my $gn = $entry->get_value ('givenName');

	if (!defined ($sn) or !defined ($gn))
	{
		warn ("sn or givenName not given");
		return (undef);
	}

	$dn = "cn=$sn $gn," . $Config{'base_dn'};
	($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i;
	
	$entry->add (cn => "$sn $gn", ou => $ou);
	$entry->dn ($dn);

	print "<!--\n";
	$entry->dump (*STDOUT);
	print "-->\n";

	$entry->changetype ('add');
	my $mesg = $entry->update ($Ldap);

	if ($mesg->is_error ())
	{
		warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
		return (undef);
	}

	return (new ($pkg, $entry));
}

=item Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)

Search for the given patterns. Returns a list of I<Person>-objects.

  @filter =
  (
    [
      [field => value], # OR
      [field => value]
    ], # AND
    ...
  );

=cut

sub search
{
	my $pkg = shift;

	my @patterns = @_;
	my @konjunct = ();
	my $filter;

	my $mesg;
	my @retval = ();

	for (@patterns)
	{
		my $dj = $_;
		my @disjunc = ();

		for (@$dj)
		{
			my $field = $_->[0];
			my $value = $_->[1];

			$field = $ExternalNames{$field} if (defined ($ExternalNames{$field}));
			if (!defined ($ValidFields{$field}))
			{
				warn ("Not a valid field: $field");
				next;
			}

			$value =~ s/([\(\)\\])/\\$1/g;

			push (@disjunc, "($field=$value)");
		}
			
		if (@disjunc)
		{
			my $tmp;
			if (scalar (@disjunc) == 1)
			{
				$tmp = $disjunc[0];
			}
			else
			{
				$tmp = join ('', '(|', @disjunc, ')');
			}
			push (@konjunct, $tmp);
		}
	}

	if (@konjunct)
	{
		$filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')');
	}
	else
	{
		$filter = '(objectclass=inetOrgPerson)';
	}

	#print STDERR "Debug: using filter: $filter";
	
	$mesg = $Ldap->search
	(
		base   => $Config{'base_dn'},
		filter => $filter
	);

	if ($mesg->is_error ())
	{
		warn ("Error while querying LDAP server: " . $mesg->error_text ());
		return (qw());
	}

	for ($mesg->entries ())
	{
		my $entry = $_;
		my $obj = new ($pkg, $entry);

		push (@retval, $obj);
	}

	return (@retval);
}

=item I<$obj>-E<gt>B<delete> ()

Deletes the record.

=cut

sub delete
{
	my $obj = shift;
	my $entry = $obj->{'ldap'};

	$entry->changetype ('delete');
	$entry->delete ();
	$entry->update ($Ldap);

	%$obj = ();
}

=item I<$obj>-E<gt>B<lastname> ([I<$lastname>])

Get or set the lastname.

=cut

sub _update_dn
{
	my $obj = shift;
	my $entry = $obj->{'ldap'};
	my $sn = $obj->{'sn'};
	my $gn = $obj->{'givenName'};
	my $cn = "$sn $gn";
	my $dn = "cn=$cn," . $Config{'base_dn'};

	$obj->{'cn'} = $cn;

	print STDERR "This is _update_dn, trying to set dn=$dn";

	$entry->changetype ('modify');
	$entry->replace (sn => $sn, givenName => $gn, cn => $cn);
	$entry->update ($Ldap);
	$entry->dn ($dn);
	$entry->update ($Ldap);
}

sub lastname
{
	my $obj = shift;

	if (@_)
	{
		$obj->{'sn'} = shift;
		_update_dn ($obj);
	}

	return ($obj->{'sn'});
}

=item I<$obj>-E<gt>B<firstname> ([I<$firstname>])

Get or set the firstname.

=cut

sub firstname
{
	my $obj = shift;

	if (@_)
	{
		$obj->{'givenName'} = shift;
		_update_dn ($obj);
	}

	return ($obj->{'givenName'});
}

=item I<$obj>-E<gt>B<name> ()

Returns the CN.

=cut

sub name
{
	my $obj = shift;
	return ($obj->{'cn'});
}

=item I<$obj>-E<gt>B<address> ([I<@address>])

=item I<$obj>-E<gt>B<homephone> ([I<@homephone>])

=item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])

=item I<$obj>-E<gt>B<officephone> ([I<@officephone>])

=item I<$obj>-E<gt>B<fax> ([I<@fax>])

=item I<$obj>-E<gt>B<mail> ([I<@mail>])

=item I<$obj>-E<gt>B<uri> ([I<@uri>])

=item I<$obj>-E<gt>B<group> ([I<@groups>])

Get or set the attribute. This is the same as calling S<I<$obj>-E<gt>B<set>
(I<$field>, I<\@values>)> or S<I<$obj>-E<gt>B<get> (I<$field>)>.

=cut

sub AUTOLOAD
{
	my $obj = shift;
	my @values = @_;
	my $field = $Person::AUTOLOAD;

	return (undef) unless ($field);
	
	$field =~ s/.*:://;

	return (set ($obj, $field, @values ? [@values] : undef))
}

=item I<$obj>-E<gt>B<get> (I<$field>)

Returs the value(s) of field I<$field>.

=cut

sub get
{
	my $obj = shift;
	my $field = shift;

	if (wantarray ())
	{
		return (set ($obj, $field, undef));
	}
	else
	{
		return (scalar (set ($obj, $field, undef)));
	}
}

=item I<$obj>-E<gt>B<set> (I<$field>, I<\@values>)

Sets the field I<$field> to the value(s) I<\@valued>. Pass an empty array-ref
to delete the field.

=cut

sub set
{
	my $obj = shift;
	my $field = shift;
	my $value = @_ ? shift : undef;
	my $entry = $obj->{'ldap'};
	
	if (defined ($ExternalNames{$field}))
	{
		$field = $ExternalNames{$field};
	}
	if (!defined ($ValidFields{$field}))
	{
		return (undef);
	}

	if (defined ($value))
	{
		$entry->changetype ('modify');

		if ($ValidFields{$field})
		{
			$entry->replace ($field, [@$value]);
			$obj->{$field} = $value;
		}
		else
		{
			splice (@$value, 1) if (scalar (@$value) > 1);
			$entry->replace ($field, $value);
			$obj->{$field} = $value->[0];
		}

		$entry->update ($Ldap);
	}

	$obj->{$field} = [] unless (defined ($obj->{$field}));
	
	if (wantarray () and $ValidFields{$field})
	{
		return (@{$obj->{$field}});
	}
	else
	{
		return ($obj->{$field});
	}
}

sub get_user
{
	my $pkg = shift;
	my $dn = shift;
	my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;

	die unless ($search);
	
	my $cn = '';
	my $id = '';

	my $mesg = $Ldap->search
	(
		base   => $Config{'base_dn'},
		filter => "(cn=$search)"
	);

	if ($mesg->is_error ())
	{
		warn ("Error while querying LDAP server: " . $mesg->error_text ());
		return ('');
	}

	for ($mesg->entries ())
	{
		my $e = $_;
		my ($t_cn) = $e->get_value ('cn', asref => 0);
		my ($t_id) = $e->get_value ('uid', asref => 0);

		if (!$id or $t_id)
		{
			$cn = $t_cn;
			$id = $t_id;
		}
	}

	return ($cn, $id);
}

=back

=head1 AUTHOR

Florian octo Forster E<lt>octo at verplant.orgE<gt>

=cut
