Ïðèãëàøàåì ïîñåòèòü
Õëåáíèêîâ (hlebnikov.lit-info.ru)

11.6 Incorporating Modules Effectively, Part 2

Previous Table of Contents Next

11.6 Incorporating Modules Effectively, Part 2

However, this version feels dissatisfyingly inadequate. All that HTML text also looks like several large constant values; can we do the same with it?

Yes, we can, with HTML::Template. We can break the HTML out into its own files (one for normal output, one for error output) and those files will now contain just HTML. This will achieve separation of code and data—usually a good thing in its own right—and also allow us to pawn off—er, delegate—the job of HTML editing to someone else. Let's transfer the normal result HTML output to a file called output.tmpl:

Example 11.9. output.tmpl, Version 1

<HTML><HEAD><TITLE></TITLE></HEAD>

 <BODY>

  <H1>Results of search for <TMPL_VAR NAME=filter></H1>

  <TABLE BORDER="1">

   <TR>

    <TH>username</TH>

    <TH>location</TH>

    <TH>haircolor</TH>

    <TH>telephone</TH>

    <TH>email</TH>

    <TH>fax</TH>

    <TH>name</TH>

   </TR>

   <TMPL_LOOP NAME="results">

    <TR>

     <TD><TMPL_VAR NAME="username"></TD>

     <TD><TMPL_VAR NAME="location"></TD>

     <TD><TMPL_VAR NAME="haircolor"></TD>

     <TD><TMPL_VAR NAME="telephone"></TD>

     <TD><TMPL_VAR NAME="email"></TD>

     <TD><TMPL_VAR NAME="fax"></TD>

     <TD><TMPL_VAR NAME="name"></TD>

    </TR>

   </TMPL_LOOP>

  </TABLE>

 </BODY>

</HTML>

The error text goes in a template called error.tmpl:

Example 11.10. error.tmpl, Version 1

<HTML><HEAD><TITLE>Error</TITLE></HEAD>

 <BODY>

  <H1>Error</H1>

   <P><TMPL_VAR NAME="reason"></P>

 </BODY>

</HTML>

In order to use these templates, we must bundle all our data up with the param() method of HTML::Template and output it in one go with the output() method. The full program (except for the do_email() subroutine, which isn't changing—yet) is now:

Example 11.11. dirsearch.cgi, Version 7

1  #!/usr/bin/perl

2  use strict;

3  use warnings;

4

5  use CGI qw(param header);

6  use Net::LDAP;

7  use HTML::Template;

8

9  my %SEARCH_OPTS =

10    (base  => 'ou=People, dc=wp, dc=emerald, dc=city, dc=oz',

11     scope => 'sub');

12 my $LDAP_SERVER = "whitepages";

13 my @LDAP_OPTS = ($LDAP_SERVER, timeout => 10);

14 my @ATTRS = qw(username location haircolor

15        telephone email fax name);

16

17 my $filter;

18 foreach my $input (param)

19 {

20   my $value = param($input);

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

22   $filter = "($input=$value)";

23 }

24 $filter or do_error("Need an attribute to search on");

25

26 my $ldap = Net::LDAP->new(@LDAP_OPTS)

27   or do_email_error("Can't connect to $LDAP_SERVER: $@");

28 my $mesg = $ldap->bind;

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

30                                . $mesg->error);

31 my $res = $ldap->search(%SEARCH_OPTS, filter => $filter);

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

33                               . $res->error);

34

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

36

37 my $tem = HTML::Template->new(filename => "output.tmpl");

38 my @results;

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

40 {

41   push @results,

42     { map { $_ => $ent->get_value($_) } @ATTRS };

43 }

44 $tem->param(filter => $filter, results => \@results);

45 print header, $tem->output;

46

47 $ldap->unbind;

48

49 sub do_email_error

50 {

51   my $mess = shift;

52   do_email($mess);

53   do_error($mess);

54 }

55

56 sub do_error

57 {

58   my $mess = shift;

59   my $tem = HTML::Template->new(filename => "error.tmpl");

60   $tem->param(reason => $mess);

61   exit;

62 }

In line 41 we are pushing onto @results a reference to an anonymous hash, the contents of which are the result of applying the map() function to the @ATTRS array. The map() block evaluates to the two-element list of attribute name (from @ATTRS), and attribute value (from the Net::LDAP::Entry object), thus giving us the key-value pair for the hash. In do_error(), we realized that the original and rather warped logic behind the return unless $mess line (line 60 in version 4) doesn't apply . . . and apparently never did, in any version of the program we have seen. Expect to find vestigial code such as this in your own inherited programs; it might once have made sense, but as soon as you are sure that it has no place in your program, get rid of it. It's your program now, and you need to know why every line of code is there.

    Previous Table of Contents Next