Приглашаем посетить
Грибоедов (griboedov.lit-info.ru)

11.4 Coming into the 21st Century

Previous Table of Contents Next

11.4 Coming into the 21st Century

Now we can no longer ignore the fact that we are using an ancient, unsupported module (Dua.pm) for LDAP operations, and we look up the documentation for Net::LDAP. Line by line we replace Dua.pm calls with Net::LDAP calls. This requires us to learn Net::LDAP if we don't already know it, but doing so will pay handsome dividends. Here are the changes we have to make:

  • The timeout is now specified in the new() constructor.

  • If the constructor fails it returns undef and puts the error in $@.

  • The login to the server (called binding in LDAP terminology) is a separate method call, even though we are making an anonymous connection.

  • Searching is done by the search() method, which returns a result object in the Net::LDAP::Search class.

  • The bind() and search() methods return objects that have a code() method that returns true on error, and an error() method that returns the error text.

  • The Net::LDAP::Search class has a method, count(), which returns the number of results found, and another method, entries(), which returns all the results as a list of Net::LDAP::Entry objects.

  • Each Net::LDAP::Entry object has a get_value() method that will return the value of a named attribute.

  • The base distinguished name (DN) of the search can now be specified in the natural order instead of the reversed order with @ separators that duaperl perversely required. We move it to the head of the program to get a head start on moving all magic constants there.

In the process, we discover that the magic number 389 in the Dua::open() method is actually the default port number for LDAP connections, so we can leave it out altogether. These changes bring us to:

Example 11.6. dirsearch.cgi, Version 5

1  #!/usr/bin/perl

2  use strict;

3  use warnings;

4  use Net::LDAP;

5

6  print "Content-type: text/html\n\n";

7  my $rdn = 'ou=People, dc=wp, dc=emerald, dc=city, dc=oz';

8

9  my @values = split(/&/, $ENV{'QUERY_STRING'});

10 my $filter;

11 foreach my $input (@values)

12 {

13   my ($one, $two) = split(/=/,$input);

14   $filter && do_error("Cannot lookup by >1 attribute... pick one only");

15   $filter = "($one=$two)";

16 }

17 $filter || do_error("Need an attribute to search on");

18 my $ldap = Net::LDAP->new("whitepages", timeout => 10)

19   or do_email_error("Can't connect to whitepages: $@");

20 my $mesg = $ldap->bind;

21 $mesg->code and do_email_error("Bind error: "

22                                . $mesg->error);

23 my $res = $ldap->search(base => $rdn, filter => $filter, scope => 'sub');

24 $res->code and do_email_error("Search failure: "

25                               . $res->error);

26

27 $res->count or do_error("No match for $filter");

28

29 print "<HTML><HEAD><TITLE>Search Results</TITLE></HEAD>\n";

30 print "<BODY><H1>Results of search for $filter</H1>\n";

31 print "<TABLE BORDER=\"1\"><TR>\n";

32 my @attrs = qw(username location haircolor

33        telephone email fax name);

34 print map "<TH>$_</TH>", @attrs;

35 print "</TR>\n";

36 foreach my $ent ($res->entries)

37 {

38   print "<TR>", map "<TD>" . $ent->get_value($_)

39                            . "</TD>", @attrs;

40 }

41 print "</TR></TABLE></BODY></HTML>\n";

42

43 $ldap->unbind;

Again, the later subroutines are as yet unchanged (but fear not, their day is coming). Now we have a program that uses only modern modules and runs on our latest perl. Are we done? Hardly. First, let's get rid of that festering sore of $ENV{QUERY_STRING} parsing. The problems with this approach start with the fact that it only works for forms submitted via the GET method and rapidly get far worse. Using CGI.pm will also allow us to test the program from the command line easily:


% ./dirsearch.cgi username=dorothy

and therefore we can make our test program run much faster by changing it to follow suit:

Example 11.7. Test for dirsearch.cgi, Version 2

#!/usr/bin/perl

use strict;

use warnings;



use Test::More tests => 3;



my %SEARCH = (username  => "dorothy",

              location  => "kansas",

              haircolor => "red");



for my $attr (keys %SEARCH)

{

  like(`./dirsearch.cgi $attr=$SEARCH{$attr}`,

       qr/Dorothy Gale/,

       "Result okay");

}

    Previous Table of Contents Next