From: octo <octo>
Date: Fri, 6 May 2005 11:00:27 +0000 (+0000)
Subject: Added LiCoM::Group
X-Git-Tag: Release-0.3~11
X-Git-Url: https://git.verplant.org/?a=commitdiff_plain;h=17b661b0d5e8f9927a7f7785779ff15244dd0d52;p=licom.git

Added LiCoM::Group
---

diff --git a/lib/LiCoM/Group.pm b/lib/LiCoM/Group.pm
new file mode 100644
index 0000000..f7bd00d
--- /dev/null
+++ b/lib/LiCoM/Group.pm
@@ -0,0 +1,291 @@
+package LiCoM::Group;
+
+use strict;
+use warnings;
+
+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'}        = $entry->get_value ('cn', asref => 0);
+	$obj->{'description'} = $entry->get_value ('description', asref => 0);
+	$obj->{'members'}     = [map { m/cn=([^,]+)/i; $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 with a member named I<$cn>.
+
+=cut
+
+sub load
+{
+	my $pkg = shift;
+	my $name = shift;
+	my $member_dn = 'cn=' . $name . ',' . $Config{'base_dn'};
+	my @retval = ();
+
+	my $mesg = $Ldap->search
+	(
+		base	=> $Config{'base_dn'},
+		filter	=> "(&(objectClass=groupOfNames)(|(cn=$name)(member=$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<@members>)
+
+Creates and returns a new group. At least one member has to be given to meet
+LDAP requirements.
+
+=cut
+
+sub create ($$$@)
+{
+	my $pkg = shift;
+	my $name = shift;
+	my $desc = shift;
+	my @members = @_;
+	my $dn = "cn=$name," . $Config{'base_dn'};
+
+	my $entry = Net::LDAP::Entry->new ();
+
+	$entry->add (objectClass => [qw(top groupOfNames)]);
+	$entry->add (cn => $name);
+	$entry->add (member => [map { $_->get ('dn') } (@members)]);
+	$entry->add (description => $desc);
+	$entry->dn ($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	=> $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);
+	}
+}
+
+sub _update_members
+{
+	my $obj = shift;
+	my $entry = $obj->{'ldap'};
+	my @tmp = map { 'cn=' . $_ . ',' . $Config{'base_dn'} } (@{$obj->{'members'}});
+
+	$entry->changetype ('modify');
+	$entry->replace (member => \@tmp);
+	$entry->update ($Ldap);
+}
+
+=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;
+
+		$entry->changetype ('modify');
+		$entry->replace (cn => $obj->{'name'});
+		$entry->update ($Ldap);
+		$entry->dn ('cn=' . $obj->{'name'} . ',' . $Config{'base_dn'});
+		$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 => $obj->{'description'});
+		$entry->update ($Ldap);
+	}
+
+	return ($obj->{'description'});
+}
+
+
+=back
+
+=head1 AUTHOR
+
+Florian octo Forster E<lt>octo at verplant.orgE<gt>
+
+=cut