February 2006 Archives

Advanced Subroutine Techniques

In "Making Sense of Subroutines," I wrote about what subroutines are and why you want to use them. This article expands on that topic, discussing some of the more common techniques for subroutines to make them even more useful.

Several of these techniques are advanced, but you can use each one by itself without understanding the others. Furthermore, not every technique is useful in every situation. As with all techniques, consider these as tools in your toolbox, not things you have to do every time you open your editor.

Named Arguments

Positional Arguments

Subroutines, by default, use "positional arguments." This means that the arguments to the subroutine must occur in a specific order. For subroutines with a small argument list (three or fewer items), this isn't a problem.

sub pretty_print {
    my ($filename, $text, $text_width) = @_;

    # Format $text to $text_width somehow.

    open my $fh, '>', $filename
        or die "Cannot open '$filename' for writing: $!\n";

    print $fh $text;

    close $fh;

    return;
}

pretty_print( 'filename', $long_text, 80 );

The Problem

However, once everyone starts using your subroutine, it starts expanding what it can do. Argument lists tend to expand, making it harder and harder to remember the order of arguments.

sub pretty_print {
    my (
        $filename, $text, $text_width, $justification, $indent,
        $sentence_lead
    ) = @_;

    # Format $text to $text_width somehow. If $justification is set, justify
    # appropriately. If $indent is set, indent the first line by one tab. If
    # $sentence_lead is set, make sure all sentences start with two spaces.

    open my $fh, '>', $filename
        or die "Cannot open '$filename' for writing: $!\n";

    print $fh $text;

    close $fh;

    return;
}

pretty_print( 'filename', $long_text, 80, 'full', undef, 1 );

Quick--what does that 1 at the end of the subroutine mean? If it took you more than five seconds to figure it out, then the subroutine call is unmaintainable. Now, imagine that the subroutine isn't right there, isn't documented or commented, and was written by someone who is quitting next week.

The Solution

The most maintainable solution is to use "named arguments." In Perl 5, the best way to implement this is by using a hash reference. Hashes also work, but they require additional work on the part of the subroutine author to verify that the argument list is even. A hashref makes any unmatched keys immediately obvious as a compile error.

sub pretty_print {
    my ($args) = @_;

    # Format $args->{text} to $args->{text_width} somehow.
    # If $args->{justification} is set, justify appropriately.
    # If $args->{indent} is set, indent the first line by one tab.
    # If $args->{sentence_lead} is set, make sure all sentences start with
    # two spaces.

    open my $fh, '>', $args->{filename}
        or die "Cannot open '$args->{filename}' for writing: $!\n";

    print $fh $args->{text};

    close $fh;

    return;
}

pretty_print({
    filename      => 'filename',
    text          => $long_text,
    text_width    => 80,
    justification => 'full',
    sentence_lead => 1,
});

Now, the reader can immediately see exactly what the call to pretty_print() is doing.

And Optional Arguments

By using named arguments, you gain the benefit that some or all of your arguments can be optional without forcing our users to put undef in all of the positions they don't want to specify.

Validation

Argument validation is more difficult in Perl than in other languages. In C or Java, for instance, every variable has a type associated with it. This includes subroutine declarations, meaning that trying to pass the wrong type of variable to a subroutine gives a compile-time error. By contrast, because perl flattens everything to a single list, there is no compile-time checking at all. (Well, there kinda is with prototypes.)

This has been such a problem that there are dozens of modules on CPAN to address the problem. The most commonly recommended one is Params::Validate.

Prototypes

Prototypes in Perl are a way of letting Perl know exactly what to expect for a given subroutine, at compile time. If you've ever tried to pass an array to the vec() built-in and you saw Not enough arguments for vec, you've hit a prototype.

For the most part, prototypes are more trouble than they're worth. For one thing, Perl doesn't check prototypes for methods because that would require the ability to determine, at compile time, which class will handle the method. Because you can alter @ISA at runtime--you see the problem. The main reason, however, is that prototypes aren't very smart. If you specify sub foo ($$$), you cannot pass it an array of three scalars (this is the problem with vec()). Instead, you have to say foo( $x[0], $x[1], $x[2] ), and that's just a pain.

Prototypes can be very useful for one reason--the ability to pass subroutines in as the first argument. Test::Exception uses this to excellent advantage:

sub do_this_to (&;$) {
    my ($action, $name) = @_;

    $action->( $name );
}

do_this_to { print "Hello, $_[0]\n" } 'World';
do_this_to { print "Goodbye, $_[0]\n" } 'cruel world!';

Context Awareness

Using the wantarray built-in, a subroutine can determine its calling context. Context for subroutines, in Perl, is one of three things--list, scalar, or void. List context means that the return value will be used as a list, scalar context means that the return value will be used as a scalar, and void context means that the return value won't be used at all.

sub check_context {
    # True
    if ( wantarray ) {
        print "List context\n";
    }
    # False, but defined
    elsif ( defined wantarray ) {
        print "Scalar context\n";
    }
    # False and undefined
    else {
        print "Void context\n";
    }
}

my @x       = check_context();  # prints 'List context'
my %x       = check_context();  # prints 'List context'
my ($x, $y) = check_context();  # prints 'List context'

my $x       = check_context();  # prints 'Scalar context'

check_context();                # prints 'Void context'

For CPAN modules that implement or augment context awareness, look at Contextual::Return, Sub::Context, and Return::Value.

Note: you can misuse context awareness heavily by having the subroutine do something completely different when called in scalar versus list context. Don't do that. A subroutine should be a single, easily identifiable unit of work. Not everyone understands all of the different permutations of context, including your standard Perl expert.

Instead, I recommend having a standard return value, except in void context. If your return value is expensive to calculate and is calculated only for the purposes of returning it, then knowing if you're in void context may be very helpful. This can be a premature optimization, however, so always measure (benchmarking and profiling) before and after to make sure you're optimizing what needs optimizing.

Mimicking Perl's Internal Functions

A lot of Perl's internal functions modify their arguments and/or use $_ or @_ as a default if no parameters are provided. A perfect example of this is chomp(). Here's a version of chomp() that illustrates some of these techniques:

sub my_chomp {
    # This is a special case in the chomp documentation
    return if ref($/);

    # If a return value is expected ...
    if ( defined wantarray ) {
        my $count = 0;
        $count += (@_ ? (s!$/!!g for @_) : s!$/!!g);
        return $count;
    }
    # Otherwise, don't bother counting
    else {
        @_ ? do{ s!$/!!g for @_ } : s!$/!!g;
        return;
    }
}
  • Use return; instead of return undef; if you want to return nothing. If someone assigns the return value to an array, the latter creates an array of one value (undef), which evaluates to true. The former will correctly handle all contexts.
  • If you want to modify $_ if no parameters are given, you have to check @_ explicitly. You cannot do something like @_ = ($_) unless @_; because $_ will lose its magic.
  • This doesn't calculate $count unless $count is useful (using a check for void context).
  • The key is the aliasing of @_. If you modify @_ directly (as opposed to assigning the values in @_ to variables), then you modify the actual parameters passed in.

Conclusion

I hope I have introduced you to a few more tools in your toolbox. The art of writing a good subroutine is very complex. Each of the techniques I have presented is one tool in the programmer's toolbox. Just as a master woodworker wouldn't use a drill for every project, a master programmer doesn't make every subroutine use named arguments or mimic a built-in. You must evaluate each technique every time to see if it will make the code more maintainable. Overusing these techniques will make your code less maintainable. Using them appropriately will make your life easier.

Managing Rich Data Structures

As a Perl beginner, I wrote many scripts that created text files to store snippets of data. Eventually I had hundreds of little text files in a data directory, each one holding one piece of information in the form of a text string. I decided to move from snippets to a single database. Here's how I did it.

I didn't go all the way to creating a relational database with SQL, in part because I had not yet learned to use Perl modules to work with such databases. Plus I wanted to try the apparently simpler technique described in Chapters 11 and 14 of Perl Cookbook, 2nd Edition, namely the use of one of the DBM libraries. I was intrigued by the idea of creating and using a database without needing to learn SQL or run a database server such as PostgreSQL or MySQL.

One of my scripts created HTML for a clickable banner ad; the HTML would be inserted into an HTML email newsletter I publish daily. For any particular issue, the script pulled data from three different text files, each of which held a different piece of information in the form of a text string on the file's first and only line:

  • The URL of the advertiser's web page, to which the reader would be taken when the banner is clicked,
  • The location of the .gif file (the banner), or
  • A one-line headline that would appear above the banner.

A different script created those files and named them according to (i) the type of data in the file and (ii) the date of the newsletter in which the ad would appear. For example, data for the December 9, 2005 ad was contained in three files named url_2005_12_09, gif_2005_12_09 and headline_2005_12_09.

A Hash of Hashes

First I considered the kind of data structure needed to hold the data. I looked at the relationship between the three text files. It became clear that I basically had a hash for each ad. The data for any particular ad consisted of three different keys and their values: URL, gif and headline. The name of any particular file would provide the key (the type of information contained in the file). The contents of the file would provide the key's value.

I thought about finding some way to store those hashes as an array of anonymous hashes (one hash per ad), but then I realized that an array wouldn't let me access a particular ad's data easily. The hashes would be in the order in which I saved them into the array, but that wouldn't translate easily to the ad for a particular date. For example, how would I know where to find the data for next Monday's newsletter? Is it in $array[8] or $array[17]?

Hmm. Each anonymous hash could be identified by a particular date--the key (!) to locating the ad for any particular date. What kind of data structure associates a unique key with a value? A hash, of course! My data would fit nicely into a hash of hashes.

The name I chose for the hash was %data_for_ad_on. Choosing a hash name that ends in a preposition provides a more natural-reading and meaningful name; the key for data for the December 8, 2005 banner ad would be 2005_12_08, for example, and the way to access the value associated with that key would be $data_for_ad_on{2005_12_08}.

In code, this is how the data for two days of newsletters could be represented as a hash of hashes:

%data_for_ad_on = (

  '2005_12_08' => { 'url'      => 'http://roadrunners-r-us.com/index.html',
                    'gif'      => 'http://myserver.com/banners/roadrunners_banner.gif',
                    'headline' => 'Use Roadrunners R Us for speedy, reliable deliveries!',
                  },

  '2005_12_09' => { 'url'      => 'http://acme.com/index.html',
                    'gif'      => 'http://myserver.com/banners/acme_banner.gif',
                    'headline' => 'Look to Acme for quality, inexpensive widgets!',
                  },
);

The keys of the named hash are 2005_12_08 and 2005_12_09. Each key's value is a reference to an anonymous hash that contains its own keys and values. When a hash is created using braces instead of parentheses, its value is a reference to that unnamed, "anonymous" hash. I need to use a reference because a hash is permitted to contain only scalar keys and scalar values; another hash can't be stored as a value. A reference to that hash works, because it acts like a scalar.

Storing the Data

Now I knew what the data structure would be; but how would I store it? Being Perl, of course there's more than one way to store data to disk. Some of those solutions involve the parsing of potentially large amounts of data and then the need to programmatically find a particular desired piece of data, however.

I came across a single-file database solution in Recipes 11.14 and 14.6 of Perl Cookbook, 2nd Edition. These describe the use of a DBM file on disk. A Perl script can read data from a DBM file as if it were contained in a hash in memory. For data having unique keys, it's a great fit. In addition to data persistence from one run of your script to the next, using a DBM database file means your script won't need to read all the data into memory. Instead, you pull up only data associated with a particular key. This applies especially to large data sets; a DBM database file on disk might hold data for hundreds of thousands of keys.

A straightforward but tedious way to get data into a DBM file is shown below. The code creates a database called ad_data.db and inserts data for two newsletters.

#!/usr/local/bin/perl
use strict;
use warnings;
use MLDBM qw( DB_File Storable );
use Fcntl qw( :flock O_CREAT O_RDWR );

my $db = '/www/cgi-bin/databases/ad_data.db';
my %data_for_ad_on;

tie %data_for_ad_on, 'MLDBM', $db, O_CREAT|O_RDWR, 0644
  or die "Trouble opening $db, stopped: $!";

%data_for_ad_on = (
  '2005_12_09' => { 'url'      => 'http://acme.com/index.html',
                    'gif'      => 'http://myserver.com/banners/acme_banner.gif',
                    'headline' => 'Look to Acme for quality, inexpensive widgets!',
                  },

  '2005_12_08' => { 'url'      => 'http://roadrunners-r-us.com/index.html',
                    'gif'      => 'http://myserver.com/banners/roadrunners_banner.gif',
                    'headline' => 'Use Roadrunners R Us for speedy, reliable deliveries!',
                  },
);

After the script is run, the data contained in %data_for_ad_on are saved automatically into the DBM database file named /www/cgi-bin/databases/ad_data.db.

The secret is Perl's tie function. It associates a particular hash (here named %data_for_ad_on ) with a "class" and a file. A class that works for "complex" data (data containing references) is the MLDBM module, available from CPAN.

Note: if the values being stored are scalars only, a tied hash using the DB_File module as the class, rather than the MLDBM module, will be much easier to work with. I'm using MLDBM because my values include references to data structures. I'll discuss some of MLDBM's limitations later in this article.

The script shown above uses the Fcntl module to make it easier to create or update the DBM database file. The imported O_CREAT|O_RDWR parameters tell the script to create the database file if it doesn't yet exist or to update (read/write) the file if it exists.

The DB_File and Storable parameters passed to MLDBM specify the particular kind of DBM database to use and the serialization module to use. They handle the behind-the-scenes conversion of references into strings. (A recent version of MLDBM is necessary to be able to specify such parameters.) DB_File won't work with every system, however, because it depends upon your system's configuration, like all DBM modules. In particular, the Berkeley DB library (a C library) must be present; see the DB_File documentation for details. You can get another DBM module from CPAN if DB_File won't work for you.

Manually entering hash keys and their values into a script is time-consuming and error-prone, of course. I prefer to programmatically add data created or copied from existing files, and used a script to copy data from my hundreds of text files into the DBM database file.

#!/usr/local/bin/perl -T
use strict;
use warnings;
use MLDBM qw( DB_File Storable );
use Fcntl qw( :flock O_CREAT O_RDWR );

my $db = '/www/cgi-bin/databases/ad_data.db';
my %data_for_ad_on;

tie %data_for_ad_on, 'MLDBM', $db, O_CREAT|O_RDWR, 0644
  or die "Can't open $db: $!";

my $data_dir = '/www/cgi-bin/newsletter_data_text_files';

opendir my $dir_handle, $data_dir
  or die "Can't open $data_dir, stopped: $!";

# All of the data files are in the same directory; each file's name
# is url_YYYY_MM_DD, gif_YYYY_MM_DD or headline_YYYY_MM_DD (where
# YYYY is the year, MM is the month, with a leading zero if needed,
# and DD is the day of the month, with a leading zero if needed).
# No other files in that directory end with YYYY_MM_DD.

my @data_files = grep { /\d\d\d\d_\d\d_\d\d$/ } readdir $dir_handle;

close $dir_handle;

my $entry;
foreach my $file ( @data_files ) {

  # Test the filename to see if the file contains the advertiser's
  # URL...

  if ($file =~ /^url_(\d\d\d\d_\d\d_\d\d)/ ) {

      $entry = $data_for_ad_on{$1};

      open (FILE, "$data_dir/$file") or die;
      my $url = do { local $/; <FILE> };
      close FILE;

      $entry->{url}       = $url;
      $data_for_ad_on{$1} = $entry;
      print "Advertiser's URL for $1 has been saved.\n";

  # Test the filename to see if the file contains the .gif location...

  } elsif ($file =~ /^gif_(\d\d\d\d_\d\d_\d\d)/ ) {

      $entry = $data_for_ad_on{$1};

      open (FILE, "$data_dir/$file") or die;
      my $gif = do { local $/; <FILE> };
      close FILE;

      $entry->{gif}       = $gif;
      $data_for_ad_on{$1} = $entry;
      print ".gif file location for $1 has been saved.\n";

  # Test the filename to see if the file contains the headline...

  } elsif ($file =~ /^headline_(\d\d\d\d_\d\d_\d\d)/ ) {

      $entry = $data_for_ad_on{$1};

      open (FILE, "$data_dir/$file") or die;
      my $headline = do { local $/; <FILE> };
      close FILE;

      $entry->{headline}  = $headline;
      $data_for_ad_on{$1} = $entry;
      print "Headline for $1 has been saved.\n";
  }

}

A limitation of MLDBM is that you can't work piecemeal with the data structures (the values for keys in the tied hash). You must retrieve a copy of the data structure in the form of a reference ($entry in the example); use that reference to add, update or delete parts of the data structure; and then save the reference back to the database in order for MLDBM to put the changed data structure back onto disk. This is because the data structure is no longer tied, once it has been retrieved from disk.

For example, the script above works piecemeal with the data structure: it builds one key at a time in the anonymous hash. A temporary variable called $entry holds a reference to the retrieved anonymous hash, which now exists in memory; then $entry is used to dereference the anonymous hash (and to select a named key in the hash, on the right side of the infix operator); then the script alters a part of that data structure (assigning a value to the named key); then the now-changed anonymous hash is saved back into the database file on disk by assigning $entry to the key.

As shown in earlier examples, an entire data structure can be stored as the value of a key in the tied hash without fetching the existing data structure (if any) associated with that key. In such a case, you're overwriting any existing data structure completely, so there is no need to fetch the existing data structure first or to work with it using the temporary variable technique.

Note: a recently added CPAN module called DBM_Deep allows tied hashes of complex data as does MLDBM, but appears to avoid the need for fetching data first in order to work with it through a temporary variable.

By the way, MLDBM allows stored data structures to be arrays, not just hashes. Hence MLDBM might be a good disk-based storage solution for you if a hash of arrays works best to hold your data. Plus, whether you're storing a hash of hashes or a hash of arrays, those stored hashes or arrays are permitted to contain values that consist of even more hashes or arrays!

Another thing to know about MLDBM is that file locking is not provided automatically. The solution presented in this article works well in a single-user environment, but data corruption is possible when more than one instance of the script (or more than one script) needs to access the disk-based data while another process is writing to it. See section 10.2.1 of CGI Programming with Perl for an example of file locking with the DB_File DBM module.

Reading HoH Data

Here is a portion of a script that prints a report for my stored newsletter data.

I reach into the %data_for_ad_on hash by specifying a key (the date of a particular newsletter); the key's associated value is a reference to the anonymous hash holding ad data for that date. Use infix (arrow) notation to dereference the anonymous hash and also to access a specified key.

tie %data_for_ad_on, 'MLDBM', $db, O_RDWR, 0644
  or die "Can't open $db: $!";

my @newsletter_dates = sort keys %data_for_ad_on;

foreach my $date ( @newsletter_dates ) {

   my $url      = $data_for_ad_on{$date}->{url};
   my $gif      = $data_for_ad_on{$date}->{gif};
   my $headline = $data_for_ad_on{$date}->{headline};

   print "\nHere are details for the banner ad in the $date newsletter:\n";
   print "          Advertiser's URL: $url\n";
   print "        Location of banner: $gif\n";
   print "     Headline above banner: $headline\n";
}

A temporary variable to work with the data was unnecessary because I was merely reading data. I had no need to save a changed data structure back to disk after working with it. A temporary variable would be needed as a reference to the data structure, as noted earlier, if I were adding, updating or deleting something in the data structure, in order to save the changed data structure back to disk.

Nevertheless, a temporary variable is useful for storing a fetched data structure even when a tied hash is being used only to read data from disk. The MLDBM documentation points out that disk fetch occurs each time a script names a key in the tied hash; a new copy of the entire data structure for that key gets created with each fetch. For efficiency, scripts that merely read data work better if the data structure for a particular key is stored first into a temporary variable and the script works with that single copy of data in memory. For example, the lines in the preceding code that get values for $url, $gif, and $headline should be rewritten to cut the number of fetches from three to one:

   my $entry    = $data_for_ad_on{$date};
   my $url      = $entry->{url};
   my $gif      = $entry->{gif};
   my $headline = $entry->{headline};

Updating HoH Data

My next task was to update existing data. An advertiser informed me that its web page had changed. The advertiser's banner ad in a particular upcoming newsletter needed to point to the new page rather than to the URL I had stored earlier for the ad. So I tried this:

tie %data_for_ad_on, 'MLDBM', $db, O_CREAT|O_RDWR, 0644
  or die "Can't open $db: $!";

$data_for_ad_on{'2005_12_14'}->{url}
  = 'http://roadrunners-r-us.com/new_home_page.html';   # WRONG

Despite the apparently correct syntax, the line marked "# WRONG" did not change the data in the tied hash. MLDBM can't add, update or delete just a part of a data structure stored on disk; it must retrieve the entire data structure first. Unfortunately that doesn't happen automatically when a part of the tied hash is used as an lvalue (the left side of an assignment).

Here is the correct syntax for updating part of a data structure:

my $entry = $data_for_ad_on{'2005_12_14'};                        # Get
$entry->{url} = 'http://roadrunners-r-us.com/new_home_page.html'; # Change
$data_for_ad_on{'2005_12_14'} = $entry;                           # Save

A different kind of update would be to add a new kind of information to an existing data structure. Until now I have been working with each ad's data as an anonymous hash of three keys because I only had three pieces of information per ad. Here's how I can modify the data structure for any particular ad--that is, the value of any particular key in the tied hash--to include a fourth piece of information. I'll record whether or not a particular ad has been billed.

tie %data_for_ad_on, 'MLDBM', $db, O_CREAT|O_RDWR, 0644
  or die "Can't open $db: $!";

my $entry = $data_for_ad_on{'2005_12_02'};  # Get
$entry->{has_been_billed} = 'yes';           # Change (by creating a key and value)
$data_for_ad_on{'2005_12_02'} = $entry;      # Save

Adding a fourth key as shown is not remarkable because it's done the same way I created the original three keys. But note how I've added a fourth key to just one of the ads (for the 2005_12_02 newsletter). I don't need to define such a fourth key in each of the other anonymous hashes because MLDBM doesn't require that the anonymous hashes have the same structure.

Now that I've added a fourth key to one of the ads, I want to see that key's information when I run my report, even though the information for each of the other newsletters is incomplete. Just as with a hash in memory, the exists operator can test for the existence of a key in a tied hash, or test for the existence of a key in one of the stored anonymous hashes. The earlier reporting script can be improved:

foreach my $date ( @newsletter_dates ) {

   my $entry    = $data_for_ad_on{$date};
   my $url      = $entry->{url};
   my $gif      = $entry->{gif};
   my $headline = $entry->{headline};

   my $has_been_billed = exists ( $entry->{has_been_billed} ) ?
                         $entry->{has_been_billed}
                         : 'Billing status is unknown';

   print "\nHere are details for the banner ad in the $date newsletter:\n";
   print "            Advertiser's URL: $url\n";
   print "          Location of banner: $gif\n";
   print "       Headline above banner: $headline\n";
   print "  Has advertiser been billed? $has_been_billed\n";
}

Note how a default value is provided for $has_been_billed (the string 'Billing status is unknown'). If $entry->{has_been_billed} had been assigned to $has_been_billed without providing a default value, the script (if it is using the warnings pragma) would report "Use of uninitialized value in concatenation (.) or string" every time it processes the "Has advertiser been billed?" statement for an anonymous hash that has no 'has_been_billed' key. The value of a nonexistent key in a hash is undefined, whether or not the hash is tied.

Because the value of a nonexistent key in a hash is undefined, remember when working with MLDBM not to assume your tied hash's keys will return either a reference to a data structure or a reference to an empty data structure. For example, this code produces a runtime error if the '2005_12_32' key does not exist in the tied hash (there is no December 32) and the script is using the strict pragma:

my $entry = $data_for_ad_on{2005_12_32};
my %named_hash = %{ $entry };

if ( $named_hash{url} ) {
    print "The advertiser's URL for the ad dated 2005_12_32 is $named_hash{url}.\n";

} else {
    print "We have no URL on file for the ad dated 2005_12_32.\n";
}

The runtime error would be 'Can't use string ("") as a HASH ref while "strict refs" in use' on the line number of my %named_hash = %{ $entry }. The code doesn't create a named hash that has no elements.

Conclusion

I hope this article helps you move from a swamp of weedy text files into the simplicity of a single disk-based database file. A DBM database file enables you to work with your data as if it were a single hash of keys and their values.

The MLDBM module extends the "hash on a disk" capability by letting you store a key's value as a hash, as illustrated in this article, or store a key's value as an array.

MLDBM requires a special technique for working piecemeal with stored hashes (or stored arrays). Also, the solution described works well in my single-user environment; file locking to protect the disk-based data would become important in a multi-user environment such as a script executed by a publicly accessible web server. Still, you get all this hash-like goodness for key-based data without running a relational database server or using SQL, without parsing large amounts of disk-based data, and without storing all the data in memory first.

Happy hashing!

Debugging and Profiling mod_perl Applications

Because of the added complexity of being inside of the Apache web server, debugging mod_perl applications is often not as straightforward as it is with regular Perl programs or CGIs. Is the problem with your code, Apache, a CPAN module you are using, or within mod_perl itself? How do you tell? Sometimes traditional debugging techniques will not give you enough information to find your problem.

Perhaps, instead, you're baffled as to why some code you just wrote is running so slow. You're probably asking yourself, "Isn't this mod_perl stuff supposed to improve my code's performance?" Don't worry, slow code happens even to the best of us. How do you profile your code to find the problem?

This article shows how to use the available CPAN modules to debug and profile your mod_perl applications.

Traditional Debugging Methods

The tried-and-true print statement is the debugger's best friend. Used wisely this, can be the easiest and fastest way of figuring out what is amiss in your program. Can't figure out why your sales tax subroutine is always off by 14 cents? Add several print statements just before, just after, and all around inside of that particular subroutine. Use them to show the value of key variables at each step in the process. You can direct the output straight onto the page in your browser, or if you prefer, into hidden HTML comments. Typically this is all that you need to spot your problems. It's flexible and easy to implement and understand.

Another common approach is to place die() and/or warn() statements as you trace through your code, isolating the problem. die() is especially useful if you do not want your program to continue executing, possibly because the errors will corrupt your otherwise valid testing data. The main benefit of using warn over a simple print statement is that the output goes instead to the appropriate Apache error_log. This keeps your debugging information out of the user interface and gives you the ability to log and spot errors long after they occurred for the user. Simply tail your error_log in another window and you can watch it all day long. If you're into that sort of thing.

For example, if you had some code like:

sub handler {
    my $r   =   shift;

    # Set content type
    $r->content_type( 'text/html' );

    my $req = Apache2::Request->new($r);
   
    # Compute sales tax if we are told to do so
    my $tax = 0;
    if( $req->param('compute_sales_tax') ) {
        my $tax = compute_sales_tax($r, $req->param('total_amount');
    }

    # Code to display results to the browser....
}

... you might find a problem during testing. Your initial search leads you to believe that either the code never calls the compute_sales_tax() function or the function always returns zero. You can add some simple debugging statements:

sub handler {
    my $r   =   shift;
   
    # Set content type
    $r->content_type( 'text/html' );

    my $req = Apache2::Request->new($r);
   
    # Compute sales tax if we are told to do so
    my $tax = 0;

    # Debugging statements
    warn("Tax at start '$tax'");
    warn('compute_sales_tax ' . $req->param('compute_sales_tax') );

    if( $req->param('compute_sales_tax') ) {

        # Debugging
        warn("Tax before sub '$tax'");
        my $tax = compute_sales_tax($r, $req->param('total_amount');
        warn("Tax after sub '$tax'");
    }

    warn("Tax after if '$tax'");

    # Code to display results to the browser....
}

Assuming that the page that directs the user to this code has set compute_sales_tax to a true value, you will see something similar to:

Tax at start '0' at line 5
compute_sales_tax 1 at line 6
Tax before sub '0' at line 12
Tax after sub '1.36' at line 14
Tax after if '0' at line 17

If you read through this, you see that compute_sales_tax() is indeed being called, otherwise you would not see the "Tax before/after" warn outputs. Directly after the subroutine call you can see that $tax holds a suitable value. However, after the if block, $tax reverts back to zero. Upon closer examination, you might find that the bug is the my before the call to compute_sales_tax(). This creates a locally scoped variable named $tax and does not assign it to the $tax variable in the outer block, which causes it to stay zero and makes it seem that compute_sales_tax() was never called.

When to Use Apache::DB

Using print, die, and warn statements in your code will help you find and fix 99 percent of the bugs you may run across when building mod_perl applications. Too bad there is still that pesky remaining 1 percent that will make you tear your hair out in clumps and wish you had gone into selling insurance instead of programming. Luckily there is Apache::DB to help keep the glare off our collective heads at next year's Perl conference to a minimum.

Sometime, despite all of your attempts to see what is going wrong, you will find yourself in a situation where:

  • Your code causes Apache to segfault and you can't for the life of you figure out why.
  • It appears that your code segfaults inside of a subroutine or method you are calling in a CPAN module you are using.
  • You have more debugging statements than actual code.

You could spend time hacking up your other installed modules, such as those from CPAN, with debugging statements--but this only means you will have to return later and remove all of it. You could take an easier route and debug your mod_perl application with a real source debugger.

Using the Perl debugger allows you to see directly into what is happening to your code and data. You can step through your code line by line, as Perl executes it. Because you are following the same flow, there is no chance that you are making any bad assumptions. You might even consider it WYSIWYG, albeit without a GUI.

Using Apache::DB

While Apache::DB works with both mod_perl 1.x and mod_perl 2.x, all of the examples in this article use mod_perl 2.0. Once you have installed Apache::DB from CPAN, using it is fairly simple. It does, however, require that you make a few Apache configuration changes. Assuming you have a mod_perl handler installed at /modperl/ on your system, your configuration needs to resemble this:

<Location /modperl>
  SetHandler perl-script
  PerlResponseHandler My::Modperl::Handler
  PerlFixupHandler +Apache::DB
</Location>

You also need to modify either the appropriate <Perl></Perl> section or your startup.pl file to include:

use APR::Pool ();
use Apache::DB ();
Apache::DB->init();

If you are working in a mod_perl 1.0 environment, the only change is that you should not include the use APR::Pool (); directive.

Note that you must call Apache::DB->init(); prior to whatever code you are attempting to debug. To be safe, I always just put it as the very first thing in my startup.pl.

Once you have modified your configuration, the last step is to launch your Apache server with the -X command-line option. This option tells Apache to launch only one back-end process and to not fork into the background. If you don't use this option, you can't guarantee that your debugger has connected to same Apache child as your browser.

With this Apache daemon tying up your command prompt, simply browse to your application. As you will see, the shell running httpd has been replaced with a Perl debugging session. This debugging session is tied directly to your application and browser. If you look at your browser it will appear to hang waiting for a response; this is due to the fact your Apache server is waiting on you to work with the debugger.

Perl's debugger is very similar to other debuggers you may have used. You can step through your code line by line, skip entire subroutines, set break points, and display and/or change the value of variables with it.

It might be useful to read through man perldebtut, a introductory tutorial on using the debugger. For a more complete reference to all of the available commands, see man perldebug. This list should be just enough to get you started:

Command Description
expression This prints out the value of an expression or variable, just like the print directive in Perl.
expression This evaluates an expression and prettily prints it for you. Use it to make complex data structures readable.
s This tells the debugger to take a single step. A step is a single statement. If the next statement is a subroutine, the debugger will treat it as only one statement; you will not be able to step through each statement of that subroutine and the flow will continue without descending into it.
n This tells the debugger to go to the next statement. If the next statement is a subroutine, you will descend into it and be able to step through each line of that subroutine.
line Display a particular line of source code.
M Display all loaded modules.

Code Profiling with Apache::DProf

Apache::DProf provides the necessary hooks for you to get some coarse profiling information about your code. By coarse, I mean only information on a subroutine level. It will show you the number of times a subroutine is called along with duration information.

Essentially, Apache::DProf wraps Devel::DProf for you, making your life much easier. It is possible to use Devel::DProf by itself, but it assumes that you are running a normal Perl program from the command line and not in a persistent mod_perl environment. This isn't optimal, because while you can shoehorn Devel::DProf into working, you'll end up profiling all of the code used at server startup when you really only care about the runtime code.

Using Apache::DProf is relatively straightforward. All you need to do is include PerlModule Apache::DProf in your httpd.conf and restart your server.

As an example, here's a small application to profile. This code, while not all that useful, will help illustrate the major differences between these two profiling modules:

package PerlTest;

sub handler {
    my $r = shift;
  
    $r->content_type( 'text/plain' );
  
    handle_request($r);

    return( Apache2::Const::OK );
}

sub handle_request {
    my $r = shift;

    $r->print( "Handling request....\n" );

    cleanup_request($r);

}

sub cleanup_request {
    my $r = shift;

    $r->print( "Cleaning up request....\n" );

    sleep(5);     # Take some time in this section
}

1;

When you profile a module with Apache::Dprof, it will create a directory named dprof/ in your server's logs/ directory. Under this directory will be subdirectories named after the PID of each Apache child your server has. This allows you to profile code over a long period of time on a production system to see where your real bottlenecks are. Often, faking a typical user session does not truly represent how your users interact with your application and having the real data is beneficial.

After your server has run for a while, you need to stop it and revert your configuration, removing the PerlModule Apache::DProf you just inserted. This is due to the fact that Apache::DProf does not write its data to disk until the server child ends.

Viewing the profiling data is exactly the same as with Devel::DProf. Choose a particular Apache child directory in $SERVER_ROOT/logs/dprof/ and run dprofpp on the corresponding tmon.out file.

After beating on the code sample above for awhile with ab, here are the results Apache::DProf gave me:

Total Elapsed Time = 1082.402 Seconds
  User+System Time =        0 Seconds
Exclusive Times
%Time ExclSec CumulS #Calls sec/call Csec/c  Name
 0.00   0.004  0.001    687   0.0000 0.0000  RevSys::PerlTest::cleanup_request
 0.00       - -0.000      1        -      -  warnings::import
 0.00       - -0.000      1        -      -  APR::Pool::DESTROY
 0.00       - -0.000      1        -      -  strict::import
 0.00       - -0.000      1        -      -  Apache2::XSLoader::load
 0.00       - -0.000      3        -      -  Apache2::RequestIO::BEGIN
 0.00       - -0.000      2        -      -  RevSys::PerlTest::BEGIN
 0.00       - -0.003    687        -      -  Apache2::RequestRec::content_type
 0.00       - -0.006   1374        -      -  Apache2::RequestRec::print
 0.00       - -0.012    687        -      -  RevSys::PerlTest::handle_request
 0.00       - -0.024    687        -      -  RevSys::PerlTest::handler

As expected, cleanup_request() shows the most time used per call. The report also shows stats for the other function calls you would expect as well as the ones that happen behind the scenes.

Code Profiling with Apache::SmallProf

While Apache::DProf will show you which subroutines use the most system resources, sometimes that is not enough information. Apache::SmallProf gives you fine-grained details in a line-by-line profile of your code.

Setup is similar to both of two previous modules. Add into a <Perl> section or your startup.pl file the code:

use APR::Pool ();
use Apache::DB ();
Apache::DB->init();

You also need to add PerlFixupHandler Apache::SmallProf into the <Directory> or <Location> block that refers to your mod_perl code.

Like Apache::DProf, Apache::SmallProf writes all of the profiling data into $SERVER_ROOT/logs/smallprof/. One interesting difference between Apache::DProf and Apache::SmallProf is that the latter writes a profile for each module in use. This is helpful because you already know which subroutines are slow and which packages they are in, from your first round of profiling with Apache::DProf. By focusing on those modules you can find your troubled code much faster.

Viewing Apache::SmallProf data is, however, a little different from Apache::DProf. A module profile looks like this:

<number> <wall time> <cpu time> <line number> <source line>

<number> is the number of times this particular line was executed, <wall time> is the actual time passed, and <cpu time> is the amount of time the CPU spent working on that line. The remaining two pieces of data are the line number in the file and the actual source on that line.

You can just open up the profiles generated by Apache::SmallProf and look at the results. However, this doesn't get to the heart of the matter very quickly. Sorting the profile by the amount of time spent on each line gets you where you want to go:

$ sort -nrk 2 logs/smallprof/MyHandler.pm | more

This command sorts the profile for MyHandler.pm by the wall time of each line. If you use this same sort on the output from Apache::SmallProf on the example code, you will see something similar to this:

# sort -nrk 2 PerlTest.pm.prof | more
    1 5.000785 0.000000         29:    sleep( 5 );
    1 0.008177 0.000000         13:    return( Apache2::Const::OK );
    1 0.007431 0.010000         21:    cleanup_request( $r );
    3 0.001343 0.000000          4:use Apache2::RequestIO;
    1 0.000176 0.000000         33:1;
    3 0.000164 0.000000          3:use Apache2::RequestRec;
    1 0.000093 0.000000         19:    $r->print( "Handling request......\n" );
    1 0.000067 0.000000         11:    handle_request( $r );
    1 0.000058 0.000000          9:    $r->content_type( 'text/plain' );
    1 0.000058 0.000000         28:    $r->print( "Cleaning up request......\n" );

As you can see, Apache::SmallProf has zeroed right in on our sleep() call as the source of our performance problems.

Conclusion

Hopefully, this article has given you enough of an introduction to these modules that you can begin using them in your development efforts. The next time you face a seemingly unsolvable bug or performance issue, you have a few more weapons in your arsenal.

If you have trouble getting any of these three modules to work, please don't hesitate to contact me directly. If you need mod_perl help in general, I strongly suggest you join the mod_perl mailing list. You can often get an answer to your mod_perl question in a few hours, if not minutes.

Test-Driving X11 GUIs

Driving X11 GUIs using X11::GUITest

Introduction

Interfaces to GUI applications like DCOP or D-BUS allow you to interact with GUI applications in order to get at their internal states or set some arbitrary states.

Sometimes GUIs don't allow for such interaction and you need to "click" them. If you're writing such an application, you need some sort of regression tests for it to make sure your widget/windows are as accessible as they should be. If this is the case, there is a Perl module to help you: X11::GUITest.

Be aware that X11::GUITest allows you to drive a GUI, but you can't "read" data written in a widget, such as a button or an edit box. More on this in the Limitations section below.

To install X11::GUITest, run:

$ perl -MCPAN -e 'shell'
install X11::GUITest
quit

A Simple Example

I've included two example programs. One is tested.pl and it serves as an example GUI. The other is tester.pl that starts and drives the tested program.

You need Tk installed for the tested GUI. Tk comes as a package in most GNU/Linux distributions or other *NIX OSes. Download both files in the same folder, run ./tester.pl, and watch.

What are they doing and how do they work?

Starting a GUI

First thing to do prior to driving a GUI is to start the driven program. While you can use fork and exec or any other means, X11::GUITest comes with a routine of its own.

Use StartApp( $tested_application ); to start a GUI, which results in starting the desired application in an asynchronous manner.

If you want to start an application and wait for it to finish before going on, use RunApp.

Finding a Window

After having the GUI started, you need to search for it among the other open windows on your desktop. For this, use FindWindowLike(), WaitWindowLike(), or WaitWindowViewable(), depending on what you need. Their names are pretty much self-explanatory.

Usually you need to have only one instance of the tested application started:

@windows = FindWindowLike( $tested_app_title );
print "* Number of $tested_app_title windows found: ", scalar @windows, "\n";

if ( @windows == 1 ) {
     print "* Only one instance found, going on ...\n";
} else {
    print "* The number of $tested_app_title instances is different than 1\n";
    print "exiting ...\n";
    exit;
}

FindWindowLike() returns a list of windows that match the search criteria, which is a regular expression to match against the window title. In case there is more than one window that matches the criteria, either you have the same window started multiple times, or the regular expression isn't specific enough.

Sending Keyboard Events to an Application

Having found the window, (when you know that there is only one, you can access it as the first element of @windows, namely $windows[0]), you probably want to send it some keystrokes. Use SendKeys() to do this.

If you are having a busy X server, or just want your testing to be easy for the human eye to watch, set the delay between the keystrokes (in milliseconds) with SetKeySendDelay():

SetKeySendDelay( $delay );

To send Alt+O, followed by a delay of $delay milliseconds, then e:

SendKeys( '%(o)e' );

Besides sending plain text to an application, like sending the infamous "Hello World" to an editor window, you may have noticed that the previous example sent a combination of keys. Do so by using modifiers. The modifier keys are:

  • ^, Ctrl
  • %, Alt
  • +, Shift

The X11::GUITest documentation has a complete list of special keys and their "encodings."

You may also find it useful to use QuoteStringForSendKeys() in the case of complicated strings.

Sending Mouse Events to an Application

Sending keys may be not enough in some situations. Having an application that has keyboard shortcuts is nice, but not all of them support it. Sometimes you may need to send mouse events.

To get the absolute position of the appropriate window on your desktop:

my ($x, $y, $width, $height) = GetWindowPos($edit_windows[0]);

Suppose that you want to click right in the middle of it. First, compute the position of the middle of the window:

$x += $width  / 2;
$y += $height / 2;

Now move the mouse:

MoveMouseAbs( $x, $y );

Then press the right mouse button:

PressMouseButton M_RIGHT;

Do something useful, and then release the mouse button. (Don't forget to do that when you're using PressMouseButton; otherwise, you may experience "strange" desktop behavior when your testing application exits.)

ReleaseMouseButton M_RIGHT

You could replace PressMouseButton() and ReleaseMouseButton() with ClickMouseButton() if you don't have anything to do between pressing and releasing the mouse button.

In the example programs, there's something to do--navigating the context menu with keystrokes.

Moving a Window

This is a neat and interesting feature: the ability to move windows. While it is useful to impress your friends with having their favorite mail program moving up and down, its utility lies in the fact that you can arrange the tested windows on the desktop so they are all visible.

MoveWindow( $window_id, $x, $y );

Limitations

As you may have noticed reading the example code, there is almost no way of validating the fact that you are indeed interacting with the right widget or window. The functions you can use for this are FindWindow* or WaitWindow*, which return a list of windows whose titles match an arbitrary regexp, and the functions that deal with child windows, such as IsChild() and GetChildWindows().

While you may pass the window ID to a testing program, using external means to validate the tested application (such as indicating the coordinates on the screen), the problem is that you can't grab a widget's contents.

Also, while you might be tempted to parse the child tree of an application to get from the main window to one of its children, this doesn't work every time. Plenty of GUIs spawn other windows at the top level, and the spawned windows have as root window the topmost window (which is the desktop).

Here's an example of the problem that uses Mozilla Firefox. Before running the test, you must meet some prerequisites:

  • Back up your preferences before running the tests.
  • Go to Edit -> Preferences -> General -> Connection Settings and set it to "Direct connection to the Internet."
  • Click OK, and then OK, and close the browser.

Now run the Firefox.pl example code.

The test program assumes that when the Preferences window pops up, the General menu is selected.

Open Mozilla Firefox again, go to Preferences, select the Web Features menu, click OK, and exit the browser.

Rerun the Firefox.pl program, and watch it.

It has no idea which menu is selected, because every menu component belongs to the same window, having the same title.

Writing GUIs for Testability

Having in mind the strengths and weaknesses of X11::GUITest, it's critical to design graphical user interfaces that are easy to test. This way, you shorten your maintenance time, as you can have a tester program that can help check that the GUI hasn't lost some of its windows in the development/maintenance process.

Of course, when displaying a license text when your GUI starts, you don't have the means to check that the contents are unchanged using X11::GUITest.

What you can do is to ensure that all child windows are "in place" and that a user can access them in the same way as he/she could in previous versions.

If you define ways of navigating the GUI using keyboard shortcuts so that you can reach any "leaf" window starting from the top-level window, then it's trivial for a test program to navigate the same way you do and ensure that all windows are reachable as they were in previous versions.

Consider the following code based on the tested Tk program:

$menu{'OTHER'} = $menu_bar->cascade(
    -label   => 'Other',
    -tearoff => 0,
);

$menu{'OTHER'}->command(
    -label   => 'Editor',
    -command => sub {
        edit_window();
    }
);

It defines a piece of menu from the overall menu of the application. As you may notice, there are no keyboard shortcuts that you can use to access the Editor window.

Thinking of testability, you could go to some lengths to test this piece of code to ensure that the Editor window is reachable and that it indeed pops up. You could record the application's position on the screen and then click the Other button, then move the mouse over the Editor button and click it. I'm sure you can spot some caveats here, among them:

  • You need to make sure that the application is always on the screen at some known coordinates (use GetWindowPos()) or maybe that the test always moves the window to the same place (use MoveWindow()).
  • You have to take into consideration font size changes, localization, and resolution changes so that you are sure you are clicking in the right place.

This kind of testing is fragile and error-prone. You can make things simpler and more robust: add keyboard shortcuts for each action. You gain two main benefits: you make some users (like me) happier and ease the testing process. You just need to define all the "paths" that you need to "walk" and define the child window titles so you know you've reached them.

Here's a slight adjustment to the tested application so that it provides keyboard shortcuts:

$menu{'OTHER'} = $menu_bar->cascade(
    -label   => '~Other',
    -tearoff => 0,
);

$menu{'OTHER'}->command(
    -label   => '~Editor',
    -command => sub {
        edit_window();
    }
);

sub edit_window {
    # some initialization code here ...

    $edit_window = $main_window->Toplevel();

    # Set the title of the Editor window
    $edit_window->title("This is an edit window");

    # the rest of the code here ....

}

This piece of code is easier to test. Navigate the application until you reach the Editor window:

SendKeys('%(o)e');

Now you should have the Editor window spawned. Grab a list of windows having the title matching the Editor window's title:

@edit_windows = FindWindowLike( $edit_title );

Check to see whether the Editor window is present. Also, there should be only one Editor window started:

if ( @edit_windows == 1 ) {
    # code here
} else {
    # we have zero or more than one Editor window, so something is not quite
    # right
}

This kind of code is easy to extend, as you can store the application window hierarchy in some external file outside of the program source (in some sort of markup language file, or anything that suits your needs). Having this external definition of the windows' hierarchy and their properties, the tester program can read the same file the tested application uses; thus, both know the same keyboard shortcuts and window titles.

Program logic errors and/or bugs in underlying libraries used are easier to catch before you release the software.

Conclusion

As you can see, there is no easy way to test an entire GUI application with X11::GUITest, but you can test the important parts. Also, for some actions you can use a mixed approach, such as initiating an event using the application interface (connecting to a remote server protected with a user/password auth scheme) and picking the results from a log file.

While the testing done in the previous paragraph is necessary, it is not sufficient. It would be great if there were someone willing to pick up the module and research whether it could be possible for X11::GUITest to be able to fetch data from the widgets, making it possible to "read" the contents of a window (from a text widget, for example).

This kind of testing is more complete than simply driving the GUI.

Of course, you could also use X11::GUITest to write a "record and playback" application. You might only need GetMousePos(), IsMouseButtonPressed(), and the other mouse functions. As I said earlier, in my opinion this kind of testing is too fragile.

The problem is that you can't validate the contents of the windows.

Visit the home of the Perl programming language: Perl.org

Sponsored by

Monthly Archives

Powered by Movable Type 5.13-en