Added LiCoM::Group

diff --git a/lib/LiCoM/Group.pm b/lib/LiCoM/Group.pm
new file mode 100644 (file)
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