Practical mod_perl, from O'Reilly. | 37

Practical mod_perl: Chapter 6: Coding with mod_perl in Mind

Method Handlers: The Browse and See, Browse and View Example

Let's look at an example of the method-handler concepts presented in Chapter 4. Suppose you need to implement a handler that allows browsing the files in the document root and beneath. Directories should be browsable (so you can move up and down the directory tree), but files should not be viewable (so you can see the available files, but you cannot click to view them).

So let's write a simple file browser. We know what customers are like, so we suspect that the customer will ask for similar customized modules pretty soon. To avoid having to duplicate our work later, we decide to start writing a base class whose methods can easily be overridden as needed. Our base class is called Apache::BrowseSee.

We start the class by declaring the package and using the strict pragma:

package Apache::BrowseSee;
use strict;

Next, we import common constants (e.g., OK, NOT_FOUND, etc.), load the File::Spec::Functions and File::Basename modules, and import a few path-manipulation functions that we are going to use:

use Apache::Constants qw(:common);
use File::Spec::Functions qw(catdir canonpath curdir updir);
use File::Basename 'dirname';

Now let's look at the functions. We start with the simple constructor:

sub new { bless {  }, shift;}

The real entry point, the handler, is prototyped as ($$). The handler starts by instantiating its object, if it hasn't already been done, and storing the $r object, so we don't need to pass it to the functions as an argument:

sub handler ($$) {
    my($self, $r) = @_;
    $self = $self->new unless ref $self;
    $self->{r} = $r;

Next we retrieve the path_info element of the request record:

    $self->{dir} = $r->path_info || '/';

For example, if the request was /browse/foo/bar, where /browse is the location of the handler, the path_info element will be /foo/bar. The default value / is used when the path is not specified.

Then we reset the entries for dirs and files:

    $self->{dirs}  = {  };
    $self->{files} = {  };

This is needed because it's possible that the $self object is created outside the handler (e.g., in the startup file) and may persist between requests.

Now an attempt to fetch the contents of the directory is made:

    eval { $self->fetch(  ) };
    return NOT_FOUND if $@;

If the fetch( ) method dies, the error message is assigned to $@ and we return NOT_FOUND. You may choose to approach it differently and return an error message explaining what has happened. You may also want to log the event before returning:

    warn($@), return NOT_FOUND if $@;

Normally this shouldn't happen, unless a user messes with the arguments (something you should always be on the lookout for, because they will do it).

When the fetch( ) function has completed successfully, all that's left is to send the HTTP header and start of the HTML via the head( ) method, render the response, send the end of the HTML via tail( ),[4] and finally to return the OK constant to tell the server that the request has been fully answered:

    $self->head;
    $self->render;
    $self->tail;
 
    return OK;
}

The response is generated by three functions. The head( ) method is a very simple one--it sends the HTTP header text/html and prints an HTML preamble using the current directory name as a title:

sub head {
    my $self = shift;
    $self->{r}->send_http_header("text/html");
    print "<html><head><title>Dir: $self->{dir}</title><head><body>";
}

The tail( ) method finishes the HTML document:

sub tail {
    my $self = shift;
    print "</body></html>";
}

The fetch( ) method reads the contents of the directory stored in the object's dir attribute (relative to the document root) and then sorts the contents into two groups, directories and files:

sub fetch {
    my $self = shift;
    my $doc_root = Apache->document_root;
    my $base_dir = canonpath( catdir($doc_root, $self->{dir}));
 
    my $base_entry = $self->{dir} eq '/' ? '' : $self->{dir};
    my $dh = Apache::gensym(  );
    opendir $dh, $base_dir or die "Cannot open $base_dir: $!";
    for (readdir $dh) {
        next if $_ eq curdir(  );  # usually '.'
 
        my $full_dir = catdir $base_dir, $_;
        my $entry = "$base_entry/$_";
        if (-d $full_dir) {
            if ($_ eq updir(  )) { # '..'
                $entry = dirname $self->{dir};
                next if catdir($base_dir, $entry) eq $doc_root;
            }
            $self->{dirs}{$_} = $entry;
        }
        else {
            $self->{files}{$_} = $entry;
        }
    }
    closedir $dh;
}

By using canonpath( ), we make sure that nobody messes with the path_info element, by eliminating successive slashes and "/."s on Unix and taking appropriate actions on other operating systems. It's important to use File::Spec and other cross-platform functions when developing applications.

While looping through the directory entries, we skip over the current directory entry using the curdir( ) function imported from File::Spec::Functions (which is equivalent to . on Unix) and handle the parent directory entry specially by matching the updir( ) function (which is equivalent to .. on Unix). The function dirname( ) gives us the parent directory, and afterward we check that this directory is different from the document root. If it's the same, we skip this entry.

Note that since we use the path_info element to pass the directory relative to the document root, we rely on Apache to handle the case when users try to mess with the URL and add .. to reach files they aren't supposed to reach.

Finally, let's look at the render( ) method:

sub render {
    my $self = shift;
    print "<p>Current Directory: <i>$self->{dir}</i><br>";
 
    my $location = $self->{r}->location;
    print qq{<a href="$location$self->{dirs}{$_}">$_</a><br>}
        for sort keys %{ $self->{dirs} || {  } };
    print qq{$_<br>}
        for sort keys %{ $self->{files} || {  } };
}

The render( ) method actually takes the files and directories prepared in the fetch( ) method and displays them to the user. First the name of the current directory is displayed, followed by the directories and finally the files. Since the module should allow browsing of directories, we hyperlink them. The files aren't linked, since we are in "see but don't touch" mode.[5]

Finally, we finish the package with 1; to make sure that the module will be successfully loaded. The _ _END_ _ token allows us to put various notes and POD documentation after the program, where Perl won't complain about them.

1;
_ _END_ _

Example 6-39 shows how the whole package looks.

Created: March 27 2003
Revised: July 23, 2003

URL: http://webreference.com/programming/perl/mod_perl/chap6/4

Practical mod_perl, from O'Reilly. | 37

Practical mod_perl: Chapter 6: Coding with mod_perl in Mind

Method Handlers: The Browse and See, Browse and View Example

Find a programming school near you