X-Git-Url: https://git.octo.it/?a=blobdiff_plain;f=lib%2FLiCoM%2FPerson.pm;h=3c43a4b89a1bb2a85a1b7febb455648181e7a974;hb=89c58aa0c99bc2fd168fda98891ac2962ff16c94;hp=d51ad28a9297519a7a5aa459683cf365b0d3a0ab;hpb=fb2741ec9a3da3376994f3f70f8d0c17bbe70931;p=licom.git diff --git a/lib/LiCoM/Person.pm b/lib/LiCoM/Person.pm index d51ad28..3c43a4b 100644 --- a/lib/LiCoM/Person.pm +++ b/lib/LiCoM/Person.pm @@ -3,6 +3,9 @@ package LiCoM::Person; use strict; use warnings; +use LiCoM::Config (qw(get_config)); +use LiCoM::Connection (qw($Ldap)); + use Net::LDAP; use Net::LDAP::Filter; @@ -12,11 +15,6 @@ Person - High level interface for address books using an LDAP-backend. =cut -our %Config = -( - base_dn => undef -); - our %ValidFields = ( telephoneNumber => 1, @@ -29,7 +27,7 @@ our %ValidFields = labeledURI => 1, mail => 1, mobile => 1, - o => 1 + userPassword => 0 ); our %ExternalNames = @@ -44,67 +42,11 @@ our %ExternalNames = uri => 'labeledURI', mail => 'mail', cellphone => 'mobile', - group => 'o' + password => 'userPassword' ); -our $Ldap; - return (1); -=head1 METHODS - -=over 4 - -=item Person-EB (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-EB () - -Disconnect from the LDAP-Server. - -=cut - -sub disconnect -{ - $Ldap->unbind (); - $Ldap = undef; -} - -=item Person-EB (I<$ldap_entry>) - -Created a new I-object from the passed I-object. - -=cut - sub new { my $pkg = shift; @@ -123,7 +65,11 @@ sub new return (bless ($obj, $pkg)); } -=item Person-EB (I<$cn>) +=head1 STATIC FUNCTIONS + +=over 4 + +=item LiCoM::Person-EB (I<$cn>) Loads the given CN and returns the B-object. @@ -145,7 +91,7 @@ sub load return ($retval); } -=item Person-EB (B =E I<$lastname>, B =E I<$firstname>, ...) +=item LiCoM::Person-EB (B =E I<$lastname>, B =E I<$firstname>, ...) Create a new I-object and return it's corresponding I-object. @@ -161,7 +107,7 @@ sub create my $dn; my $ou; - $entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]); + $entry->add (objectClass => [qw(person organizationalPerson inetOrgPerson)]); for (keys %hash) { @@ -219,16 +165,12 @@ sub create return (undef); } - $dn = "cn=$sn $gn," . $Config{'base_dn'}; - ($ou) = $Config{'base_dn'} =~ m/\bou\s*=\s*([^,]+)/i; + $ou = 'Person'; + $dn = "cn=$sn $gn,ou=$ou," . get_config ('base_dn'); $entry->add (cn => "$sn $gn", ou => $ou); $entry->dn ($dn); - print "\n"; - $entry->changetype ('add'); my $mesg = $entry->update ($Ldap); @@ -241,7 +183,7 @@ sub create return (new ($pkg, $entry)); } -=item Person-EB (B =E I<"Flor*">) +=item LiCoM::Person-EB (B =E I<"Flor*">) Search for the given patterns. Returns a list of I-objects. @@ -291,7 +233,16 @@ sub search if (@disjunc) { - push (@konjunct, join ('', '(|', @disjunc, ')')); + my $tmp; + if (scalar (@disjunc) == 1) + { + $tmp = $disjunc[0]; + } + else + { + $tmp = join ('', '(|', @disjunc, ')'); + } + push (@konjunct, $tmp); } } @@ -304,11 +255,9 @@ sub search $filter = '(objectclass=inetOrgPerson)'; } - print STDERR "Debug: using filter: $filter"; - $mesg = $Ldap->search ( - base => $Config{'base_dn'}, + base => 'ou=Person,' . get_config ('base_dn'), filter => $filter ); @@ -329,6 +278,57 @@ sub search return (@retval); } +=item LiCoM::Person-EB (I<$dn>) + +Returns the cn and, if defined, the user-id of this dn. + +=cut + +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 => 'ou=Person,' . get_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 METHODS + +=over 4 + =item I<$obj>-EB () Deletes the record. @@ -360,7 +360,7 @@ sub _update_dn my $sn = $obj->{'sn'}; my $gn = $obj->{'givenName'}; my $cn = "$sn $gn"; - my $dn = "cn=$cn," . $Config{'base_dn'}; + my $dn = "cn=$cn,ou=Person," . get_config ('base_dn'); $obj->{'cn'} = $cn; @@ -431,9 +431,8 @@ sub name =item I<$obj>-EB ([I<@uri>]) -=item I<$obj>-EB ([I<@groups>]) - -Get or set the attribute. +Get or set the attribute. This is the same as calling S-EB +(I<$field>, I<\@values>)> or S-EB (I<$field>)>. =cut @@ -442,19 +441,42 @@ 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>-EB (I<$field>) + +Returs the value(s) of field I<$field>. + +=cut + sub get { my $obj = shift; my $field = shift; - return (set ($obj, $field, undef)); + if (wantarray ()) + { + return (set ($obj, $field, undef)); + } + else + { + return (scalar (set ($obj, $field, undef))); + } } +=item I<$obj>-EB (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; @@ -468,7 +490,7 @@ sub set } if (!defined ($ValidFields{$field})) { - return (undef); + return; } if (defined ($value)) @@ -490,7 +512,10 @@ sub set $entry->update ($Ldap); } - $obj->{$field} = [] unless (defined ($obj->{$field})); + if (!defined ($obj->{$field}) and $ValidFields{$field}) + { + $obj->{$field} = []; + } if (wantarray () and $ValidFields{$field}) { @@ -502,62 +527,6 @@ sub set } } -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); -} - -sub password -{ - my $obj = shift; - my $entry = $obj->{'ldap'}; - my $pwd; - - if (@_) - { - $pwd = shift; - $entry->changetype ('modify'); - $entry->replace (userPassword => $pwd); - $entry->update ($Ldap); - } - - $pwd = $entry->get_value ('userPassword'); -} - =back =head1 AUTHOR