| Previous | Table of Contents | Next |
11.3 Desperately Seeking SanityWe can't run this code yet for the simple reason that we're in the process of upgrading it to Perl 5 and we've already used Perl 5-isms such as map() and my to make the code more concise. In order to get it working we will have to get the LDAP code working. If we can get Dua.pm built—and that's a big "if," because I could only get it to build for Perl 5.004—we can do a nearly straightforward replacement of &dua_ with $dua-> after creating a new Dua object. Errors are reported via a method instead of an exported variable, that's all: Example 11.4. dirsearch.cgi, Version 31 #!/usr/bin/perl 2 use Dua; 3 print "Content-type: text/html\n\n"; 4 5 @values = split(/&/, $ENV{'QUERY_STRING'}); 6 foreach $input (@values) 7 { 8 ($one, $two) = split(/=/,$input); 9 $filter && do_error("Cannot lookup by >1 attribute... pick one only"); 10 $filter = "($one=$two)"; 11 } 12 $filter || do_error("Need an attribute to search on"); 13 my $dua = Dua->new; 14 $dua->settmout(10, 0); 15 unless ($dua->open("whitepages", 389, $dn, $pwd)) 16 { 17 $msg = "Can't connect to whitepages: " . $dua->error"; 18 do_email_error($msg); 19 } 20 $scope = 1; 21 $all = 0; 22 $rdn = '@dc=oz@dc=city@dc=emerald@dc=wp@ou=People'; 23 %list = $dua->find($rdn, $filter, $scope, $all); 24 if ($dua->error) 25 { 26 do_email_error($dua->error); 27 } 28 unless (%list) 29 { 30 do_error("No match for $filter"); 31 } 32 print "<HTML><HEAD><TITLE>Search Results</TITLE></HEAD>\n"; 33 print "<BODY><H1>Results of search for $filter</H1>\n"; 34 print "<TABLE BORDER=\"1\"><TR>\n"; 35 my @attrs = qw(username location haircolor 36 telephone email fax name); 37 print map "<TH>$_</TH>", @attrs; 38 print "</TR>\n"; 39 foreach $i (sort { $a <=> $b } keys %list) 40 { 41 $dn = "\@". join("\@", reverse(split(/,\s*/, $list{$i}))); 42 %attr = $dua->show($dn); 43 print "<TR>", map "<TD>$attr{$_}</TD>", @attrs; 44 } 45 print "</TR></TABLE></BODY></HTML>\n"; 46 47 $dua->close; Again I have omitted the unchanged subroutines. This is a major milestone in that we have it working on Perl 5, so now we can impose strictness and warnings on it. There is no need to invoke it via a web browser, because running it at the command line after inserting use strict and use warnings (in this case, -w if we're stuck with Perl 5.004 because that's the only perl we can build Dua.pm on) tells us all we need to know: Global symbol "values" requires explicit package name at dirsearch.cgi line 8. Global symbol "input" requires explicit package name at dirsearch.cgi line 9. Global symbol "one" requires explicit package name at dirsearch.cgi line 11. Global symbol "two" requires explicit package name at dirsearch.cgi line 11. Global symbol "filter" requires explicit package name at dirsearch.cgi line 12. Global symbol "dua" requires explicit package name at dirsearch.cgi line 16. Global symbol "dn" requires explicit package name at dirsearch.cgi line 18. Global symbol "pwd" requires explicit package name at dirsearch.cgi line 18. Global symbol "msg" requires explicit package name at dirsearch.cgi line 20. Global symbol "scope" requires explicit package name at dirsearch.cgi line 23. Global symbol "all" requires explicit package name at dirsearch.cgi line 24. Global symbol "rdn" requires explicit package name at dirsearch.cgi line 25. Global symbol "list" requires explicit package name at dirsearch.cgi line 26. Global symbol "i" requires explicit package name at dirsearch.cgi line 41. Global symbol "attr" requires explicit package name at dirsearch.cgi line 45. Global symbol "mess" requires explicit package name at dirsearch.cgi line 61. Execution of dirsearch.cgi aborted due to compilation errors. In the process of inserting enough my statements to fix these problems we find out that the $dn and $pwd in line 15 of Example 11.4 were never set to anything, are therefore undefined, and so might as well be left out of the subroutine call anyway since unspecified values are the same as undefined ones nearly always. The code now looks like this: Example 11.5. dirsearch.cgi, Version 41 #!/usr/bin/perl -w 2 use strict; 3 use Dua; 4 print "Content-type: text/html\n\n"; 5 6 my @values = split(/&/, $ENV{'QUERY_STRING'}); 7 my $filter; 8 foreach my $input (@values) 9 { 10 my ($one, $two) = split(/=/,$input); 11 $filter && do_error("Cannot lookup by >1 attribute... pick one only"); 12 $filter = "($one=$two)"; 13 } 14 $filter || do_error("Need an attribute to search on"); 15 my $dua = Dua->new; 16 $dua->settmout(10, 0); 17 unless ($dua->open("whitepages", 389, $dn, $pwd)) 18 { 19 my $msg = "Can't connect to whitepages: " . $dua->error"; 20 do_email_error($msg); 21 } 22 my ($scope, $all) = (1, 0); 23 my $rdn = '@dc=oz@dc=city@dc=emerald@dc=wp@ou=People'; 24 my %list = $dua->find($rdn, $filter, $scope, $all); 25 if ($dua->error) 26 { 27 do_email_error($dua->error); 28 } 29 unless (%list) 30 { 31 do_error("No match for $filter"); 32 } 33 print "<HTML><HEAD><TITLE>Search Results</TITLE></HEAD>\n"; 34 print "<BODY><H1>Results of search for $filter</H1>\n"; 35 print "<TABLE BORDER=\"1\"><TR>\n"; 36 my @attrs = qw(username location haircolor 37 telephone email fax name); 38 print map "<TH>$_</TH>", @attrs; 39 print "</TR>\n"; 40 foreach my $i (sort { $a <=> $b } keys %list) 41 { 42 my $dn = "\@". join("\@", reverse(split(/,\s*/, $list{$i}))); 43 my %attr = $dua->show($dn); 44 print "<TR>", map "<TD>$attr{$_}</TD>", @attrs; 45 } 46 print "</TR></TABLE></BODY></HTML>\n"; 47 48 $dua->close; 49 50 sub do_email_error 51 { 52 my $mess = shift; 53 do_email($mess); 54 do_error($mess); 55 } 56 57 sub do_error 58 { 59 my $mess = shift; 60 return unless $mess; 61 print "<HTML><HEAD><TITLE>Error</TITLE></HEAD><BODY>\n"; 62 print "<H1>Error</H1><P>$mess</P>\n"; 63 print "</BODY></HTML>\n"; 64 exit; 65 } 66 67 sub do_email 68 { 69 my $mess = shift; 70 open MAIL, "|/usr/lib/sendmail -oi -t"; 71 print MAIL "To: me\@here\n"; 72 print MAIL "Subject: $0: LDAP lookup problem\n"; 73 print MAIL "\n"; 74 print MAIL "Error in LDAP processing in $0:\n\n"; 75 print MAIL "$mess\n"; 76 close MAIL; 77 } |
| Previous | Table of Contents | Next |