#============================================================= -*-Perl-*-
#
# Template::Service::Apache
#
# DESCRIPTION
# Module subclassed from Template::Service which implements a service
# specific to the Apache/mod_perl environment.
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
#----------------------------------------------------------------------------
#
# $Id: Apache.pm,v 1.4 2004/04/27 09:11:31 abw Exp $
#
#============================================================================
package Template::Service::Apache;
require 5.004;
use strict;
use vars qw( $VERSION $DEBUG $ERROR $CONTENT_TYPE );
use base qw( Template::Service );
use Digest::MD5 qw( md5_hex );
use Template::Config;
use Template::Constants;
use Template::Exception;
use Template::Service;
$VERSION = sprintf("%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$CONTENT_TYPE = 'text/html';
use Apache::Util qw( escape_uri ht_time );
use Apache::Constants qw( :common );
use Apache::Request;
#========================================================================
# ----- PUBLIC METHODS -----
#========================================================================
#------------------------------------------------------------------------
# template($request)
#
# Fetch root template document from the ROOT_PROVIDER using the
# request filename. Returns a reference to a Template::Document
# object on success or a DECLINED status code if not found. On error,
# the relevant error message is logged and SERVER_ERROR is returned.
#------------------------------------------------------------------------
sub template {
my ($self, $r) = @_;
my $filename = $r->filename();
return DECLINED unless -f $filename;
$self->{ TEMPLATE_ERROR } = undef;
my ($template, $error) = $self->{ ROOT_PROVIDER }->fetch($filename);
if ($error && $error == &Template::Constants::STATUS_DECLINED) {
return DECLINED;
}
elsif ($error) {
# save error as exception for params() to add to template vars
$self->{ TEMPLATE_ERROR } = Template::Exception->new(
Template::Constants::ERROR_FILE, $template
);
# if there is an ERROR template defined then we attempt to
# fetch it as a substitute for the original template. Note
# that we must fetch it from the regular template providers
# in the Template::Context because they honour the INCLUDE_PATH
# parameters whereas the ROOT_PROVIDER expects an absolute file
if ($template = $self->{ ERROR }) {
eval { $template = $self->{ CONTEXT }->template($template) };
if ($@) {
$r->log_reason($self->{ TEMPLATE_ERROR } . " / $@", $filename);
return SERVER_ERROR;
}
}
else {
$r->log_reason($template, $filename);
return SERVER_ERROR;
}
}
return $template;
}
#------------------------------------------------------------------------
# params($request, $params)
#
# Create a set of processing parameters (i.e. template variables) for
# the request.
#------------------------------------------------------------------------
sub params {
my ($self, $request, $params) = @_;
$params ||= { };
my $plist = $self->{ SERVICE_PARAMS };
my $all = $plist->{ all };
return $params unless keys %$plist;
$request = Apache::Request->new($request);
$params->{ env } = { %{ $request->subprocess_env() } }
if $all or $plist->{ env };
$params->{ uri } = $request->subprocess_env('REDIRECT_URL') || $request->uri()
if $all or $plist->{ uri };
$params->{ pnotes } = $request->pnotes()
if $all or $plist->{ pnotes };
$params->{ params } = { %{ $request->parms() } }
if $all or $plist->{ params };
$params->{ request } = $request
if $all or $plist->{ request };
if ($all or $plist->{ uploads }) {
my @uploads = $request->upload;
$params->{ uploads } = \@uploads;
}
$params->{ cookies } = {
map { $1 => escape_uri($2) if (/([^=]+)=(.*)/) }
grep(!/^$/, split(/;\s*/, $request->header_in('cookie'))),
} if $all or $plist->{ cookies };
# add any error raised by main template failure
$params->{ error } = $self->{ TEMPLATE_ERROR };
return $params;
}
#------------------------------------------------------------------------
# headers($request, $template, $content_ref)
#
# Set and then send the required http headers.
#------------------------------------------------------------------------
sub headers {
my ($self, $r, $template, $content) = @_;
my $headers = $self->{ SERVICE_HEADERS };
my $all = $headers->{ all };
$r->content_type($self->{ CONTENT_TYPE })
if $all or $headers->{ type };
$r->headers_out->add('Content-Length' => length $$content)
if $all or $headers->{ length };
$r->headers_out->add('Last-Modified' => ht_time($template->modtime()))
if $all or $headers->{ modified } and $template;
$r->headers_out->add('E-tag' => sprintf q{"%s"}, md5_hex($$content))
if $all or $headers->{ etag };
$r->send_http_header;
}
#------------------------------------------------------------------------
# _init()
#
# In additional to the regular template providers (Template::Provider
# objects) created as part of the context initialisation and used to
# deliver templates loaded via INCLUDE, PROCESS, etc., we also create
# a single additional provider responsible for loading the main
# template. We do this so that we can enable its ABSOLUTE flag,
# allowing us to specify a requested template by absolute filename (as
# Apache provides for us in $r->filename()) but without forcing all
# other providers to honour the ABSOLUTE flag. We pre-create a PARSER
# object (Template::Parser) which can be shared across all providers.
#------------------------------------------------------------------------
sub _init {
my ($self, $config) = @_;
# create a parser to be shared by all providers
$config->{ PARSER } ||= Template::Config->parser($config)
|| return $self->error(Template::Config->error());
# create a provider for the root document
my $rootcfg = {
ABSOLUTE => 1,
map { exists $config->{ $_ } ? ($_, $config->{ $_ }) : () }
qw( COMPILE_DIR COMPILE_EXT CACHE_SIZE PARSER ),
};
my $rootprov = Template::Config->provider($rootcfg)
|| return $self->error(Template::Config->error());
# now let the Template::Service superclass initialiser continue
$self->SUPER::_init($config)
|| return undef;
# save reference to root document provider
$self->{ ROOT_PROVIDER } = $rootprov;
# determine content type or use default
$self->{ CONTENT_TYPE } = $config->{ CONTENT_TYPE } || $CONTENT_TYPE;
# if TT2Headers not explicitly defined then we default it to
# just send the Content-Type, for the simple cases and backwards
# compatibility with earlier versions (0.08 and earlier) where
# the Content-Type was always sent regardless
$config->{ SERVICE_HEADERS } = ['type']
unless $config->{ SERVICE_HEADERS };
# extract other relevant SERVICE_* config items
foreach (qw( SERVICE_HEADERS SERVICE_PARAMS )) {
my $item = $config->{ $_ } || [ ];
$self->{ $_ } = { map { $_ => 1 } @$item };
}
return $self;
}
1;