lib/LiCoM/Person.pm

   1 package LiCoM::Person;
   2
   3 use strict;
   4 use warnings;
   5
   6 use LiCoM::Config (qw(get_config));
   7 use LiCoM::Connection (qw($Ldap));
   8
   9 use Net::LDAP;
  10 use Net::LDAP::Filter;
  11
  12 =head1 NAME
  13
  14 Person - High level interface for address books using an LDAP-backend.
  15
  16 =cut
  17
  18 our %ValidFields =
  19 (
  20         telephoneNumber                 => 1,
  21         facsimileTelephoneNumber        => 1,
  22         sn                              => 0,
  23         cn                              => 0,
  24         givenName                       => 0,
  25         homePhone                       => 1,
  26         homePostalAddress               => 1,
  27         labeledURI                      => 1,
  28         mail                            => 1,
  29         mobile                          => 1,
  30         userPassword                    => 0
  31 );
  32
  33 our %ExternalNames =
  34 (
  35         officephone     => 'telephoneNumber',
  36         fax             => 'facsimileTelephoneNumber',
  37         lastname        => 'sn',
  38         name            => 'cn',
  39         firstname       => 'givenName',
  40         homephone       => 'homePhone',
  41         address         => 'homePostalAddress',
  42         uri             => 'labeledURI',
  43         mail            => 'mail',
  44         cellphone       => 'mobile',
  45         password        => 'userPassword'
  46 );
  47
  48 return (1);
  49
  50 =head1 STATIC FUNCTIONS
  51
  52 =over 4
  53
  54 =item LiCoM::Person-E<gt>B<load> (I<$cn>)
  55
  56 Loads the given CN and returns the B<Person>-object.
  57
  58 =cut
  59
  60 sub load
  61 {
  62         my $pkg = shift;
  63         my $cn = shift;
  64
  65         my ($retval) = search ($pkg, [[cn => $cn]]);
  66
  67         if (!$retval)
  68         {
  69                 warn ("CN '$cn' could not be found");
  70                 return (undef);
  71         }
  72
  73         return ($retval);
  74 }
  75
  76 =item LiCoM::Person-E<gt>B<create> (B<lastname> =E<gt> I<$lastname>, B<firstname> =E<gt> I<$firstname>, ...)
  77
  78 Create a new I<Net::LDAP::Entry>-object and return it's corresponding
  79 I<Person>-object.
  80
  81 =cut
  82
  83 sub create
  84 {
  85         my $pkg = shift;
  86
  87         my %hash = @_;
  88         my $entry = Net::LDAP::Entry->new ();
  89         my $dn;
  90
  91         $entry->add (objectClass => [qw(top organizationalUnit person organizationalPerson inetOrgPerson)]);
  92
  93         for (keys %hash)
  94         {
  95                 my $key = $_;
  96                 my $val = $hash{$key};
  97                 my $field = defined ($ExternalNames{$key}) ? $ExternalNames{$key} : $key;
  98
  99                 if (!defined ($ValidFields{$field}))
 100                 {
 101                         warn ("Invalid field $field");
 102                         next;
 103                 }
 104
 105                 if ($ValidFields{$field})
 106                 {
 107                         if (ref ($val) eq 'ARRAY')
 108                         {
 109                                 $entry->add ($field => [@$val]) if (@$val);
 110                         }
 111                         elsif (!ref ($val))
 112                         {
 113                                 $entry->add ($field => [$val]) if ($val);
 114                         }
 115                         else
 116                         {
 117                                 warn ("You cannot pass ref-type " . ref ($val));
 118                         }
 119                 }
 120                 else
 121                 {
 122                         my $temp;
 123                         if (ref ($val) eq 'ARRAY')
 124                         {
 125                                 $temp = $val->[0];
 126                         }
 127                         elsif (!ref ($val))
 128                         {
 129                                 $temp = $val;
 130                         }
 131                         else
 132                         {
 133                                 warn ("You cannot pass ref-type " . ref ($val));
 134                         }
 135
 136                         $entry->add ($field => $val) if (defined ($val) and $val);
 137                 }
 138         }
 139
 140         my $sn = $entry->get_value ('sn');
 141         my $gn = $entry->get_value ('givenName');
 142
 143         if (!defined ($sn) or !defined ($gn))
 144         {
 145                 warn ("sn or givenName not given");
 146                 return (undef);
 147         }
 148
 149         $dn = "cn=$sn $gn," . get_config ('base_dn');
 150
 151         $entry->add (cn => "$sn $gn");
 152         $entry->dn ($dn);
 153
 154         $entry->changetype ('add');
 155         my $mesg = $entry->update ($Ldap);
 156
 157         if ($mesg->is_error ())
 158         {
 159                 warn ("Error while creating entry '$dn' on LDAP server: " . $mesg->error_text ());
 160                 return (undef);
 161         }
 162
 163         return (new ($pkg, $entry));
 164 }
 165
 166 =item LiCoM::Person-E<gt>B<search> (B<firstname> =E<gt> I<"Flor*">)
 167
 168 Search for the given patterns. Returns a list of I<Person>-objects.
 169
 170   @filter =
 171   (
 172     [
 173       [field => value], # OR
 174       [field => value]
 175     ], # AND
 176     ...
 177   );
 178
 179 =cut
 180
 181 sub search
 182 {
 183         my $pkg = shift;
 184
 185         my @patterns = @_;
 186         my @konjunct = ();
 187         my $filter;
 188
 189         my $mesg;
 190         my @retval = ();
 191
 192         for (@patterns)
 193         {
 194                 my $dj = $_;
 195                 my @disjunc = ();
 196
 197                 for (@$dj)
 198                 {
 199                         my $field = $_->[0];
 200                         my $value = $_->[1];
 201
 202                         $field = $ExternalNames{$field} if (defined ($ExternalNames{$field}));
 203                         if (!defined ($ValidFields{$field}))
 204                         {
 205                                 warn ("Not a valid field: $field");
 206                                 next;
 207                         }
 208
 209                         $value =~ s/([\(\)\\])/\\$1/g;
 210
 211                         push (@disjunc, "($field=$value)");
 212                 }
 213
 214                 if (@disjunc)
 215                 {
 216                         my $tmp;
 217                         if (scalar (@disjunc) == 1)
 218                         {
 219                                 $tmp = $disjunc[0];
 220                         }
 221                         else
 222                         {
 223                                 $tmp = join ('', '(|', @disjunc, ')');
 224                         }
 225                         push (@konjunct, $tmp);
 226                 }
 227         }
 228
 229         if (@konjunct)
 230         {
 231                 $filter = join ('', '(&(objectclass=inetOrgPerson)', @konjunct, ')');
 232         }
 233         else
 234         {
 235                 $filter = '(objectclass=inetOrgPerson)';
 236         }
 237
 238         $mesg = $Ldap->search
 239         (
 240                 base   => get_config ('base_dn'),
 241                 filter => $filter
 242         );
 243
 244         if ($mesg->is_error ())
 245         {
 246                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 247                 return (qw());
 248         }
 249
 250         for ($mesg->entries ())
 251         {
 252                 my $entry = $_;
 253                 my $obj = new ($pkg, $entry);
 254
 255                 push (@retval, $obj);
 256         }
 257
 258         return (@retval);
 259 }
 260
 261 =item LiCoM::Person-E<gt>B<get_user> (I<$dn>)
 262
 263 Returns the cn and, if defined, the user-id of this dn.
 264
 265 =cut
 266
 267 sub get_user
 268 {
 269         my $pkg = shift;
 270         my $dn = shift;
 271         my ($search) = $dn =~ m/cn\s*=\s*([^,]+)/i;
 272
 273         die unless ($search);
 274
 275         my $cn = '';
 276         my $id = '';
 277
 278         my $mesg = $Ldap->search
 279         (
 280                 base   => get_config ('base_dn'),
 281                 filter => "(cn=$search)"
 282         );
 283
 284         if ($mesg->is_error ())
 285         {
 286                 warn ("Error while querying LDAP server: " . $mesg->error_text ());
 287                 return ('');
 288         }
 289
 290         for ($mesg->entries ())
 291         {
 292                 my $e = $_;
 293                 my ($t_cn) = $e->get_value ('cn', asref => 0);
 294                 my ($t_id) = $e->get_value ('uid', asref => 0);
 295
 296                 if (!$id or $t_id)
 297                 {
 298                         $cn = $t_cn;
 299                         $id = $t_id;
 300                 }
 301         }
 302
 303         return ($cn, $id);
 304 }
 305
 306 =back
 307
 308 =head1 METHODS
 309
 310 =over 4
 311
 312 =item I<$obj>-E<gt>B<delete> ()
 313
 314 Deletes the record.
 315
 316 =cut
 317
 318 sub delete
 319 {
 320         my $obj = shift;
 321         my $entry = $obj->{'ldap'};
 322
 323         $entry->changetype ('delete');
 324         $entry->delete ();
 325         $entry->update ($Ldap);
 326
 327         %$obj = ();
 328 }
 329
 330 =item I<$obj>-E<gt>B<lastname> ([I<$lastname>])
 331
 332 Get or set the lastname.
 333
 334 =cut
 335
 336 sub _update_dn
 337 {
 338         my $obj = shift;
 339         my $entry = $obj->{'ldap'};
 340         my $sn = $obj->{'sn'};
 341         my $gn = $obj->{'givenName'};
 342         my $cn = "$sn $gn";
 343         my $dn = "cn=$cn," . get_config ('base_dn');
 344
 345         $obj->{'cn'} = $cn;
 346
 347         print STDERR "This is _update_dn, trying to set dn=$dn";
 348
 349         $entry->changetype ('modify');
 350         $entry->replace (sn => $sn, givenName => $gn, cn => $cn);
 351         $entry->update ($Ldap);
 352         $entry->dn ($dn);
 353         $entry->update ($Ldap);
 354 }
 355
 356 sub lastname
 357 {
 358         my $obj = shift;
 359
 360         if (@_)
 361         {
 362                 $obj->{'sn'} = shift;
 363                 _update_dn ($obj);
 364         }
 365
 366         return ($obj->{'sn'});
 367 }
 368
 369 =item I<$obj>-E<gt>B<firstname> ([I<$firstname>])
 370
 371 Get or set the firstname.
 372
 373 =cut
 374
 375 sub firstname
 376 {
 377         my $obj = shift;
 378
 379         if (@_)
 380         {
 381                 $obj->{'givenName'} = shift;
 382                 _update_dn ($obj);
 383         }
 384
 385         return ($obj->{'givenName'});
 386 }
 387
 388 =item I<$obj>-E<gt>B<name> ()
 389
 390 Returns the CN.
 391
 392 =cut
 393
 394 sub name
 395 {
 396         my $obj = shift;
 397         return ($obj->{'cn'});
 398 }
 399
 400 =item I<$obj>-E<gt>B<address> ([I<@address>])
 401
 402 =item I<$obj>-E<gt>B<homephone> ([I<@homephone>])
 403
 404 =item I<$obj>-E<gt>B<cellphone> ([I<@cellphone>])
 405
 406 =item I<$obj>-E<gt>B<officephone> ([I<@officephone>])
 407
 408 =item I<$obj>-E<gt>B<fax> ([I<@fax>])
 409
 410 =item I<$obj>-E<gt>B<mail> ([I<@mail>])
 411
 412 =item I<$obj>-E<gt>B<uri> ([I<@uri>])
 413
 414 =item I<$obj>-E<gt>B<group> ([I<@groups>])
 415
 416 Get or set the attribute. This is the same as calling S<I<$obj>-E<gt>B<set>
 417 (I<$field>, I<\@values>)> or S<I<$obj>-E<gt>B<get> (I<$field>)>.
 418
 419 =cut
 420
 421 sub AUTOLOAD
 422 {
 423         my $obj = shift;
 424         my @values = @_;
 425         my $field = $Person::AUTOLOAD;
 426
 427         return (undef) unless ($field);
 428
 429         $field =~ s/.*:://;
 430
 431         return (set ($obj, $field, @values ? [@values] : undef))
 432 }
 433
 434 =item I<$obj>-E<gt>B<get> (I<$field>)
 435
 436 Returs the value(s) of field I<$field>.
 437
 438 =cut
 439
 440 sub get
 441 {
 442         my $obj = shift;
 443         my $field = shift;
 444
 445         if (wantarray ())
 446         {
 447                 return (set ($obj, $field, undef));
 448         }
 449         else
 450         {
 451                 return (scalar (set ($obj, $field, undef)));
 452         }
 453 }
 454
 455 =item I<$obj>-E<gt>B<set> (I<$field>, I<\@values>)
 456
 457 Sets the field I<$field> to the value(s) I<\@valued>. Pass an empty array-ref
 458 to delete the field.
 459
 460 =cut
 461
 462 sub set
 463 {
 464         my $obj = shift;
 465         my $field = shift;
 466         my $value = @_ ? shift : undef;
 467         my $entry = $obj->{'ldap'};
 468
 469         if (defined ($ExternalNames{$field}))
 470         {
 471                 $field = $ExternalNames{$field};
 472         }
 473         if (!defined ($ValidFields{$field}))
 474         {
 475                 return (undef);
 476         }
 477
 478         if (defined ($value))
 479         {
 480                 $entry->changetype ('modify');
 481
 482                 if ($ValidFields{$field})
 483                 {
 484                         $entry->replace ($field, [@$value]);
 485                         $obj->{$field} = $value;
 486                 }
 487                 else
 488                 {
 489                         splice (@$value, 1) if (scalar (@$value) > 1);
 490                         $entry->replace ($field, $value);
 491                         $obj->{$field} = $value->[0];
 492                 }
 493
 494                 $entry->update ($Ldap);
 495         }
 496
 497         $obj->{$field} = [] unless (defined ($obj->{$field}));
 498
 499         if (wantarray () and $ValidFields{$field})
 500         {
 501                 return (@{$obj->{$field}});
 502         }
 503         else
 504         {
 505                 return ($obj->{$field});
 506         }
 507 }
 508
 509 =back
 510
 511 =head1 AUTHOR
 512
 513 Florian octo Forster E<lt>octo at verplant.orgE<gt>
 514
 515 =cut