Документация
HTML CSS PHP PERL другое

11.10 Advanced Modification

 
Previous Table of Contents Next

11.10 Advanced Modification

Are we done yet? We could rest on our laurels . . . but something about this code is still unsatisfying. The advanced features we have added obscure what is really going on. We should make it easier to understand even at the expense of adding a few lines of code.

This will involve radical surgery. We will abstract as much as possible of the specialized LDAP code into its own module. We'll leave the handling of templates and e-mail messages to the program itself. We'll make our module a convenience wrapper around Net::LDAP; it will work like a Net::LDAP object, but with a few extra methods. We'll combine the constructor and bind() methods into one, which we'll call connect() to avoid confusion with the behavior of the Net::LDAP::new() method.

Everything to do with the attributes of an entry will go into this module, which we'll call OzLDAP. Because we still need to know the attributes, we'll provide a method attrs() to get them back, which will do double duty: Without any arguments, it will return the list of output attributes, but when handed a Net::LDAP::Entry object, it will return the list of values for the output attributes of that object. The main program now looks like this:

Example 11.16. dirsearch.cgi, Version 10

1  #!/usr/bin/perl -T

2  use strict;

3  use warnings;

4

5  use CGI qw(header param);

6  use HTML::Template;

7  use lib qw(.);

8  use OzLDAP;

9

10 my $OUTPUT_TEMPLATE = "output.tmpl";

11 my $ERROR_TEMPLATE  = "error.tmpl";

12

13 my %ERR_MAIL_ARGS = (Subject => "$0: LDAP lookup problem",

14                      To      => 'me@here');

15

16 eval

17 {

18   my $ldap = OzLDAP->connect(user_error => \&error);

19   my $res = $ldap->query(map { $_ => param($_) } param);

20

21   my $tem = HTML::Template->new(filename =>

22                                 $OUTPUT_TEMPLATE);

23

24   my @results;

25   while (my $entry = $res->shift_entry)

26   {

27     my @data = map +{ attribute => $_ }

28                => $ldap->attrs($entry);

29     push @results, { attributes => \@data };

30   }

31   $tem->param(results    => \@results,

32               filter     => $ldap->filter,

33               attributes => [ map +{ (attribute => $_) }

34                                   => $ldap->attrs ]

35              );

36   print header, $tem->output;

37 };

38 if (my $exception = $@)

39 {

40   send_email($exception);

41   error($exception);

42 }

43

44 sub error

45 {

46   my $message = shift;

47   my $tem = HTML::Template->new(filename =>

48                                 $ERROR_TEMPLATE);

49   $tem->param(reason => $message);

50   print header, $tem->output;

51   exit;

52 }

The send_email() subroutine is unchanged. However, notice how in line 18 we passed a callback to the error() subroutine as the user_error parameter to our new object constructor. The purpose of that is for handling user errors; we want any mistake made by a user to be handled by our error() routine without OzLDAP.pm having to know anything about the way we chose to do that. Speaking of which, here's that module:

Example 11.17. OzLDAP.pm

1  package OzLDAP;

2  use strict;

3  use warnings;

4

5  use Carp;

6  use Net::LDAP;

7  use Net::LDAP::Filter;

8

9  my @OUTPUT_ATTRS = qw(username location haircolor

10                       telephone email fax name);

11 my %SEARCH_ATTR = map { ($_ => 1) } qw(username location haircolor);

12 my %ERROR = (

13  TOOMANY => "Cannot lookup by >1 attribute... pick one only",

14  TOOFEW  => "Need an attribute to search on",

15  LDAPERR => "LDAP error: %s",

16  LDAPCON => "Can't connect to %s: %s"

17             );

18 my $LDAP_SERVER = "whitepages";

19 my @LDAP_OPTS = ($LDAP_SERVER, onerror => 'die',

20                  timeout => 10);

21 my %SEARCH_OPTS = (base  => "ou=People, dc=wp, dc=emerald, dc=city, dc=oz",

22                    scope => "sub", attrs => \@OUTPUT_ATTRS);

23 sub connect

24 {

25   my ($class, %opt) = @_;

26   my $error_handler = delete $opt{user_error};

27   my $self = bless { error_handler => $error_handler }, $class;

28   my $ldap = Net::LDAP->new(@LDAP_OPTS, %opt)

29     or croak _error_message(LDAPCON => $LDAP_SERVER, $@);

30   $self->{ldap} = $ldap;

31   $ldap->bind;

32   $self;

33 }

34

35 sub query

36 {

37   my ($self, %query) = @_;

38   $SEARCH_ATTR{$_} or delete $query{$_} for keys %query;

39

40   keys %query > 1 and $self->_error('TOOMANY');

41   keys %query      or $self->_error('TOOFEW');

42   my ($filter) = map "$_=$query{$_}" => keys %query;

43   $self->{filter} = $filter;

44   $self->{ldap}->search(%SEARCH_OPTS,

45          filter => Net::LDAP::Filter->new("($filter)"));

46 }

47

48 sub _error

49 {

50   my $self = shift;

51   return unless my $error_handler = $self->{error_handler};

52   $error_handler->(_error_message(@_));

53 }

54

55 sub attrs

56 {

57   my ($self, $entry) = @_;

58   $entry or return @OUTPUT_ATTRS;

59   map defined($entry->get_value($_))

60         ? $entry->get_value($_) : ''

61       => @OUTPUT_ATTRS;

62 }

63

64 sub _error_message

65 {

66   my $fmt = $ERROR{+shift};

67   sprintf $fmt, @_;

68 }

69

70 sub filter

71 {

72   my $self = shift;

73   $self->{filter};

74 }

75

76 sub AUTOLOAD

77 {

78   my $self = shift;

79   our $AUTOLOAD =~ s/.*://;

80   return if $AUTOLOAD eq 'DESTROY';

81   $self->{ldap}->$AUTOLOAD; (@_);

82 }

83

84 1;

Some notable features of this module are:

  • The _error_message() private subroutine for formatting error messages; it is used by both our private _error() method and in the event of a problem in connect().

  • The filter() method for getting back the text version of the filter the way we like it (without the external parentheses).

  • The query() method accepts a hash of names and values and uses only the ones that are valid search parameters; if later on we have reason to use a boolean combination of multiple search terms we only need to change this routine.

  • The AUTOLOAD() routine intercepts any method calls we haven't defined and delegates them to the Net::LDAP object ensconced within our OzLDAP object.

11.10.1 What Next?

At this point, many other possible changes might suggest themselves to you; there are certainly more methods we could add to OzLDAP, for instance. However, in the absence of a need for them it's not clear that the effort would be worth it.

You'd be entitled to point out at this stage that the current version of the program is not only longer than the original, but more complicated. Fair enough. But readability depends on other factors besides length, and we are more expert in Perl than the author of the original program. And in addition to cleaning up unclear and buggy code, we've added many features. We've produced a full-fledged module that both provides a foundation for code reuse (if it takes an LDAP directory to track the denizens of Oz, there are quite likely to be other uses for OzLDAP.pm) and enables us to modify our test script to test the essential search functionality independently of the CGI front end. We might easily have been justified in stopping several revisions ago.

So let's declare success at this point before getting carried away even further. Remember to add POD documentation to the program and the module!

    Previous Table of Contents Next
    © 2000- NIV