Template::Context - Runtime context in which templates are processed

    use Template::Context;

    # constructor
    $context = Template::Context->new(\%config)
        || die $Template::Context::ERROR;

    # fetch (load and compile) a template
    $template = $context->template($template_name);

    # fetch (load and instantiate) a plugin object
    $plugin = $context->plugin($name, \@args);

    # fetch (return or create) a filter subroutine
    $filter = $context->filter($name, \@args, $alias);

    # process/include a template, errors are thrown via die()
    $output = $context->process($template, \%vars);
    $output = $context->include($template, \%vars);

    # raise an exception via die()
    $context->throw($error_type, $error_message, \$output_buffer);

    # catch an exception, clean it up and fix output buffer
    $exception = $context->catch($exception, \$output_buffer);

    # save/restore the stash to effect variable localisation
    $new_stash = $context->localise(\%vars);
    $old_stash = $context->delocalise();

    # add new BLOCK or FILTER definitions
    $context->define_block($name, $block);
    $context->define_filter($name, \&filtersub, $is_dynamic);

    # reset context, clearing any imported BLOCK definitions
    $context->reset();

    # methods for accessing internal items
    $stash     = $context->stash();
    $tflag     = $context->trim();
    $epflag    = $context->eval_perl();
    $providers = $context->templates();
    $providers = $context->plugins();
    $providers = $context->filters();
    ...

    use Template;

    my $template = Template->new({
        TRIM      => 1,
        EVAL_PERL => 1,
        BLOCKS    => {
            header => 'This is the header',
            footer => 'This is the footer',
        },
    });

    $context = Template::Context->new({
        INCLUDE_PATH => '/home/abw/templates', # provider option
        TAG_STYLE    => 'html',                # parser option
    });

    use Template;
    use Template::Context;

    my $context  = Template::Context->new({ TRIM => 1 });
    my $template = Template->new({ CONTEXT => $context });

    use Template;

    $Template::Config::CONTEXT = 'MyOrg::Template::Context';

    my $template = Template->new({
        EVAL_PERL   => 1,
        EXTRA_MAGIC => 'red hot',  # your extra config items
        ...
    });

    my $context = Template::Context->new({
        INCLUDE_PATH => 'header',
        POST_PROCESS => 'footer',
    });

    my $context = Template::Context->new( EVAL_PERL => 1 );

    my $context = Template::Context->new(\%config)
        || die Template::Context->error();

    my $context = Template::Context->new(\%config)
        || die $Template::Context::ERROR;

    my $context = Template::Context->new({
        VARIABLES => {
            title   => 'A Demo Page',
            author  => 'Joe Random Hacker',
            version => 3.14,
        },
    };

    my $context = Template::Context->new({
        BLOCKS => {
            header  => 'The Header.  [% title %]',
            footer  => sub { return $some_output_text },
            another => Template::Document->new({ ... }),
        },
    }); 

    my $context = Template::Context->new({
        VIEWS => [
            bottom => { prefix => 'bottom/' },
            middle => { prefix => 'middle/', base => 'bottom' },
            top    => { prefix => 'top/',    base => 'middle' },
        ],
    });

    [% BLOCK foo %]

    Line 1 of foo

    [% END %]

    before 
    [% INCLUDE foo %]
    after

    before
    Line 1 of foo
    after

    my $context = Template::Context->new({
        LOAD_TEMPLATES => [
            MyOrg::Template::Provider->new({ ... }),
            Template::Provider->new({ ... }),
        ],
    });

    my $context = Template::Context->new({
        LOAD_PLUGINS => [
            MyOrg::Template::Plugins->new({ ... }),
            Template::Plugins->new({ ... }),
        ],
    });

    my $context = Template::Context->new({
        LOAD_FILTERS => [
            MyTemplate::Filters->new(),
            Template::Filters->new(),
        ],
    });

    my $stash = MyOrg::Template::Stash->new({ ... });
    my $context = Template::Context->new({
        STASH => $stash,
    });

    use Template::Constants qw( :debug );

    my $template = Template->new({
        DEBUG => DEBUG_CONTEXT | DEBUG_DIRS,
    });

    $template = $context->template('header');

    eval { $template = $context->template('header') };
    if ($@) {
        print "failed to fetch template: $@\n";
    }

    $plugin = $context->plugin('DBI', 'dbi:msql:mydbname');

    # static filter (no args)
    $filter = $context->filter('html');

    # dynamic filter (args) aliased to 'padright'
    $filter = $context->filter('format', '%60s', 'padright');

    # retrieve previous filter via 'padright' alias
    $filter = $context->filter('padright');

    $output = $context->process('header', { title => 'Hello World' });

    $output = $context->include('header', { title => 'Hello World' });

    $context->throw($exception);
    $context->throw("I'm sorry Dave, I can't do that");
    $context->throw('denied', "I'm sorry Dave, I can't do that");

    $output .= 'blah blah blah';
    $output .= 'more rhubarb';
    $context->throw('yack', 'Too much yacking', \$output);

    $context->define_view( 
        my_view => { 
            prefix => 'my_templates/' 
        } 
    );

    [% my_view.print(some_data) %]

    $context->define_view({     # hash reference
        my_view_one => { 
            prefix => 'my_templates_one/' 
        },
        my_view_two => { 
            prefix => 'my_templates_two/' 
        } 
    });

    $context->define_view([     # list referenence
        my_view_one => {
            prefix => 'my_templates_one/' 
        },
        my_view_two => { 
            prefix => 'my_templates_two/' ,
            base   => 'my_view_one',
        } 
    ]);

    [% my_view_one.print(some_data) %]
    [% my_view_two.print(some_data) %]

    $stash = $context->localise();

    $stash = $context->delocalise();

    $stash     = $context->stash();
    $tflag     = $context->trim();
    $epflag    = $context->eval_perl();
    ...

#============================================================= -*-Perl-*-
#
# Template::Context
#
# DESCRIPTION
#   Module defining a context in which a template document is processed.
#   This is the runtime processing interface through which templates 
#   can access the functionality of the Template Toolkit.
#
# AUTHOR
#   Andy Wardley   <abw@wardley.org>
#
# COPYRIGHT
#   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
#
#   This module is free software; you can redistribute it and/or
#   modify it under the same terms as Perl itself.
# 
#============================================================================

package Template::Context;

use strict;
use warnings;
use base 'Template::Base';

use Template::Base;
use Template::Config;
use Template::Constants;
use Template::Exception;
use Scalar::Util 'blessed';

use constant DOCUMENT         => 'Template::Document';
use constant EXCEPTION        => 'Template::Exception';
use constant BADGER_EXCEPTION => 'Badger::Exception';

our $VERSION = 2.98;
our $DEBUG   = 0 unless defined $DEBUG;
our $DEBUG_FORMAT = "\n## \$file line \$line : [% \$text %] ##\n";
our $VIEW_CLASS   = 'Template::View';
our $AUTOLOAD;

#========================================================================
#                     -----  PUBLIC METHODS -----
#========================================================================

#------------------------------------------------------------------------
# template($name) 
#
# General purpose method to fetch a template and return it in compiled 
# form.  In the usual case, the $name parameter will be a simple string
# containing the name of a template (e.g. 'header').  It may also be 
# a reference to Template::Document object (or sub-class) or a Perl 
# sub-routine.  These are considered to be compiled templates and are
# returned intact.  Finally, it may be a reference to any other kind 
# of valid input source accepted by Template::Provider (e.g. scalar
# ref, glob, IO handle, etc).
#
# Templates may be cached at one of 3 different levels.  The internal
# BLOCKS member is a local cache which holds references to all
# template blocks used or imported via PROCESS since the context's
# reset() method was last called.  This is checked first and if the
# template is not found, the method then walks down the BLOCKSTACK
# list.  This contains references to the block definition tables in
# any enclosing Template::Documents that we're visiting (e.g. we've
# been called via an INCLUDE and we want to access a BLOCK defined in
# the template that INCLUDE'd us).  If nothing is defined, then we
# iterate through the LOAD_TEMPLATES providers list as a 'chain of 
# responsibility' (see Design Patterns) asking each object to fetch() 
# the template if it can.
#
# Returns the compiled template.  On error, undef is returned and 
# the internal ERROR value (read via error()) is set to contain an
# error message of the form "$name: $error".
#------------------------------------------------------------------------

sub template {
    my ($self, $name) = @_;
    my ($prefix, $blocks, $defblocks, $provider, $template, $error);
    my ($shortname, $blockname, $providers);

    $self->debug("template($name)") if $self->{ DEBUG };

    # references to Template::Document (or sub-class) objects objects, or
    # CODE references are assumed to be pre-compiled templates and are
    # returned intact
    return $name
        if (blessed($name) && $name->isa(DOCUMENT))
        || ref($name) eq 'CODE';

    $shortname = $name;

    unless (ref $name) {
        
        $self->debug("looking for block [$name]") if $self->{ DEBUG };

        # we first look in the BLOCKS hash for a BLOCK that may have 
        # been imported from a template (via PROCESS)
        return $template
            if ($template = $self->{ BLOCKS }->{ $name });
        
        # then we iterate through the BLKSTACK list to see if any of the
        # Template::Documents we're visiting define this BLOCK
        foreach $blocks (@{ $self->{ BLKSTACK } }) {
            return $template
                if $blocks && ($template = $blocks->{ $name });
        }
        
        # now it's time to ask the providers, so we look to see if any 
        # prefix is specified to indicate the desired provider set.
        if ($^O eq 'MSWin32') {
            # let C:/foo through
            $prefix = $1 if $shortname =~ s/^(\w{2,})://o;
        }
        else {
            $prefix = $1 if $shortname =~ s/^(\w+)://;
        }
        
        if (defined $prefix) {
            $providers = $self->{ PREFIX_MAP }->{ $prefix } 
            || return $self->throw( Template::Constants::ERROR_FILE,
                                    "no providers for template prefix '$prefix'");
        }
    }
    $providers = $self->{ PREFIX_MAP }->{ default }
        || $self->{ LOAD_TEMPLATES }
            unless $providers;


    # Finally we try the regular template providers which will 
    # handle references to files, text, etc., as well as templates
    # reference by name.  If

    $blockname = '';
    while ($shortname) {
        $self->debug("asking providers for [$shortname] [$blockname]") 
            if $self->{ DEBUG };

        foreach my $provider (@$providers) {
            ($template, $error) = $provider->fetch($shortname, $prefix);
            if ($error) {
                if ($error == Template::Constants::STATUS_ERROR) {
                    # $template contains exception object
                    if (blessed($template) && $template->isa(EXCEPTION)
                        && $template->type eq Template::Constants::ERROR_FILE) {
                        $self->throw($template);
                    }
                    else {
                        $self->throw( Template::Constants::ERROR_FILE, $template );
                    }
                }
                # DECLINE is ok, carry on
            }
            elsif (length $blockname) {
                return $template 
                    if $template = $template->blocks->{ $blockname };
            }
            else {
                return $template;
            }
        }
        
        last if ref $shortname || ! $self->{ EXPOSE_BLOCKS };
        $shortname =~ s{/([^/]+)$}{} || last;
        $blockname = length $blockname ? "$1/$blockname" : $1;
    }
        
    $self->throw(Template::Constants::ERROR_FILE, "$name: not found");
}


#------------------------------------------------------------------------
# plugin($name, \@args)
#
# Calls on each of the LOAD_PLUGINS providers in turn to fetch() (i.e. load
# and instantiate) a plugin of the specified name.  Additional parameters 
# passed are propagated to the new() constructor for the plugin.  
# Returns a reference to a new plugin object or other reference.  On 
# error, undef is returned and the appropriate error message is set for
# subsequent retrieval via error().
#------------------------------------------------------------------------

sub plugin {
    my ($self, $name, $args) = @_;
    my ($provider, $plugin, $error);
    
    $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')')
        if $self->{ DEBUG };
    
    # request the named plugin from each of the LOAD_PLUGINS providers in turn
    foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) {
        ($plugin, $error) = $provider->fetch($name, $args, $self);
        return $plugin unless $error;
        if ($error == Template::Constants::STATUS_ERROR) {
            $self->throw($plugin) if ref $plugin;
            $self->throw(Template::Constants::ERROR_PLUGIN, $plugin);
        }
    }
    
    $self->throw(Template::Constants::ERROR_PLUGIN, "$name: plugin not found");
}


#------------------------------------------------------------------------
# filter($name, \@args, $alias)
#
# Similar to plugin() above, but querying the LOAD_FILTERS providers to 
# return filter instances.  An alias may be provided which is used to
# save the returned filter in a local cache.
#------------------------------------------------------------------------

sub filter {
    my ($self, $name, $args, $alias) = @_;
    my ($provider, $filter, $error);
    
    $self->debug("filter($name, ", 
                 defined $args  ? @$args : '[ ]', 
                 defined $alias ? $alias : '<no alias>', ')')
        if $self->{ DEBUG };
    
    # use any cached version of the filter if no params provided
    return $filter 
        if ! $args && ! ref $name
            && ($filter = $self->{ FILTER_CACHE }->{ $name });
    
    # request the named filter from each of the FILTERS providers in turn
    foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
        ($filter, $error) = $provider->fetch($name, $args, $self);
        last unless $error;
        if ($error == Template::Constants::STATUS_ERROR) {
            $self->throw($filter) if ref $filter;
            $self->throw(Template::Constants::ERROR_FILTER, $filter);
        }
        # return $self->error($filter)
        #    if $error == &Template::Constants::STATUS_ERROR;
    }
    
    return $self->error("$name: filter not found")
        unless $filter;
    
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # commented out by abw on 19 Nov 2001 to fix problem with xmlstyle
    # plugin which may re-define a filter by calling define_filter()
    # multiple times.  With the automatic aliasing/caching below, any
    # new filter definition isn't seen.  Don't think this will cause
    # any problems as filters explicitly supplied with aliases will
    # still work as expected.
    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # alias defaults to name if undefined
    # $alias = $name
    #     unless defined($alias) or ref($name) or $args;

    # cache FILTER if alias is valid
    $self->{ FILTER_CACHE }->{ $alias } = $filter
        if $alias;

    return $filter;
}


#------------------------------------------------------------------------
# view(\%config)
# 
# Create a new Template::View bound to this context.
#------------------------------------------------------------------------

sub view {
    my $self = shift;
    require Template::View;
    return $VIEW_CLASS->new($self, @_)
        || $self->throw(&Template::Constants::ERROR_VIEW, 
                        $VIEW_CLASS->error);
}


#------------------------------------------------------------------------
# process($template, \%params)         [% PROCESS template var=val ... %]
# process($template, \%params, $local) [% INCLUDE template var=val ... %]
#
# Processes the template named or referenced by the first parameter.
# The optional second parameter may reference a hash array of variable
# definitions.  These are set before the template is processed by
# calling update() on the stash.  Note that, unless the third parameter
# is true, the context is not localised and these, and any other
# variables set in the template will retain their new values after this
# method returns.  The third parameter is in place so that this method
# can handle INCLUDE calls: the stash will be localized.
#
# Returns the output of processing the template.  Errors are thrown
# as Template::Exception objects via die().  
#------------------------------------------------------------------------

sub process {
    my ($self, $template, $params, $localize) = @_;
    my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) };
    my (@compiled, $name, $compiled);
    my ($stash, $component, $tblocks, $error, $tmpout);
    my $output = '';
    
    $template = [ $template ] unless ref $template eq 'ARRAY';
    
    $self->debug("process([ ", join(', '), @$template, ' ], ', 
                 defined $params ? $params : '<no params>', ', ', 
                 $localize ? '<localized>' : '<unlocalized>', ')')
        if $self->{ DEBUG };
    
    # fetch compiled template for each name specified
    foreach $name (@$template) {
        push(@compiled, $self->template($name));
    }

    if ($localize) {
        # localise the variable stash with any parameters passed
        $stash = $self->{ STASH } = $self->{ STASH }->clone($params);
    } else {
        # update stash with any new parameters passed
        $self->{ STASH }->update($params);
        $stash = $self->{ STASH };
    }

    eval {
        # save current component
        eval { $component = $stash->get('component') };

        foreach $name (@$template) {
            $compiled = shift @compiled;
            my $element = ref $compiled eq 'CODE' 
                ? { (name => (ref $name ? '' : $name), modtime => time()) }
                : $compiled;

            if (blessed($component) && $component->isa(DOCUMENT)) {
                $element->{ caller } = $component->{ name };
                $element->{ callers } = $component->{ callers } || [];
                push(@{$element->{ callers }}, $element->{ caller });
            }

            $stash->set('component', $element);
            
            unless ($localize) {
                # merge any local blocks defined in the Template::Document
                # into our local BLOCKS cache
                @$blocks{ keys %$tblocks } = values %$tblocks
                    if (blessed($compiled) && $compiled->isa(DOCUMENT))
                    && ($tblocks = $compiled->blocks);
            }
            
            if (ref $compiled eq 'CODE') {
                $tmpout = &$compiled($self);
            }
            elsif (ref $compiled) {
                $tmpout = $compiled->process($self);
            }
            else {
                $self->throw('file', 
                             "invalid template reference: $compiled");
            }
            
            if ($trim) {
                for ($tmpout) {
                    s/^\s+//;
                    s/\s+$//;
                }
            }
            $output .= $tmpout;

            # pop last item from callers.  
            # NOTE - this will not be called if template throws an 
            # error.  The whole issue of caller and callers should be 
            # revisited to try and avoid putting this info directly into
            # the component data structure.  Perhaps use a local element
            # instead?

            pop(@{$element->{ callers }})
                if (blessed($component) && $component->isa(DOCUMENT));
        }
        $stash->set('component', $component);
    };
    $error = $@;
    
    if ($localize) {
        # ensure stash is delocalised before dying
        $self->{ STASH } = $self->{ STASH }->declone();
    }
    
    $self->throw(ref $error 
                 ? $error : (Template::Constants::ERROR_FILE, $error))
        if $error;
    
    return $output;
}


#------------------------------------------------------------------------
# include($template, \%params)    [% INCLUDE template   var = val, ... %]
#
# Similar to process() above but processing the template in a local 
# context.  Any variables passed by reference to a hash as the second
# parameter will be set before the template is processed and then 
# revert to their original values before the method returns.  Similarly,
# any changes made to non-global variables within the template will 
# persist only until the template is processed.
#
# Returns the output of processing the template.  Errors are thrown
# as Template::Exception objects via die().  
#------------------------------------------------------------------------

sub include {
    my ($self, $template, $params) = @_;
    return $self->process($template, $params, 'localize me!');
}

#------------------------------------------------------------------------
# insert($file)
#
# Insert the contents of a file without parsing.
#------------------------------------------------------------------------

sub insert {
    my ($self, $file) = @_;
    my ($prefix, $providers, $text, $error);
    my $output = '';

    my $files = ref $file eq 'ARRAY' ? $file : [ $file ];

    $self->debug("insert([ ", join(', '), @$files, " ])") 
        if $self->{ DEBUG };


    FILE: foreach $file (@$files) {
        my $name = $file;

        if ($^O eq 'MSWin32') {
            # let C:/foo through
            $prefix = $1 if $name =~ s/^(\w{2,})://o;
        }
        else {
            $prefix = $1 if $name =~ s/^(\w+)://;
        }

        if (defined $prefix) {
            $providers = $self->{ PREFIX_MAP }->{ $prefix } 
                || return $self->throw(Template::Constants::ERROR_FILE,
                    "no providers for file prefix '$prefix'");
        }
        else {
            $providers = $self->{ PREFIX_MAP }->{ default }
                || $self->{ LOAD_TEMPLATES };
        }

        foreach my $provider (@$providers) {
            ($text, $error) = $provider->load($name, $prefix);
            next FILE unless $error;
            if ($error == Template::Constants::STATUS_ERROR) {
                $self->throw($text) if ref $text;
                $self->throw(Template::Constants::ERROR_FILE, $text);
            }
        }
        $self->throw(Template::Constants::ERROR_FILE, "$file: not found");
    }
    continue {
        $output .= $text;
    }
    return $output;
}


#------------------------------------------------------------------------
# throw($type, $info, \$output)          [% THROW errtype "Error info" %]
#
# Throws a Template::Exception object by calling die().  This method
# may be passed a reference to an existing Template::Exception object;
# a single value containing an error message which is used to
# instantiate a Template::Exception of type 'undef'; or a pair of
# values representing the exception type and info from which a
# Template::Exception object is instantiated.  e.g.
#
#   $context->throw($exception);
#   $context->throw("I'm sorry Dave, I can't do that");
#   $context->throw('denied', "I'm sorry Dave, I can't do that");
#
# An optional third parameter can be supplied in the last case which 
# is a reference to the current output buffer containing the results
# of processing the template up to the point at which the exception 
# was thrown.  The RETURN and STOP directives, for example, use this 
# to propagate output back to the user, but it can safely be ignored
# in most cases.
# 
# This method rides on a one-way ticket to die() oblivion.  It does not 
# return in any real sense of the word, but should get caught by a 
# surrounding eval { } block (e.g. a BLOCK or TRY) and handled 
# accordingly, or returned to the caller as an uncaught exception.
#------------------------------------------------------------------------

sub throw {
    my ($self, $error, $info, $output) = @_;
    local $" = ', ';

    # die! die! die!
    if (blessed($error) && $error->isa(EXCEPTION)) {
        die $error;
    }
    elsif (blessed($error) && $error->isa(BADGER_EXCEPTION)) {
        # convert a Badger::Exception to a Template::Exception so that
        # things continue to work during the transition to Badger
        die EXCEPTION->new($error->type, $error->info);
    }
    elsif (defined $info) {
        die (EXCEPTION->new($error, $info, $output));
    }
    else {
        $error ||= '';
        die (EXCEPTION->new('undef', $error, $output));
    }

    # not reached
}


#------------------------------------------------------------------------
# catch($error, \$output)
#
# Called by various directives after catching an error thrown via die()
# from within an eval { } block.  The first parameter contains the errror
# which may be a sanitized reference to a Template::Exception object
# (such as that raised by the throw() method above, a plugin object, 
# and so on) or an error message thrown via die from somewhere in user
# code.  The latter are coerced into 'undef' Template::Exception objects.
# Like throw() above, a reference to a scalar may be passed as an
# additional parameter to represent the current output buffer
# localised within the eval block.  As exceptions are thrown upwards
# and outwards from nested blocks, the catch() method reconstructs the
# correct output buffer from these fragments, storing it in the
# exception object for passing further onwards and upwards.
#
# Returns a reference to a Template::Exception object..
#------------------------------------------------------------------------

sub catch {
    my ($self, $error, $output) = @_;

    if ( blessed($error) 
      && ( $error->isa(EXCEPTION) || $error->isa(BADGER_EXCEPTION) ) ) {
        $error->text($output) if $output;
        return $error;
    }
    else {
        return EXCEPTION->new('undef', $error, $output);
    }
}


#------------------------------------------------------------------------
# localise(\%params)
# delocalise()
#
# The localise() method creates a local copy of the current stash,
# allowing the existing state of variables to be saved and later 
# restored via delocalise().
#
# A reference to a hash array may be passed containing local variable 
# definitions which should be added to the cloned namespace.  These 
# values persist until delocalisation.
#------------------------------------------------------------------------

sub localise {
    my $self = shift;
    $self->{ STASH } = $self->{ STASH }->clone(@_);
}

sub delocalise {
    my $self = shift;
    $self->{ STASH } = $self->{ STASH }->declone();
}


#------------------------------------------------------------------------
# visit($document, $blocks)
#
# Each Template::Document calls the visit() method on the context
# before processing itself.  It passes a reference to the hash array
# of named BLOCKs defined within the document, allowing them to be 
# added to the internal BLKSTACK list which is subsequently used by
# template() to resolve templates.
# from a provider.
#------------------------------------------------------------------------

sub visit {
    my ($self, $document, $blocks) = @_;
    unshift(@{ $self->{ BLKSTACK } }, $blocks)
}


#------------------------------------------------------------------------
# leave()
#
# The leave() method is called when the document has finished
# processing itself.  This removes the entry from the BLKSTACK list
# that was added visit() above.  For persistence of BLOCK definitions,
# the process() method (i.e. the PROCESS directive) does some extra
# magic to copy BLOCKs into a shared hash.
#------------------------------------------------------------------------

sub leave {
    my $self = shift;
    shift(@{ $self->{ BLKSTACK } });
}


#------------------------------------------------------------------------
# define_block($name, $block)
#
# Adds a new BLOCK definition to the local BLOCKS cache.  $block may
# be specified as a reference to a sub-routine or Template::Document
# object or as text which is compiled into a template.  Returns a true
# value (the $block reference or compiled block reference) if
# successful or undef on failure.  Call error() to retrieve the
# relevent error message (i.e. compilation failure).
#------------------------------------------------------------------------

sub define_block {
    my ($self, $name, $block) = @_;
    $block = $self->template(\$block)
    || return undef
        unless ref $block;
    $self->{ BLOCKS }->{ $name } = $block;
}


#------------------------------------------------------------------------
# define_filter($name, $filter, $is_dynamic)
#
# Adds a new FILTER definition to the local FILTER_CACHE.
#------------------------------------------------------------------------

sub define_filter {
    my ($self, $name, $filter, $is_dynamic) = @_;
    my ($result, $error);
    $filter = [ $filter, 1 ] if $is_dynamic;

    foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
    ($result, $error) = $provider->store($name, $filter);
    return 1 unless $error;
    $self->throw(&Template::Constants::ERROR_FILTER, $result)
        if $error == &Template::Constants::STATUS_ERROR;
    }
    $self->throw(&Template::Constants::ERROR_FILTER, 
         "FILTER providers declined to store filter $name");
}

sub define_view {
    my ($self, $name, $params) = @_;
    my $base;

    if (defined $params->{ base }) {
        my $base = $self->{ STASH }->get($params->{ base });

        return $self->throw(
            &Template::Constants::ERROR_VIEW, 
            "view base is not defined: $params->{ base }"
        ) unless $base;

        return $self->throw(
            &Template::Constants::ERROR_VIEW, 
            "view base is not a $VIEW_CLASS object: $params->{ base } => $base"
        ) unless blessed($base) && $base->isa($VIEW_CLASS);
        
        $params->{ base } = $base;
    }
    my $view = $self->view($params);
    $view->seal();
    $self->{ STASH }->set($name, $view);
}

sub define_views {
    my ($self, $views) = @_;
    
    # a list reference is better because the order is deterministic (and so
    # allows an earlier VIEW to be the base for a later VIEW), but we'll 
    # accept a hash reference and assume that the user knows the order of
    # processing is undefined
    $views = [ %$views ] 
        if ref $views eq 'HASH';
    
    # make of copy so we don't destroy the original list reference
    my @items = @$views;
    my ($name, $view);
    
    while (@items) {
        $self->define_view(splice(@items, 0, 2));
    }
}


#------------------------------------------------------------------------
# reset()
# 
# Reset the state of the internal BLOCKS hash to clear any BLOCK 
# definitions imported via the PROCESS directive.  Any original 
# BLOCKS definitions passed to the constructor will be restored.
#------------------------------------------------------------------------

sub reset {
    my ($self, $blocks) = @_;
    $self->{ BLKSTACK } = [ ];
    $self->{ BLOCKS   } = { %{ $self->{ INIT_BLOCKS } } };
}


#------------------------------------------------------------------------
# stash()
#
# Simple accessor methods to return the STASH values.  This is likely
# to be called quite often so we provide a direct method rather than
# relying on the slower AUTOLOAD.
#------------------------------------------------------------------------

sub stash {
    return $_[0]->{ STASH };
}


#------------------------------------------------------------------------
# define_vmethod($type, $name, \&sub)
#
# Passes $type, $name, and &sub on to stash->define_vmethod().
#------------------------------------------------------------------------
sub define_vmethod {
    my $self = shift;
    $self->stash->define_vmethod(@_);
}


#------------------------------------------------------------------------
# debugging($command, @args, \%params)
#
# Method for controlling the debugging status of the context.  The first
# argument can be 'on' or 'off' to enable/disable debugging, 'format'
# to define the format of the debug message, or 'msg' to generate a 
# debugging message reporting the file, line, message text, etc., 
# according to the current debug format.
#------------------------------------------------------------------------

sub debugging {
    my $self = shift;
    my $hash = ref $_[-1] eq 'HASH' ? pop : { };
    my @args = @_;

#    print "*** debug(@args)\n";
    if (@args) {
    if ($args[0] =~ /^on|1$/i) {
        $self->{ DEBUG_DIRS } = 1;
        shift(@args);
    }
    elsif ($args[0] =~ /^off|0$/i) {
        $self->{ DEBUG_DIRS } = 0;
        shift(@args);
    }
    }

    if (@args) {
    if ($args[0] =~ /^msg$/i) {
            return unless $self->{ DEBUG_DIRS };
        my $format = $self->{ DEBUG_FORMAT };
        $format = $DEBUG_FORMAT unless defined $format;
        $format =~ s/\$(\w+)/$hash->{ $1 }/ge;
        return $format;
    }
    elsif ($args[0] =~ /^format$/i) {
        $self->{ DEBUG_FORMAT } = $args[1];
    }
    # else ignore
    }

    return '';
}


#------------------------------------------------------------------------
# AUTOLOAD
#
# Provides pseudo-methods for read-only access to various internal 
# members.  For example, templates(), plugins(), filters(),
# eval_perl(), load_perl(), etc.  These aren't called very often, or
# may never be called at all.
#------------------------------------------------------------------------

sub AUTOLOAD {
    my $self   = shift;
    my $method = $AUTOLOAD;
    my $result;

    $method =~ s/.*:://;
    return if $method eq 'DESTROY';

    warn "no such context method/member: $method\n"
    unless defined ($result = $self->{ uc $method });

    return $result;
}


#------------------------------------------------------------------------
# DESTROY
#
# Stash may contain references back to the Context via macro closures,
# etc.  This breaks the circular references. 
#------------------------------------------------------------------------

sub DESTROY {
    my $self = shift;
    undef $self->{ STASH };
}



#========================================================================
#                     -- PRIVATE METHODS --
#========================================================================

#------------------------------------------------------------------------
# _init(\%config)
#
# Initialisation method called by Template::Base::new()
#------------------------------------------------------------------------

sub _init {
    my ($self, $config) = @_;
    my ($name, $item, $method, $block, $blocks);
    my @itemlut = ( 
        LOAD_TEMPLATES => 'provider',
        LOAD_PLUGINS   => 'plugins',
        LOAD_FILTERS   => 'filters' 
    );

    # LOAD_TEMPLATE, LOAD_PLUGINS, LOAD_FILTERS - lists of providers
    while (($name, $method) = splice(@itemlut, 0, 2)) {
        $item = $config->{ $name } 
            || Template::Config->$method($config)
            || return $self->error($Template::Config::ERROR);
        $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ];
    }

    my $providers  = $self->{ LOAD_TEMPLATES };
    my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { };
    while (my ($key, $val) = each %$prefix_map) {
        $prefix_map->{ $key } = [ ref $val ? $val : 
                                  map { $providers->[$_] } split(/\D+/, $val) ]
                                  unless ref $val eq 'ARRAY';
    }

    # STASH
    $self->{ STASH } = $config->{ STASH } || do {
        my $predefs  = $config->{ VARIABLES } 
            || $config->{ PRE_DEFINE } 
            || { };

        # hack to get stash to know about debug mode
        $predefs->{ _DEBUG } = ( ($config->{ DEBUG } || 0)
                                 & &Template::Constants::DEBUG_UNDEF ) ? 1 : 0
                                 unless defined $predefs->{ _DEBUG };
        $predefs->{ _STRICT } = $config->{ STRICT };
        
        Template::Config->stash($predefs)
            || return $self->error($Template::Config::ERROR);
    };
    
    # compile any template BLOCKS specified as text
    $blocks = $config->{ BLOCKS } || { };
    $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = { 
        map {
            $block = $blocks->{ $_ };
            $block = $self->template(\$block)
                || return undef
                unless ref $block;
            ($_ => $block);
        } 
        keys %$blocks
    };

    # define any VIEWS
    $self->define_views( $config->{ VIEWS } )
        if $config->{ VIEWS };

    # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    # RECURSION - flag indicating is recursion into templates is supported
    # EVAL_PERL - flag indicating if PERL blocks should be processed
    # TRIM      - flag to remove leading and trailing whitespace from output
    # BLKSTACK  - list of hashes of BLOCKs defined in current template(s)
    # CONFIG    - original configuration hash
    # EXPOSE_BLOCKS - make blocks visible as pseudo-files
    # DEBUG_FORMAT  - format for generating template runtime debugging messages
    # DEBUG         - format for generating template runtime debugging messages

    $self->{ RECURSION } = $config->{ RECURSION } || 0;
    $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0;
    $self->{ TRIM      } = $config->{ TRIM } || 0;
    $self->{ BLKSTACK  } = [ ];
    $self->{ CONFIG    } = $config;
    $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS }
                                     ? $config->{ EXPOSE_BLOCKS } 
                                     : 0;

    $self->{ DEBUG_FORMAT  } =  $config->{ DEBUG_FORMAT };
    $self->{ DEBUG_DIRS    } = ($config->{ DEBUG } || 0) 
                               & Template::Constants::DEBUG_DIRS;
    $self->{ DEBUG } = defined $config->{ DEBUG } 
        ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT
                               | Template::Constants::DEBUG_FLAGS )
        : $DEBUG;

    return $self;
}


#------------------------------------------------------------------------
# _dump()
#
# Debug method which returns a string representing the internal state
# of the context object.
#------------------------------------------------------------------------

sub _dump {
    my $self = shift;
    my $output = "[Template::Context] {\n";
    my $format = "    %-16s => %s\n";
    my $key;

    foreach $key (qw( RECURSION EVAL_PERL TRIM )) {
    $output .= sprintf($format, $key, $self->{ $key });
    }
    foreach my $pname (qw( LOAD_TEMPLATES LOAD_PLUGINS LOAD_FILTERS )) {
    my $provtext = "[\n";
    foreach my $prov (@{ $self->{ $pname } }) {
        $provtext .= $prov->_dump();
#       $provtext .= ",\n";
    }
    $provtext =~ s/\n/\n        /g;
    $provtext =~ s/\s+$//;
    $provtext .= ",\n    ]";
    $output .= sprintf($format, $pname, $provtext);
    }
    $output .= sprintf($format, STASH => $self->{ STASH }->_dump());
    $output .= '}';
    return $output;
}


1;

__END__

# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: