11.2 Triage

After a brief pause to vent our frustration, we check to see if the program is still working in any environment we have access to. If so, we can construct a test that will tell us at any point whether our revised versions of the program are still working:

Example 11.2. Test for dirsearch.cgi, Version 1


#!/usr/bin/perl

use strict;

use warnings;



use Test::More tests => 6;

use WWW::Mechanize;

my $URL = "http://www.city.oz/oldcode/dirsearch.cgi";

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

              location  => "Kansas",

              haircolor => "red");

my $ua = WWW::Mechanize->new;



for my $attr (keys %SEARCH)

{

  ok($ua->get("$URL?$attr=$SEARCH{$attr}")->is_success,

     "Submit okay");

  like($ua->content, qr/Dorothy Gale/, "Result okay");

}

The URL points to the location of the latest version of dirsearch.cgi as we edit it. Each different query should produce a page that contains directory search results containing at least the one person that all the query attributes are drawn from, including her full name.

Now we inspect the program for signs of its age. No need to look at its teeth this time; while the absence of use or my and the presence of local are strong hints, the dead giveaway is the duaperl in the first line. That dates it positively as Perl 4 code. The lack of warnings checking (there was no strict pragma in Perl 4), along with the fact that they did use hashes appropriately, means the programmer was about level 4.

En route to making this program maintainable, there are many problems with it that we should fix:

There are many constants, configurable data, and magic numbers spread throughout the code.
The HTML output is interwoven into the code instead of being easily viewed and edited.
There are several hidden dependencies and other fragilities in the code.
The code makes no attempt to secure itself against malicious inputs.

We will attack these problems through a process of successive refinement called refactoring (see [CHROMATIC03] for a concise discussion of this term and [FOWLER99] for a complete exposition). At each stage we will be applying more advanced techniques to gain greater advantages of maintainability; in practice, you might not carry a project as far as this one goes, depending on how much time and expertise you have at your disposal.

Let's get started by using line editing to compress the program to make it easier to read. Along the way, we'll make the executive decision that we can change the HTML output if we want as long as it still looks the same in a browser. So insignificant white space, in particular line breaks, don't have to match the original output. (Anyone who is depending on the formatting of white space in HTML deserves to have their cage rattled, anyway.)

Lines 32–35 are identical to the function of the do_error() subroutine, so we can call that routine instead. A couple of places call do_error() and do_email() in succession with the same message, so we can make a subroutine just for that purpose. The repetition in lines 40–46, 52–58, and 59–61 can be removed with map().

Example 11.3. dirsearch.cgi, Version 2


1  #!/usr/local/bin/duaperl

2

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 &dua_settmout(10, 0);

14 unless (&dua_open("whitepages", 389, $dn, $pwd))

15 {

16   $msg = "Can't connect to whitepages: $dua_errstr";

17   do_email_error($msg);

18 }

19 $scope = 1;

20 $all = 0;

21 $rdn = '@dc=oz@dc=city@dc=emerald@dc=wp@ou=People';

22 %list = &dua_find($rdn, $filter, $scope, $all);

23 if ($dua_errstr)

24 {

25   do_email_error($dua_errstr);

26 }

27 unless (%list)

28 {

29   do_error("No match for $filter");

30 }

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

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

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

34 my @attrs = qw(username location haircolor

35                telephone email fax name);

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

37 print "</TR>\n";

38 foreach $i (sort { $a <=> $b } keys %list)

39 {

40   $dn = "\@". join("\@", reverse(split(/,\s*/, $list{$i)));

41   %attr = &dua_show($dn);

42   print "<TR>", map "<TD>$attr{$_}</TD>", @attrs;

43 }

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

45

46 &dua_close();

47

48 sub do_email_error

49 {

50   my $mess = shift;

51   do_email($mess);

52   do_error($mess);

53 }

The do_error() and do_email() routines are as yet unchanged and therefore are not shown.

Table of Contents