1=head1 NAME
2
3Net::LDAP::Examples - PERL LDAP by Example
4
5=head1 DESCRIPTION
6
7The following examples are of course PERL code, found to work
8with the Net::LDAP modules.
9
10The intent of this document is to give the reader a I<cut and paste>
11jump start to getting an LDAP application working.
12
13Below you will find snippets of code that should work as-is with only
14a small amount of work to correct any variable assignments and LDAP
15specifics, e.g. Distinguished Name Syntax, related to the user's
16own implementation.
17
18The I<S>tandard I<O>perating I<P>roceedure that is followed here is:
19
20=over 8
21
22=item 1 Package		- use Net::LDAP
23
24=item 2 Initialization	- new
25
26=item 3 Binding		- bind
27
28=item 4 Operation	- add modify moddn search
29
30=item 4.1 Processing	- displaying data from a search
31
32=item 5 Error		- displaying error information
33
34=item 6 Unbinding	- unbind
35
36=back
37
38Look to each of these for a snippet of code to meet your needs.
39
40
41B<What is not covered in these examples at this time:>
42
43=over 4
44
45=item  I<abandon> and I<compare> methods
46
47=item  I<callback> subroutines
48
49=back
50
51=head1 CODE
52
53=head2 PACKAGE - Definitions
54
55 use Net::LDAP;
56
57=head2 INITIALIZING
58
59 $ldap = Net::LDAP->new ( "yourLDAPhost.yourCompany.com" ) or die "$@";
60
61=head2 BINDING
62
63 $mesg = $ldap->bind ( version => 3 );    	# use for searches
64
65 $mesg = $ldap->bind ( "$userToAuthenticate",		
66                       password => "$passwd",
67                       version => 3 );		# use for changes/edits
68
69 # see your LDAP administrator for information concerning the
70 # user authentication setup at your site.
71
72
73=head2 OPERATION - Generating a SEARCH
74
75 sub LDAPsearch
76 {
77   my ($ldap,$searchString,$attrs,$base) = @_;
78
79   # if they don't pass a base... set it for them
80
81   if (!$base ) { $base = "o=mycompany, c=mycountry"; }
82
83   # if they don't pass an array of attributes...
84   # set up something for them
85
86   if (!$attrs ) { $attrs = [ 'cn','mail' ]; }
87
88   my $result = $ldap->search ( base    => "$base",
89                                scope   => "sub",
90                                filter  => "$searchString",
91                                attrs   =>  $attrs
92                              );
93
94}
95
96 my @Attrs = ( );		# request all available attributes
97				# to be returned.
98
99 my $result = LDAPsearch ( $ldap, "sn=*", \@Attrs );
100
101
102=head2 PROCESSING - Displaying SEARCH Results
103
104 #------------
105 #
106 # Accessing the data as if in a structure
107 #  i.e. Using the "as_struct"  method
108 #
109
110 my $href = $result->as_struct;
111
112 # get an array of the DN names
113
114 my @arrayOfDNs  = keys %$href;        # use DN hashes
115
116 # process each DN using it as a key
117
118 foreach ( @arrayOfDNs ) {
119   print $_, "\n";
120   my $valref = $$href{$_};
121
122   # get an array of the attribute names
123   # passed for this one DN.
124   my @arrayOfAttrs = sort keys %$valref; #use Attr hashes
125
126   my $attrName;	
127   foreach $attrName (@arrayOfAttrs) {
128
129     # skip any binary data: yuck!
130     next if ( $attrName =~ /;binary$/ );
131
132     # get the attribute value (pointer) using the
133     # attribute name as the hash
134     my $attrVal =  @$valref{$attrName};
135     print "\t $attrName: @$attrVal \n";
136   }
137   print "#-------------------------------\n";
138   # End of that DN
139 }
140 #
141 #  end of as_struct method
142 #
143 #--------
144
145
146 #------------
147 #
148 # handle each of the results independently
149 # ... i.e. using the walk through method
150 #
151 my @entries = $result->entries;
152
153 my $entr;
154 foreach $entr ( @entries ) {
155   print "DN: ", $entr->dn, "\n";
156
157   my $attr;
158   foreach $attr ( sort $entr->attributes ) {
159     # skip binary we can't handle
160     next if ( $attr =~ /;binary$/ );
161     print "  $attr : ", $entr->get_value ( $attr ) ,"\n";
162   }
163
164   print "#-------------------------------\n";
165 }
166
167 #
168 # end of walk through method
169 #------------
170
171
172
173=head2 OPERATION - Modifying entries
174
175 #
176 #   Modify
177 #
178 #  for each of the modifies below you'll need to supply
179 #  a full DN (Distinguished Name) for the $dn variable.
180 #   example:
181 #    cn=Jo User,ou=person,o=mycompany,c=mycountry
182 #
183 #   I would recommend doing a search (listed above)
184 #   then use the dn returned to populate the $dn variable.
185
186 #
187 #  Do we only have one result returned from the search?
188
189 if ( $result->count != 1 ) { exit; }  # Nope.. exit
190
191 my $dn = $entries[0]->dn;	   # yes.. get the DN
192
193 #######################################
194 #
195 #   MODIFY using a HASH
196 #
197
198 my %ReplaceHash = ( keyword => "x", proxy => "x" );
199
200 my $result = LDAPmodifyUsingHash ( $ldap, $dn, \%ReplaceHash );
201
202 sub LDAPmodifyUsingHash
203 {
204   my ($ldap, $dn, $whatToChange ) = @_;
205   my $result = $ldap->modify ( $dn,
206                                replace => { %$whatToChange }
207                              );
208   return $result;
209 }
210
211 #######################################
212 #
213 #   MODIFY using a ARRAY List
214 #
215
216 my @ReplaceArrayList = [ 'keyword', "xxxxxxxxxx",
217                          'proxy' , "yyyyyyyyyy"   ];
218
219 my $result = LDAPmodifyUsingArrayList ( $ldap, $dn, \@ReplaceArrayList );
220
221 sub LDAPmodifyUsingArrayList
222 {
223   my ($ldap, $dn, $whatToChange ) = @_;
224   my $result = $ldap->modify ( $dn,
225                                changes => [
226                                  replace => @$whatToChange
227                                ]
228                              );
229   return $result;
230 }
231
232 #######################################
233 #
234 #   MODIFY using a ARRAY
235 #
236
237 my @ReplaceArray = ( 'keyword', "xxxxxxxxxx" ,
238                      'proxy' , "yyyyyyyyyy"   );
239
240 my $result = LDAPmodifyUsingArray ( $ldap, $dn, \@ReplaceArray );
241
242 sub LDAPmodifyUsingArray
243 {
244   my ($ldap, $dn, $whatToChange ) = @_;
245   my $result = $ldap->modify ( $dn,
246                                changes => [
247                                  replace => [ @$whatToChange ]
248                                ]
249                              );
250   return $result;
251 }
252
253 #######################################
254 #
255 #   MODIFY an existing record using 'Changes'
256 #    (or combination of add/delete/replace)
257 #
258
259 my @whatToChange;
260 my @ReplaceArray;
261 my @DeleteArray;
262 my @AddArray;
263
264 push @AddArray, 'cn', "me myself";
265 push @ReplaceArray, 'sn', '!@#$%^&*()__+Hello THere';
266 push @ReplaceArray, 'cn', "me myself I";
267 push @DeleteArray, 'cn', "me myself";
268
269 if ( $#ReplaceArray > 0 ) {
270   push @whatToChange, 'replace';
271   push @whatToChange, \@ReplaceArray;
272 }
273 if ( $#DeleteArray > 0 ) {
274   push @whatToChange, 'delete';
275   push @whatToChange, \@DeleteArray;
276 }
277 if ( $#AddArray > 0 ) {
278   push @whatToChange, 'add';
279   push @whatToChange, \@AddArray;
280 }
281
282 $result = LDAPmodify ( $ldap, $dn, \@whatToChange );
283
284 sub LDAPmodify
285 {
286   my ($ldap, $dn, $whatToChange) = @_;
287
288   my $result = $ldap->modify ( $dn,
289                                changes => [
290                                  @$whatToChange
291                                ]
292                              );
293   return $result;
294 }
295
296=head2 OPERATION - Changing the RDN
297
298 my $newRDN = "cn=Joseph User";
299
300 my $result = LDAPrdnChange ( $ldap, $dn, $newRDN, "archive" );
301
302
303 sub LDAPrdnChange
304 {
305   my ($ldap,$dn,$whatToChange,$action) = @_;
306
307   my $branch;
308
309   #
310   # if the archive action is selected, move this
311   # entry to another place in the directory.
312   #
313   if ( $action =~ /archive/i )  {
314     $branch = "ou=newbranch, o=mycompany, c=mycountry";
315   }
316
317   #
318   # use the 'deleteoldrdn' to keep from getting
319   # multivalues in the NAMING attribute.
320   # in most cases that would be the 'CN' attribute
321   #
322   my $result = $ldap->moddn ( $dn,
323                               newrdn => $whatToChange,
324                               deleteoldrdn => '1',
325                               newsuperior => $branch
326                             );
327
328   return $result;
329
330 }
331
332
333=head2 OPERATION - Adding a new Record
334
335 my $DNbranch = "ou=bailiwick, o=mycompany, c=mycountry";
336
337 #
338 # check with your Directory Schema or Administrator
339 # for the correct objectClass... I'm sure it'll be different
340 #
341 my $CreateArray = [
342   objectClass => [ "top", "person", "organizationalPerson", "inetOrgPerson" ],
343   cn => "Jane User",
344   uid => "0000001",
345   sn => "User",
346   mail => "JaneUser@mycompany.com"
347 ];
348
349 #
350 # create the  new DN to look like this
351 # " cn=Jo User + uid=0000001 , ou=bailiwick, o=mycompany, c=mycountry "
352 #
353 # NOTE: this DN  MUST be changed to meet your implementation
354 #
355
356 my $NewDN = "@$CreateArray[2]=".
357             "@$CreateArray[3]+".
358             "@$CreateArray[4]=".
359             "@$CreateArray[5],".
360             $DNbranch;
361
362 LDAPentryCreate($ldap, $NewDN, $CreateArray);
363
364 #
365 # CreateArray is a reference to an anonymous array
366 # you have to dereference it in the  subroutine it's
367 # passed to.
368 #
369
370 sub LDAPentryCreate
371 {
372    my ($ldap, $dn, $whatToCreate) = @_;
373    my $result = $ldap->add ( $dn, attrs => [ @$whatToCreate ] );
374    return $result;
375 }
376
377=head2 ERROR - Retrieving and Displaying ERROR information
378
379 if ( $result->code ) {
380   #
381   # if we've got an error... record it
382   #
383   LDAPerror ( "Searching", $result );
384 }
385
386 sub LDAPerror
387 {
388   my ($from, $mesg) = @_;
389   print "Return code: ", $mesg->code;
390   print "\tMessage: ", $mesg->error_name;
391   print " :",          $mesg->error_text;
392   print "MessageID: ", $mesg->mesg_id;
393   print "\tDN: ", $mesg->dn;
394
395   #---
396   # Programmer note:
397   #
398   #  "$mesg->error" DOESN'T work!!!
399   #
400   #print "\tMessage: ", $mesg->error;
401   #-----
402 }
403
404
405=head2 UNBIND
406
407 $ldap->unbind;
408
409=head1 LDAP SCHEMA RETRIEVAL
410
411The following code snippet shows how to retrieve schema information.
412
413The first procedure is to initialize a new LDAP object using the
414same procedures as listed at the beginning of this document.
415
416The second procedure is to bind to your directory server.  Some 
417servers may require authentication to retrieve the schema from the 
418directory server.  This procedure is listed at the beginning of 
419this document too.
420
421After a successful bind you are ready to retrieve the schema 
422information.  You do this by initializing a schema object.
423
424 $schema = $ldap->schema ( );
425
426In this case Net::LDAP will attempt to determine the dn under which
427the schema can be found. First it will look for the attribute
428C<subschemasubentry> in the root DSE. If that cannot be found then
429it will default to the assumption of C<cn=schema>
430
431Alternatively you can specify the dn where the schema is to be found
432with
433
434 $schema = $ldap->schema ( dn => $dn );
435
436Once we have a dn to search for, Net::LDAP will fetch the schema entry with
437
438  $mesg = $self->search ( base   => $dn,
439                          scope  => 'base',
440                          filter => '(objectClass=subschema)',
441                        );
442
443Once the schema object has been initialized, schema methods 
444are used to retrieve the data.  There are a number of ways this
445can be done.  Information on the schema methods can be found 
446in the Net::LDAP::Schema pod documentation.
447
448The following is a code snippet showing how to get and display 
449information about returned attributes.  
450
451 #
452 # Get the attributes
453 #
454
455 @attributes = $schema->all_attributes ( );
456
457 #
458 # Display the attributes
459 #
460
461 foreach $ar ( @attributes ) {
462   print "attributeType: ", $ar->{name}, "\n";
463
464   #
465   # Print all the details
466   #
467
468   foreach $key ( keys %{$ar} ) {
469     print join ( "\n\t\t", "\t$key:",
470                  ref ( $ar->{$key} ) ? @{$ar->{$key}} : $ar->{$key}
471                ), "\n";
472   }
473 }
474
475The process is the basically the same for getting objectClass 
476information.  Where schema-E<gt>all_attributes() is used, substitute 
477schema-E<gt>all_objectclasses().  From that point on the process is
478the same for both objectClasses and attributes. 
479
480=head1 BUGS
481
482None known, but there may be some
483
484=head1 AUTHOR  (of this document)
485
486Russell Biggs E<lt>rgb@ticnet.comE<gt>
487
488=head1 COPYRIGHT
489
490All rights to this document are hereby relinquished to Graham Barr.
491
492=cut
493
494