Practical mod_perl, from O'Reilly. | 38

Practical mod_perl: Chapter 6: Coding with mod_perl in Mind

Example 6-39: Apache/BrowseSee.pm

package Apache::BrowseSee;
use strict;
 
use Apache::Constants qw(:common);
use File::Spec::Functions qw(catdir canonpath curdir updir);
use File::Basename 'dirname';
 
sub new { bless {}, shift;}
 
sub handler ($$) {
    my($self, $r) = @_;
    $self = $self->new unless ref $self;
 
    $self->{r}     = $r;
    $self->{dir}   = $r->path_info || '/';
    $self->{dirs}  = {};
    $self->{files} = {};
 
    eval { $self->fetch(  ) };
    return NOT_FOUND if $@;
 
    $self->head;
    $self->render;
    $self->tail;
 
    return OK;
}
 
sub head {
    my $self = shift;
    $self->{r}->send_http_header("text/html");
    print "<html><head><title>Dir: $self->{dir}</title><head><body>";
}
 
sub tail {
    my $self = shift;
    print "</body></html>";
}
 
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(  );
 
        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;
}
 
sub render {
    my $self = shift;
    print "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} || {} };
}
 
1;
_  _END_  _

This module should be saved as Apache/BrowseSee.pm and placed into one of the directories in @INC. For example, if /home/httpd/perl is in your @INC, you can save it in /home/httpd/perl/Apache/BrowseSee.pm.

To configure this module, we just add the following snippet to httpd.conf:

PerlModule Apache::BrowseSee
<Location /browse>
    SetHandler perl-script
    PerlHandler Apache::BrowseSee->handler
</Location>

Users accessing the server from /browse can now browse the contents of your server from the document root and beneath but cannot view the contents of the files (see Figure 6-2).

**Figure 6-2.** **The files can be browsed but not viewed**

Now let's say that as soon as we get the module up and running, the client comes back and tells us he would like us to implement a very similar application, except that files should now be viewable (clickable). This is because later he wants to allow only authorized users to read the files while letting everybody see what he has to offer.

We knew that was coming, remember? Since we are lazy and it's not exciting to write the same code again and again, we will do the minimum amount of work while still keeping the client happy. This time we are going to implement the Apache::BrowseRead module:

package Apache::BrowseRead;
use strict;
use base qw(Apache::BrowseSee);

We place the new module into Apache/BrowseRead.pm, declare a new package, and tell Perl that this package inherits from Apache::BrowseSee using the base pragma. The last line is roughly equivalent to:

BEGIN {
    require Apache::BrowseSee;
    @Apache::BrowseRead::ISA = qw(Apache::BrowseSee);
}

Since this class is going to do the same job as Apache::BrowseSee, apart from rendering the file listings differently, all we have to do is override 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{<a href="$self->{files}{$_}">$_</a><br>}
        for sort keys %{ $self->{files} || {  } };
}

As you can see, the only difference here is that we link to the real files now.

We complete the package as usual with 1; and _ _END_ _:

1;
_ _END_ _

Example 6-40 shows the whole package.

Example 6-40: Apache/BrowseRead.pm

package Apache::BrowseRead;
use strict;
use base qw(Apache::BrowseSee);
 
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{<a href="$self->{files}{$_}">$_</a><br>}
        for sort keys %{ $self->{files} || {} };
}
1;
_  _END_  _

Finally, we should add a new configuration section in httpd.conf:

PerlModule Apache::BrowseRead
<Location /read>
    SetHandler perl-script
    PerlHandler Apache::BrowseRead->handler
</Location>

Now, when accessing files through /read, we can browse and view the contents of the files (see Figure 6-3). Once we add some authentication/authorization methods, we will have a server where everybody can browse, but only privileged users can read.

**Figure 6-3.** **The files can be browsed and read**

You might be wondering why you would write a special module to do something Apache itself can already do for you. First, this was an example on using method handlers, so we tried to keep it simple while showing some real code. Second, this example can easily be adapted and extended--for example, it can handle virtual files that don't exist on the filesystem but rather are generated on the fly and/or fetched from the database, and it can easily be changed to do whatever you (or your client) want to do, instead of what Apache allows.

References

"Just the FAQs: Coping with Scoping," an article by Mark-Jason Dominus about how Perl handles variables and namespaces, and the difference between use vars( ) and my( ): http://www.plover.com/~mjd/perl/FAQs/Namespaces.html.

It's important to know how to perform exception handling in Perl code. Exception handling is a general Perl technique; it's not mod_perl-specific. Further information is available in the documentation for the following modules:

Error.pm, by Graham Barr.

Exception::Class and Devel::StackTrace, by Dave Rolsky.

Try.pm, by Tony Olekshy, available at http://www.avrasoft.com/perl6/try6-ref5.txt.

There is also a great deal of information concerning error handling in the mod_perl online documentation (e.g., http://perl.apache.org/docs/general/perl_reference/perl_reference.html).

Perl Module Mechanics: http://world.std.com/~swmcd/steven/perl/module_mechanics.html. This page describes the mechanics of creating, compiling, releasing, and maintaining Perl modules, which any mod_perl developer planning on sharing code with others will find useful.

1. Don't forget the 1; at the end of the library, or the require( ) call might fail.

2. These are the recent pumpkins: Chip Salzenberg for 5.004, Gurusamy Sarathy for 5.005 and 5.6, Jarkko Hietaniemi for 5.8, Hugo van der Sanden for 5.10.

3. Buffering is used to reduce the number of system calls (which do the actual writing) and therefore improve performance. When the buffer (usually a few kilobytes in size) is getting full, it's flushed and the data is written.

4. This could perhaps be replaced by a templating system. See Appendix D for more information about the Template Toolkit.

5. In your real code you should also escape HTML- and URI-unsafe characters in the filenames (e.g., <, >, &, ", ', etc.) by using the Apache::Util::escape_html and Apache::Util::escape_uri functions.

Created: March 27, 2003
Revised: July 23, 2003

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

Practical mod_perl, from O'Reilly. | 38

Practical mod_perl: Chapter 6: Coding with mod_perl in Mind

References

Find a programming school near you