#### LISTING ONE ####
package My::SSILog;

## usage: PerlLogHandler My::SSILog

use vars qw($VERSION);

use Apache::Constants qw(:common);

sub handler {
  my $r = shift;
  return OK if $r->content_type =~ /^image/; # don't log images

  $r->chdir_file($r->filename);
  {
    local *LOG;
    if (open LOG, ">>.ssilog.txt") {
      flock LOG, 2;
      seek LOG, 0, 2;
      print LOG join (" ",
                      map "[$_]",
                      scalar localtime,
                      (map { $_ || "-" }
                       $r->uri,
                       $r->get_remote_host,
                       $r->header_in("referer"),
                       $r->header_in("user-agent"),
                      ),
                     ), "\n";
      close LOG;
    }
  }
  return OK;
}

"true";
#### LISTING TWO ####
## turn on the engine
RewriteEngine on
RewriteLogLevel 9
RewriteLog logs/rewrite_log

# local cgi overrides other
RewriteCond %{REQUEST_URI} ^/cgi/
RewriteCond /home/merlyn/etc/httpd/htdocs%{REQUEST_FILENAME} -f
RewriteRule ^ - [PT]

# other cgi
RewriteRule ^/cgi/(.*)$ /WWW/stonehenge/cgi-bin/$1 [L]
RewriteRule ^/cgi-bin/(.*)$ /WWW/stonehenge/cgi-bin/$1 [L]

# local htdocs overrides other
RewriteCond %{REQUEST_URI} ^/(manual|perl)/
RewriteRule ^ - [PT]

# other htdocs
RewriteRule ^/(.*)$ /WWW/stonehenge/htdocs/$1 [L]
#### LISTING THREE ####
## install as
## PerlTransHander My::Trans

package My::Trans;

use strict;

my $other = "/WWW/stonehenge";
my $other_cgi = "$other/cgi-bin";
my $other_root = "$other/htdocs";

sub handler {
  my $r = shift;

  if ($r->is_initial_req) {
    $r->warn("request: ".$r->the_request);
  }

  my $document_root = $r->document_root;
  my $uri = $r->uri;

  local $_ = $uri;

  ## local /cgi/
  if (m{^/cgi/} and -x "$document_root$_") {
    $r->warn("$uri => using local CGI at $document_root$_");
    $r->filename("$document_root$_");
    return 0;
  }
  ## old /cgi/ or /cgi-bin/
  if (s{^/(cgi|cgi-bin)/}{$other_cgi/}) {
    $r->warn("$uri => using remote CGI at $_");
    $r->filename($_);
    return 0;
  }
  ## local /manual/ or /perl/
  if (m{^/(manual|perl)(/|$)}) {
    $r->warn("$uri => using local file at $document_root$_");
    $r->filename("$document_root$_");
    return 0;
  }
  ## any old prior
  if (s{^/}{$other_root/}) {
    $r->warn("$uri => using remote file at $_");
    $r->filename($_);
    return 0;
  }
  $r->warn("$uri => huh?");
  return -1;
}

1;