11.8 Making It Mature, Part 2
Now we're on a roll! Why are we sending e-mail by talking to sendmail directly, when every other part of the code is portable to platforms that don't use sendmail for sending mail? Another trip to CPAN gives us Mail::Send, from Tim Bunce and Graham Barr, maintained by Mark Overmeer. At the same time, we'll move the mail addressing information up to the beginning of the program for configurability:
my %ERR_MAIL_ARGS = (Subject => "$0: LDAP lookup problem",
To => 'me@here');
.
.
.
sub send_email
{
require Mail::Send;
my $sender = Mail::Send->new(%ERR_MAIL_ARGS);
my $fh = $sender->open;
print $fh <<"EOM";
Error in LDAP processing in $0:
@_
EOM
$fh->close;
}
We require Mail::Send in order to load it at run time because there's no point in loading the module every time with use if it's only going to be needed in extraordinary circumstances. We also gave the subroutine a name that's more appropriate than do_email() was.
Can we do better? Of course! (You don't think I'd be asking otherwise, do you?) Let's take those error messages and move them up to the front of the program so they also can become easily configurable by a maintenance programmer; and so we have all the possible failure messages listed in one place (this will help with documentation). Because some of them have variable components, we'll need to insert placeholders and use sprintf() to fill in the values.
As long as we're making the program more maintainable, how about considering the quite likely possibility that in the future it will have to deal with multiple search terms combined with some boolean operators? So, we can read in all input terms and for now, insist that the hash contain exactly one name-value pair. (We should also add tests for these errors; I'll leave those as an exercise for the reader at this point.)
We need to consider the possibility that the value of one of the attributes in the directory might be unset, so we want to avoid a warning about the use of an uninitialized value. Finally, because we're being cautious, let's get the NET::LDAP::Entry objects out one at a time via shift_entry(), just so we don't have to form the list of all those objects in memory at once. It won't take up any more code.
Example 11.14. dirsearch.cgi, Version 9
1 #!/usr/bin/perl -T
2 use strict;
3 use warnings;
4
5 use CGI qw(header param);
6 use HTML::Template;
7 use Net::LDAP;
8 use Net::LDAP::Filter;
9
10 my @OUTPUT_ATTRS = qw(username location haircolor
11 telephone email fax name);
12 my %SEARCH_ATTRS = map { ($_ => 1) }
13 qw(username location haircolor);
14 my $OUTPUT_TEMPLATE = "output.tmpl";
15 my $ERROR_TEMPLATE = "error.tmpl";
16
17 my $LDAP_SERVER = "whitepages";
18 my @LDAP_OPTS = ($LDAP_SERVER, onerror => 'die', timeout => 10);
19
20 my %ERROR = (
21 TOOMANY => "Cannot lookup by >1 attribute... pick one only",
22 TOOFEW => "Need an attribute to search on",
23 LDAPCON => "Can't connect to %s: %s",
24 LDAPERR => "LDAP error: %s",
25 NOMATCH => "No match for %s",
26 );
27 my %ERR_MAIL_ARGS = (Subject => "$0: LDAP lookup problem",
28 To => 'me@here');
29 my %SEARCH_OPTS =
30 (base => "ou=People, dc=wp, dc=emerald, dc=city, dc=oz",
31 scope => "sub", attrs => \@OUTPUT_ATTRS);
32
33 my %query = map { ($_ => param($_) }
34 grep { defined(param($_) } keys %SEARCH_ATTRS;
35 keys %query > 1 and error('TOOMANY');
36 keys %query or error('TOOFEW');
37
38 my $ldap = Net::LDAP->new(@LDAP_OPTIONS)
39 or do_email_error(LDAPCON => $LDAP_SERVER, $@);
40
41 eval
42 {
43 $ldap->bind;
44 my ($filter) = map "$_=$query{$_}" => keys %query;
45 my $res = $ldap->search(%SEARCH_OPTS, filter =>
46 Net::LDAP::Filter->new("($filter)"));
47 $res->count or error(NOMATCH => $filter);
48
49 my $tem = HTML::Template->new(filename =>
50 $OUTPUT_TEMPLATE);
51 my @results;
52 while (my $entry = $res->shift_entry)
53 {
54 my @data;
55 for my $attr (@OUTPUT_ATTRS)
56 {
57 my $val = $entry->get_value($attr);
58 push @data, { attribute => defined($val) ? $val : '' };
59 }
60 push @results, { attributes => \@data };
61 }
62 $tem->param(results => \@results,
63 filter => $filter,
64 attributes => [ map +{ (attribute => $_) } => @OUTPUT_ATTRS ]
65 );
66 print header, $tem->output;
67 };
68 do_email_error(LDAPERR => $@) if $@;
69
70 sub do_email_error
71 {
72 my $fmt = shift;
73 send_email(@_);
74 error($fmt, @_);
75 }
76
77 sub error
78 {
79 my $fmt = $ERROR{+shift};
80 my $tem = HTML::Template->new(filename =>
81 $ERROR_TEMPLATE);
82 $tem->param(reason => sprintf $fmt, @_);
83 print header, $tem->output;
84 exit;
85 }
The send_email() subroutine is unchanged.
|
