#============================================================= -*-Perl-*-
#
# Template::Service
#
# DESCRIPTION
# Module implementing a template processing service which wraps a
# template within PRE_PROCESS and POST_PROCESS templates and offers
# ERROR recovery.
#
# AUTHOR
# Andy Wardley <abw@kfs.org>
#
# COPYRIGHT
# Copyright (C) 1996-2000 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2000 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: Service.pm,v 2.6 2000/12/01 15:29:35 abw Exp $
#
#============================================================================
package Template::Service;
require 5.004;
use strict;
use vars qw( $VERSION $DEBUG $ERROR $AUTOLOAD );
use base qw( Template::Base );
use Template::Base;
use Template::Config;
$VERSION = sprintf("%d.%02d", q$Revision: 2.6 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0;
#========================================================================
# ----- PUBLIC METHODS -----
#========================================================================
#------------------------------------------------------------------------
# process($template, \%params)
#
# Process a template within a service framework. A service may encompass
# PRE_PROCESS and POST_PROCESS templates and an ERROR hash which names
# templates to be substituted for the main template document in case of
# error. Each service invocation begins by resetting the state of the
# context object via a call to reset(). The AUTO_RESET option may be set
# to 0 (default: 1) to bypass this step.
#------------------------------------------------------------------------
sub process {
my ($self, $template, $params) = @_;
my $context = $self->{ CONTEXT };
my ($name, $output, $procout, $error);
$output = '';
$context->reset()
if $self->{ AUTO_RESET };
# pre-request compiled template from context so that we can alias it
# in the stash for pre-processed templates to reference
eval { $template = $context->template($template) };
return $self->error($@)
if $@;
# localise the variable stash with any parameters passed
# and set the 'template' variable
$params ||= { };
$params->{ template } = $template
unless ref $template eq 'CODE';
$context->localise($params);
SERVICE: {
# PRE_PROCESS
eval {
foreach $name (@{ $self->{ PRE_PROCESS } }) {
$output .= $context->process($name);
}
};
last SERVICE if ($error = $@);
# PROCESS
eval {
foreach $name (@{ $self->{ PROCESS } || [ $template ] }) {
$procout .= $context->process($name);
}
};
if ($error = $@) {
last SERVICE
unless defined ($procout = $self->_recover(\$error));
}
$output .= $procout if defined $procout;
# POST_PROCESS
eval {
foreach $name (@{ $self->{ POST_PROCESS } }) {
$output .= $context->process($name);
}
};
last SERVICE if ($error = $@);
}
$context->delocalise();
if ($error) {
# $error = $error->as_string if ref $error;
return $self->error($error);
}
return $output;
}
#------------------------------------------------------------------------
# context()
#
# Returns the internal CONTEXT reference.
#------------------------------------------------------------------------
sub context {
return $_[0]->{ CONTEXT };
}
#========================================================================
# -- PRIVATE METHODS --
#========================================================================
sub _init {
my ($self, $config) = @_;
my ($item, $data, $context, $block, $blocks);
my $delim = $config->{ DELIMITER };
$delim = ':' unless defined $delim;
# coerce PRE_PROCESS, PROCESS and POST_PROCESS to arrays if necessary,
# by splitting on non-word characters
foreach $item (qw( PRE_PROCESS PROCESS POST_PROCESS )) {
$data = $config->{ $item };
next unless defined $data;
$data = [ split($delim, $data || '') ]
unless ref $data eq 'ARRAY';
$self->{ $item } = $data;
}
# unset PROCESS option unless explicitly specified in config
$self->{ PROCESS } = undef
unless exists $config->{ PROCESS };
$self->{ ERROR } = $config->{ ERROR } || $config->{ ERRORS };
$self->{ AUTO_RESET } = defined $config->{ AUTO_RESET }
? $config->{ AUTO_RESET } : 1;
$context = $self->{ CONTEXT } = $config->{ CONTEXT }
|| Template::Config->context($config)
|| return $self->error(Template::Config->error);
return $self;
}
#------------------------------------------------------------------------
# _recover(\$exception)
#
# Examines the internal ERROR hash array to find a handler suitable
# for the exception object passed by reference. Selecting the handler
# is done by delegation to the exception's select_handler() method,
# passing the set of handler keys as arguments. A 'default' handler
# may also be provided. The handler value represents the name of a
# template which should be processed.
#------------------------------------------------------------------------
sub _recover {
my ($self, $error) = @_;
my $context = $self->{ CONTEXT };
my ($hkey, $handler, $output);
# there's a pesky lurking somewhere deep - let's hope this catches it
unless (ref $$error) {
require Carp;
confess('internal error: not an exception object',
' - please contact the author: <abw@kfs.org>\n',
"ERROR: $$error\n");
}
# a 'stop' exception is thrown by [% STOP %] - we return the output
# buffer stored in the exception object
return $$error->text()
if $$error->type() eq 'stop';
my $handlers = $self->{ ERROR }
|| return undef; ## RETURN
if (ref $handlers eq 'HASH') {
if ($hkey = $$error->select_handler(keys %$handlers)) {
$handler = $handlers->{ $hkey };
}
elsif ($handler = $handlers->{ default }) {
# use default handler
}
else {
return undef; ## RETURN
}
}
else {
$handler = $handlers;
}
eval { $handler = $context->template($handler) };
if ($@) {
$$error = $@;
return undef; ## RETURN
};
$context->stash->set('error', $$error);
eval {
$output .= $context->process($handler);
};
if ($@) {
$$error = $@;
return undef; ## RETURN
}
return $output;
}
#------------------------------------------------------------------------
# _dump()
#
# Debug method which return a string representing the internal object
# state.
#------------------------------------------------------------------------
sub _dump {
my $self = shift;
my $context = $self->{ CONTEXT }->_dump();
$context =~ s/\n/\n /gm;
my $error = $self->{ ERROR };
$error = join('',
"{\n",
(map { " $_ => $error->{ $_ }\n" }
keys %$error),
"}\n")
if ref $error;
local $" = ', ';
return <<EOF;
$self
PRE_PROCESS => [ @{ $self->{ PRE_PROCESS } } ]
POST_PROCESS => [ @{ $self->{ POST_PROCESS } } ]
ERROR => $error
CONTEXT => $context
EOF
}
1;