package LiCoM::Group;

use strict;
use warnings;

use Encode (qw(encode decode));

use LiCoM::Config (qw(get_config));
use LiCoM::Connection (qw($Ldap));
use Net::LDAP;
use Net::LDAP::Filter;

=head1 NAME

LiCoM::Group - High level group management.

=cut

return (1);

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

	$obj->{'name'}        = decode ('utf-8', $entry->get_value ('cn', asref => 0));
	$obj->{'description'} = decode ('utf-8', $entry->get_value ('description', asref => 0));
	$obj->{'members'}     = [map { m/cn=([^,]+)/i; decode ('utf-8', $1); } ($entry->get_value ('member', asref => 0))];
	$obj->{'ldap'}        = $entry;

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

=head1 STATIC FUNCTIONS

=item LiCoM::Group-E<gt>B<load> (I<$cn>)

Loads and returns the group named I<$cn> or all groups with a member named
I<$cn>.

=cut

sub load
{
	my $pkg = shift;
	my $name = shift;
	my $obj;

	my $mesg = $Ldap->search
	(
		base	=> 'ou=Group,' . get_config ('base_dn'),
		filter	=> "(&(objectClass=groupOfNames)(cn=$name))"
	);

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

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

	return ($obj);
}

sub load_by_member
{
	my $pkg = shift;
	my $cn = shift;
	my $dn = _cn_to_dn ($cn);
	my @retval = ();

	my $mesg = $Ldap->search
	(
		base	=> 'ou=Group,' . get_config ('base_dn'),
		filter	=> "(&(objectClass=groupOfNames)(member=$dn))"
	);

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

	for ($mesg->entries ())
	{
		my $entry = $_;
		push (@retval, new ($pkg, $entry));
	}

	return (@retval);
}


=item LiCoM::Group-E<gt>B<create> (I<$name>, I<$description>, I<@member_cns>)

Creates and returns a new group. At least one member has to be given to meet
LDAP requirements. I<@members> is an array of CNs.

=cut

sub create ($$$@)
{
	my $pkg = shift;
	my $name = shift;
	my $desc = shift;
	my @members = @_;
	my $dn = _cn_to_dn ($name);
	my $ou = 'Group';

	my $entry = Net::LDAP::Entry->new ();

	$entry->add (objectClass => [map { encode ('UTF-8', $_) } (qw(top groupOfNames))]);
	$entry->add (ou => encode ('UTF-8', $ou));
	$entry->add (cn => encode ('UTF-8', $name));
	$entry->add (member => [map { encode ('UTF-8', _cn_to_dn ($_)) } (@members)]);
	$entry->add (description => encode ('UTF-8', $desc)) if ($desc);
	$entry->dn (encode ('UTF-8', $dn));

	$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 LiCoM::Group-E<gt>B<all> ()

Returns all group-objects found in the database.

=cut

sub all
{
	my $pkg = shift;
	my @retval = ();

	my $mesg = $Ldap->search
	(
		base	=> 'ou=Group,' . get_config ('base_dn'),
		filter	=> "(objectClass=groupOfNames)"
	);

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

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

		push (@retval, $group);
	}

	return (@retval);
}

=back

=head1 METHODS

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

Deletes the group.

=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<get_members> ()

Returns a list of all members.

=cut

sub get_members
{
	my $obj = shift;
	return (@{$obj->{'members'}});
}

=item I<$obj>-E<gt>B<add_members> (I<@cn>)

Adds the given I<@cn>s to the group, if they aren't already in the group.

=cut

sub add_members
{
	my $obj = shift;
	my $entry = $obj->{'ldap'};
	my @new = @_;
	my @tmp;

	for (@new)
	{
		my $n = $_;
		if (!grep { $_ eq $n } (@{$obj->{'members'}}))
		{
			push (@{$obj->{'members'}}, $n);
		}
	}

	_update_members ($obj);
}

=item I<$obj>-E<gt>B<del_members> (I<@cn>)

Deletes the given I<@cn>s from the group. Automatically deletes the group if no
members are left (to meet LDAP-standards, mostly..).

=cut

sub del_members
{
	my $obj = shift;
	my $entry = $obj->{'ldap'};
	my @del = @_;

	for (@del)
	{
		my $d = $_;
		@{$obj->{'members'}} = grep { $d ne $_ } (@{$obj->{'members'}});
	}

	if (@{$obj->{'members'}})
	{
		_update_members ($obj);
	}
	else
	{
		LiCoM::Group::delete ($obj);
	}
}

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

Sets the name if given. Returns the (new) name.

=cut

sub name
{
	my $obj = shift;

	if (@_)
	{
		my $entry = $obj->{'ldap'};
		$obj->{'name'} = shift;

		# FIXME
		$entry->changetype ('modify');
		$entry->replace (cn => $obj->{'name'});
		$entry->update ($Ldap);
		$entry->dn (_cn_to_dn ($obj->{'name'}));
		$entry->update ($Ldap);
	}

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

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

Sets the description if given. Returns the (new) description.

=cut

sub description
{
	my $obj = shift;

	if (@_)
	{
		my $entry = $obj->{'ldap'};
		$obj->{'description'} = shift;

		$entry->changetype ('modify');
		$entry->replace (description => [encode ('UTF-8', $obj->{'description'})]);
		$entry->update ($Ldap);
	}

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

sub _cn_to_dn
{
	my $cn = shift;
	my $base_dn = get_config ('base_dn') or die;

	return ('cn=' . $cn . ',ou=Group,' . $base_dn);
}

sub _update_members
{
	my $obj = shift;
	my $entry = $obj->{'ldap'};
	my @tmp = map { _cn_to_dn ($_); } (@{$obj->{'members'}});

	$_ = encode ('UTF-8', $_) for (@tmp);

	$entry->changetype ('modify');
	$entry->replace (member => \@tmp);
	$entry->update ($Ldap);
}

=back

=head1 AUTHOR

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

=cut
