lib/LiCoM/Person.pm

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