893 lines
30 KiB
Perl
893 lines
30 KiB
Perl
#============================================================= -*-Perl-*-
|
|
#
|
|
# Template::Stash
|
|
#
|
|
# DESCRIPTION
|
|
# Definition of an object class which stores and manages access to
|
|
# variables for 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::Stash;
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Template::VMethods;
|
|
use Template::Exception;
|
|
use Scalar::Util qw( blessed reftype );
|
|
|
|
our $VERSION = '3.009';
|
|
our $DEBUG = 0 unless defined $DEBUG;
|
|
our $PRIVATE = qr/^[_.]/;
|
|
our $UNDEF_TYPE = 'var.undef';
|
|
our $UNDEF_INFO = 'undefined variable: %s';
|
|
|
|
# alias _dotop() to dotop() so that we have a consistent method name
|
|
# between the Perl and XS stash implementations
|
|
*dotop = \&_dotop;
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# Virtual Methods
|
|
#
|
|
# If any of $ROOT_OPS, $SCALAR_OPS, $HASH_OPS or $LIST_OPS are already
|
|
# defined then we merge their contents with the default virtual methods
|
|
# define by Template::VMethods. Otherwise we can directly alias the
|
|
# corresponding Template::VMethod package vars.
|
|
#------------------------------------------------------------------------
|
|
|
|
our $ROOT_OPS = defined $ROOT_OPS
|
|
? { %{$Template::VMethods::ROOT_VMETHODS}, %$ROOT_OPS }
|
|
: $Template::VMethods::ROOT_VMETHODS;
|
|
|
|
our $SCALAR_OPS = defined $SCALAR_OPS
|
|
? { %{$Template::VMethods::TEXT_VMETHODS}, %$SCALAR_OPS }
|
|
: $Template::VMethods::TEXT_VMETHODS;
|
|
|
|
our $HASH_OPS = defined $HASH_OPS
|
|
? { %{$Template::VMethods::HASH_VMETHODS}, %$HASH_OPS }
|
|
: $Template::VMethods::HASH_VMETHODS;
|
|
|
|
our $LIST_OPS = defined $LIST_OPS
|
|
? { %{$Template::VMethods::LIST_VMETHODS}, %$LIST_OPS }
|
|
: $Template::VMethods::LIST_VMETHODS;
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# define_vmethod($type, $name, \&sub)
|
|
#
|
|
# Defines a virtual method of type $type (SCALAR, HASH, or LIST), with
|
|
# name $name, that invokes &sub when called. It is expected that &sub
|
|
# be able to handle the type that it will be called upon.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub define_vmethod {
|
|
my ($class, $type, $name, $sub) = @_;
|
|
my $op;
|
|
$type = lc $type;
|
|
|
|
if ($type eq 'scalar' || $type eq 'item') {
|
|
$op = $SCALAR_OPS;
|
|
}
|
|
elsif ($type eq 'hash') {
|
|
$op = $HASH_OPS;
|
|
}
|
|
elsif ($type eq 'list' || $type eq 'array') {
|
|
$op = $LIST_OPS;
|
|
}
|
|
else {
|
|
die "invalid vmethod type: $type\n";
|
|
}
|
|
|
|
$op->{ $name } = $sub;
|
|
|
|
return 1;
|
|
}
|
|
|
|
|
|
#========================================================================
|
|
# ----- CLASS METHODS -----
|
|
#========================================================================
|
|
|
|
#------------------------------------------------------------------------
|
|
# new(\%params)
|
|
#
|
|
# Constructor method which creates a new Template::Stash object.
|
|
# An optional hash reference may be passed containing variable
|
|
# definitions that will be used to initialise the stash.
|
|
#
|
|
# Returns a reference to a newly created Template::Stash.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub new {
|
|
my $class = shift;
|
|
my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ };
|
|
|
|
my $self = {
|
|
global => { },
|
|
%$params,
|
|
%$ROOT_OPS,
|
|
'_PARENT' => undef,
|
|
};
|
|
|
|
bless $self, $class;
|
|
}
|
|
|
|
|
|
#========================================================================
|
|
# ----- PUBLIC OBJECT METHODS -----
|
|
#========================================================================
|
|
|
|
#------------------------------------------------------------------------
|
|
# clone(\%params)
|
|
#
|
|
# Creates a copy of the current stash object to effect localisation
|
|
# of variables. The new stash is blessed into the same class as the
|
|
# parent (which may be a derived class) and has a '_PARENT' member added
|
|
# which contains a reference to the parent stash that created it
|
|
# ($self). This member is used in a successive declone() method call to
|
|
# return the reference to the parent.
|
|
#
|
|
# A parameter may be provided which should reference a hash of
|
|
# variable/values which should be defined in the new stash. The
|
|
# update() method is called to define these new variables in the cloned
|
|
# stash.
|
|
#
|
|
# Returns a reference to a cloned Template::Stash.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub clone {
|
|
my ($self, $params) = @_;
|
|
$params ||= { };
|
|
|
|
# look out for magical 'import' argument which imports another hash
|
|
my $import = $params->{ import };
|
|
if (defined $import && ref $import eq 'HASH') {
|
|
delete $params->{ import };
|
|
}
|
|
else {
|
|
undef $import;
|
|
}
|
|
|
|
my $clone = bless {
|
|
%$self, # copy all parent members
|
|
%$params, # copy all new data
|
|
'_PARENT' => $self, # link to parent
|
|
}, ref $self;
|
|
|
|
# perform hash import if defined
|
|
&{ $HASH_OPS->{ import } }($clone, $import)
|
|
if defined $import;
|
|
|
|
return $clone;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# declone($export)
|
|
#
|
|
# Returns a reference to the PARENT stash. When called in the following
|
|
# manner:
|
|
# $stash = $stash->declone();
|
|
# the reference count on the current stash will drop to 0 and be "freed"
|
|
# and the caller will be left with a reference to the parent. This
|
|
# contains the state of the stash before it was cloned.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub declone {
|
|
my $self = shift;
|
|
$self->{ _PARENT } || $self;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# get($ident)
|
|
#
|
|
# Returns the value for an variable stored in the stash. The variable
|
|
# may be specified as a simple string, e.g. 'foo', or as an array
|
|
# reference representing compound variables. In the latter case, each
|
|
# pair of successive elements in the list represent a node in the
|
|
# compound variable. The first is the variable name, the second a
|
|
# list reference of arguments or 0 if undefined. So, the compound
|
|
# variable [% foo.bar('foo').baz %] would be represented as the list
|
|
# [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ]. Returns the value of the
|
|
# identifier or an empty string if undefined. Errors are thrown via
|
|
# die().
|
|
#------------------------------------------------------------------------
|
|
|
|
sub get {
|
|
my ($self, $ident, $args) = @_;
|
|
my ($root, $result);
|
|
$root = $self;
|
|
|
|
if (ref $ident eq 'ARRAY'
|
|
|| (index($ident,'.') > -1)
|
|
&& ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) {
|
|
my $size = $#$ident;
|
|
|
|
# if $ident is a list reference, then we evaluate each item in the
|
|
# identifier against the previous result, using the root stash
|
|
# ($self) as the first implicit 'result'...
|
|
|
|
foreach (my $i = 0; $i <= $size; $i += 2) {
|
|
$result = $self->_dotop($root, @$ident[$i, $i+1]);
|
|
last unless defined $result;
|
|
$root = $result;
|
|
}
|
|
}
|
|
else {
|
|
$result = $self->_dotop($root, $ident, $args);
|
|
}
|
|
|
|
return defined $result
|
|
? $result
|
|
: $self->undefined($ident, $args);
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# set($ident, $value, $default)
|
|
#
|
|
# Updates the value for a variable in the stash. The first parameter
|
|
# should be the variable name or array, as per get(). The second
|
|
# parameter should be the intended value for the variable. The third,
|
|
# optional parameter is a flag which may be set to indicate 'default'
|
|
# mode. When set true, the variable will only be updated if it is
|
|
# currently undefined or has a false value. The magical 'IMPORT'
|
|
# variable identifier may be used to indicate that $value is a hash
|
|
# reference whose values should be imported. Returns the value set,
|
|
# or an empty string if not set (e.g. default mode). In the case of
|
|
# IMPORT, returns the number of items imported from the hash.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub set {
|
|
my ($self, $ident, $value, $default) = @_;
|
|
my ($root, $result, $error);
|
|
|
|
$root = $self;
|
|
|
|
ELEMENT: {
|
|
if (ref $ident eq 'ARRAY'
|
|
|| (index($ident,'.') != -1) # has a '.' in it somewhere
|
|
&& ($ident = [ map { s/\(.*$//; ($_, 0) }
|
|
split(/\./, $ident) ])) {
|
|
|
|
# a compound identifier may contain multiple elements (e.g.
|
|
# foo.bar.baz) and we must first resolve all but the last,
|
|
# using _dotop() with the $lvalue flag set which will create
|
|
# intermediate hashes if necessary...
|
|
my $size = $#$ident;
|
|
foreach (my $i = 0; $i < $size - 2; $i += 2) {
|
|
$result = $self->_dotop($root, @$ident[$i, $i+1], 1);
|
|
last ELEMENT unless defined $result;
|
|
$root = $result;
|
|
}
|
|
|
|
# then we call _assign() to assign the value to the last element
|
|
$result = $self->_assign($root, @$ident[$size-1, $size],
|
|
$value, $default);
|
|
}
|
|
else {
|
|
$result = $self->_assign($root, $ident, 0, $value, $default);
|
|
}
|
|
}
|
|
|
|
return defined $result ? $result : '';
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# getref($ident)
|
|
#
|
|
# Returns a "reference" to a particular item. This is represented as a
|
|
# closure which will return the actual stash item when called.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub getref {
|
|
my ($self, $ident, $args) = @_;
|
|
my ($root, $item, $result);
|
|
$root = $self;
|
|
|
|
if (ref $ident eq 'ARRAY') {
|
|
my $size = $#$ident;
|
|
|
|
foreach (my $i = 0; $i <= $size; $i += 2) {
|
|
($item, $args) = @$ident[$i, $i + 1];
|
|
last if $i >= $size - 2; # don't evaluate last node
|
|
last unless defined
|
|
($root = $self->_dotop($root, $item, $args));
|
|
}
|
|
}
|
|
else {
|
|
$item = $ident;
|
|
}
|
|
|
|
if (defined $root) {
|
|
return sub { my @args = (@{$args||[]}, @_);
|
|
$self->_dotop($root, $item, \@args);
|
|
}
|
|
}
|
|
else {
|
|
return sub { '' };
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# update(\%params)
|
|
#
|
|
# Update multiple variables en masse. No magic is performed. Simple
|
|
# variable names only.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub update {
|
|
my ($self, $params) = @_;
|
|
|
|
# look out for magical 'import' argument to import another hash
|
|
my $import = $params->{ import };
|
|
if (defined $import && ref $import eq 'HASH') {
|
|
@$self{ keys %$import } = values %$import;
|
|
delete $params->{ import };
|
|
}
|
|
|
|
@$self{ keys %$params } = values %$params;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# undefined($ident, $args)
|
|
#
|
|
# Method called when a get() returns an undefined value. Can be redefined
|
|
# in a subclass to implement alternate handling.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub undefined {
|
|
my ($self, $ident, $args) = @_;
|
|
|
|
if ($self->{ _STRICT }) {
|
|
# Sorry, but we can't provide a sensible source file and line without
|
|
# re-designing the whole architecture of TT (see TT3)
|
|
die Template::Exception->new(
|
|
$UNDEF_TYPE,
|
|
sprintf(
|
|
$UNDEF_INFO,
|
|
$self->_reconstruct_ident($ident)
|
|
)
|
|
) if $self->{ _STRICT };
|
|
}
|
|
else {
|
|
# There was a time when I thought this was a good idea. But it's not.
|
|
return '';
|
|
}
|
|
}
|
|
|
|
sub _reconstruct_ident {
|
|
my ($self, $ident) = @_;
|
|
my ($name, $args, @output);
|
|
my @input = ref $ident eq 'ARRAY' ? @$ident : ($ident);
|
|
|
|
while (@input) {
|
|
$name = shift @input;
|
|
$args = shift @input || 0;
|
|
$name .= '(' . join(', ', map { /^\d+$/ ? $_ : "'$_'" } @$args) . ')'
|
|
if $args && ref $args eq 'ARRAY';
|
|
push(@output, $name);
|
|
}
|
|
|
|
return join('.', @output);
|
|
}
|
|
|
|
|
|
#========================================================================
|
|
# ----- PRIVATE OBJECT METHODS -----
|
|
#========================================================================
|
|
|
|
#------------------------------------------------------------------------
|
|
# _dotop($root, $item, \@args, $lvalue)
|
|
#
|
|
# This is the core 'dot' operation method which evaluates elements of
|
|
# variables against their root. All variables have an implicit root
|
|
# which is the stash object itself (a hash). Thus, a non-compound
|
|
# variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is
|
|
# '(stash.)foo.bar'. The first parameter is a reference to the current
|
|
# root, initially the stash itself. The second parameter contains the
|
|
# name of the variable element, e.g. 'foo'. The third optional
|
|
# parameter is a reference to a list of any parenthesised arguments
|
|
# specified for the variable, which are passed to sub-routines, object
|
|
# methods, etc. The final parameter is an optional flag to indicate
|
|
# if this variable is being evaluated on the left side of an assignment
|
|
# (e.g. foo.bar.baz = 10). When set true, intermediated hashes will
|
|
# be created (e.g. bar) if necessary.
|
|
#
|
|
# Returns the result of evaluating the item against the root, having
|
|
# performed any variable "magic". The value returned can then be used
|
|
# as the root of the next _dotop() in a compound sequence. Returns
|
|
# undef if the variable is undefined.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub _dotop {
|
|
my ($self, $root, $item, $args, $lvalue) = @_;
|
|
my $rootref = ref $root;
|
|
my $atroot = (blessed $root && $root->isa(ref $self));
|
|
my ($value, @result);
|
|
|
|
$args ||= [ ];
|
|
$lvalue ||= 0;
|
|
|
|
# print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n"
|
|
# if $DEBUG;
|
|
|
|
# return undef without an error if either side of the dot is unviable
|
|
return undef unless defined($root) and defined($item);
|
|
|
|
# or if an attempt is made to access a private member, starting _ or .
|
|
return undef if $PRIVATE && $item =~ /$PRIVATE/;
|
|
|
|
if ($atroot || $rootref eq 'HASH') {
|
|
# if $root is a regular HASH or a Template::Stash kinda HASH (the
|
|
# *real* root of everything). We first lookup the named key
|
|
# in the hash, or create an empty hash in its place if undefined
|
|
# and the $lvalue flag is set. Otherwise, we check the HASH_OPS
|
|
# pseudo-methods table, calling the code if found, or return undef.
|
|
|
|
if (defined($value = $root->{ $item })) {
|
|
return $value unless ref $value eq 'CODE'; ## RETURN
|
|
@result = &$value(@$args); ## @result
|
|
}
|
|
elsif ($lvalue) {
|
|
# we create an intermediate hash if this is an lvalue
|
|
return $root->{ $item } = { }; ## RETURN
|
|
}
|
|
# ugly hack: only allow import vmeth to be called on root stash
|
|
elsif (($value = $HASH_OPS->{ $item })
|
|
&& ! $atroot || $item eq 'import') {
|
|
@result = &$value($root, @$args); ## @result
|
|
}
|
|
elsif ( ref $item eq 'ARRAY' ) {
|
|
# hash slice
|
|
return [@$root{@$item}]; ## RETURN
|
|
}
|
|
}
|
|
elsif ($rootref eq 'ARRAY') {
|
|
# if root is an ARRAY then we check for a LIST_OPS pseudo-method
|
|
# or return the numerical index into the array, or undef
|
|
if ($value = $LIST_OPS->{ $item }) {
|
|
@result = &$value($root, @$args); ## @result
|
|
}
|
|
elsif ($item =~ /^-?\d+$/) {
|
|
$value = $root->[$item];
|
|
return $value unless ref $value eq 'CODE'; ## RETURN
|
|
@result = &$value(@$args); ## @result
|
|
}
|
|
elsif ( ref $item eq 'ARRAY' ) {
|
|
# array slice
|
|
return [@$root[@$item]]; ## RETURN
|
|
}
|
|
}
|
|
|
|
# NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL')
|
|
# doesn't appear to work with CGI, returning true for the first call
|
|
# and false for all subsequent calls.
|
|
|
|
# UPDATE: that doesn't appear to be the case any more
|
|
|
|
elsif (blessed($root) && $root->can('can')) {
|
|
|
|
# if $root is a blessed reference (i.e. inherits from the
|
|
# UNIVERSAL object base class) then we call the item as a method.
|
|
# If that fails then we try to fallback on HASH behaviour if
|
|
# possible.
|
|
eval { @result = $root->$item(@$args); };
|
|
|
|
if ($@) {
|
|
# temporary hack - required to propagate errors thrown
|
|
# by views; if $@ is a ref (e.g. Template::Exception
|
|
# object then we assume it's a real error that needs
|
|
# real throwing
|
|
|
|
my $class = ref($root) || $root;
|
|
|
|
# Fail only if the function exists
|
|
die $@ if ( ref($@) || $root->can($item) );
|
|
|
|
# failed to call object method, so try some fallbacks
|
|
if (reftype $root eq 'HASH') {
|
|
if( defined($value = $root->{ $item })) {
|
|
return $value unless ref $value eq 'CODE'; ## RETURN
|
|
@result = &$value(@$args);
|
|
}
|
|
elsif ($value = $HASH_OPS->{ $item }) {
|
|
@result = &$value($root, @$args);
|
|
}
|
|
elsif ($value = $LIST_OPS->{ $item }) {
|
|
@result = &$value([$root], @$args);
|
|
}
|
|
}
|
|
elsif (reftype $root eq 'ARRAY') {
|
|
if( $value = $LIST_OPS->{ $item }) {
|
|
@result = &$value($root, @$args);
|
|
}
|
|
elsif( $item =~ /^-?\d+$/ ) {
|
|
$value = $root->[$item];
|
|
return $value unless ref $value eq 'CODE'; ## RETURN
|
|
@result = &$value(@$args); ## @result
|
|
}
|
|
elsif ( ref $item eq 'ARRAY' ) {
|
|
# array slice
|
|
return [@$root[@$item]]; ## RETURN
|
|
}
|
|
}
|
|
elsif ($value = $SCALAR_OPS->{ $item }) {
|
|
@result = &$value($root, @$args);
|
|
}
|
|
elsif ($value = $LIST_OPS->{ $item }) {
|
|
@result = &$value([$root], @$args);
|
|
}
|
|
elsif ($self->{ _DEBUG }) {
|
|
@result = (undef, $@);
|
|
}
|
|
}
|
|
}
|
|
elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
|
|
# at this point, it doesn't look like we've got a reference to
|
|
# anything we know about, so we try the SCALAR_OPS pseudo-methods
|
|
# table (but not for l-values)
|
|
@result = &$value($root, @$args); ## @result
|
|
}
|
|
elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
|
|
# last-ditch: can we promote a scalar to a one-element
|
|
# list and apply a LIST_OPS virtual method?
|
|
@result = &$value([$root], @$args);
|
|
}
|
|
elsif ($self->{ _DEBUG }) {
|
|
die "don't know how to access [ $root ].$item\n"; ## DIE
|
|
}
|
|
else {
|
|
@result = ();
|
|
}
|
|
|
|
# fold multiple return items into a list unless first item is undef
|
|
if (defined $result[0]) {
|
|
return ## RETURN
|
|
scalar @result > 1 ? [ @result ] : $result[0];
|
|
}
|
|
elsif (defined $result[1]) {
|
|
die $result[1]; ## DIE
|
|
}
|
|
elsif ($self->{ _DEBUG }) {
|
|
die "$item is undefined\n"; ## DIE
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# _assign($root, $item, \@args, $value, $default)
|
|
#
|
|
# Similar to _dotop() above, but assigns a value to the given variable
|
|
# instead of simply returning it. The first three parameters are the
|
|
# root item, the item and arguments, as per _dotop(), followed by the
|
|
# value to which the variable should be set and an optional $default
|
|
# flag. If set true, the variable will only be set if currently false
|
|
# (undefined/zero)
|
|
#------------------------------------------------------------------------
|
|
|
|
sub _assign {
|
|
my ($self, $root, $item, $args, $value, $default) = @_;
|
|
my $rootref = ref $root;
|
|
my $atroot = ($root eq $self);
|
|
my $result;
|
|
$args ||= [ ];
|
|
$default ||= 0;
|
|
|
|
# return undef without an error if either side of the dot is unviable
|
|
return undef unless $root and defined $item;
|
|
|
|
# or if an attempt is made to update a private member, starting _ or .
|
|
return undef if $PRIVATE && $item =~ /$PRIVATE/;
|
|
|
|
if ($rootref eq 'HASH' || $atroot) {
|
|
# if the root is a hash we set the named key
|
|
return ($root->{ $item } = $value) ## RETURN
|
|
unless $default && $root->{ $item };
|
|
}
|
|
elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) {
|
|
# or set a list item by index number
|
|
return ($root->[$item] = $value) ## RETURN
|
|
unless $default && $root->{ $item };
|
|
}
|
|
elsif (blessed($root)) {
|
|
# try to call the item as a method of an object
|
|
|
|
return $root->$item(@$args, $value) ## RETURN
|
|
unless $default && $root->$item();
|
|
|
|
# 2 issues:
|
|
# - method call should be wrapped in eval { }
|
|
# - fallback on hash methods if object method not found
|
|
#
|
|
# eval { $result = $root->$item(@$args, $value); };
|
|
#
|
|
# if ($@) {
|
|
# die $@ if ref($@) || ($@ !~ /Can't locate object method/);
|
|
#
|
|
# # failed to call object method, so try some fallbacks
|
|
# if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) {
|
|
# $result = ($root->{ $item } = $value)
|
|
# unless $default && $root->{ $item };
|
|
# }
|
|
# }
|
|
# return $result; ## RETURN
|
|
}
|
|
else {
|
|
die "don't know how to assign to [$root].[$item]\n"; ## DIE
|
|
}
|
|
|
|
return undef;
|
|
}
|
|
|
|
|
|
#------------------------------------------------------------------------
|
|
# _dump()
|
|
#
|
|
# Debug method which returns a string representing the internal state
|
|
# of the object. The method calls itself recursively to dump sub-hashes.
|
|
#------------------------------------------------------------------------
|
|
|
|
sub _dump {
|
|
my $self = shift;
|
|
return "[Template::Stash] " . $self->_dump_frame(2);
|
|
}
|
|
|
|
sub _dump_frame {
|
|
my ($self, $indent) = @_;
|
|
$indent ||= 1;
|
|
my $buffer = ' ';
|
|
my $pad = $buffer x $indent;
|
|
my $text = "{\n";
|
|
local $" = ', ';
|
|
|
|
my ($key, $value);
|
|
|
|
return $text . "...excessive recursion, terminating\n"
|
|
if $indent > 32;
|
|
|
|
foreach $key (keys %$self) {
|
|
$value = $self->{ $key };
|
|
$value = '<undef>' unless defined $value;
|
|
next if index($key,'.') == 0; # has '.' as the first char.
|
|
if (ref($value) eq 'ARRAY') {
|
|
$value = '[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
|
|
@$value) . ' ]';
|
|
}
|
|
elsif (ref $value eq 'HASH') {
|
|
$value = _dump_frame($value, $indent + 1);
|
|
}
|
|
|
|
$text .= sprintf("$pad%-16s => $value\n", $key);
|
|
}
|
|
$text .= $buffer x ($indent - 1) . '}';
|
|
return $text;
|
|
}
|
|
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
Template::Stash - Magical storage for template variables
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use Template::Stash;
|
|
|
|
my $stash = Template::Stash->new(\%vars);
|
|
|
|
# get variable values
|
|
$value = $stash->get($variable);
|
|
$value = $stash->get(\@compound);
|
|
|
|
# set variable value
|
|
$stash->set($variable, $value);
|
|
$stash->set(\@compound, $value);
|
|
|
|
# default variable value
|
|
$stash->set($variable, $value, 1);
|
|
$stash->set(\@compound, $value, 1);
|
|
|
|
# set variable values en masse
|
|
$stash->update(\%new_vars)
|
|
|
|
# methods for (de-)localising variables
|
|
$stash = $stash->clone(\%new_vars);
|
|
$stash = $stash->declone();
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
The C<Template::Stash> module defines an object class which is used to store
|
|
variable values for the runtime use of the template processor. Variable
|
|
values are stored internally in a hash reference (which itself is blessed
|
|
to create the object) and are accessible via the L<get()> and L<set()> methods.
|
|
|
|
Variables may reference hash arrays, lists, subroutines and objects
|
|
as well as simple values. The stash automatically performs the right
|
|
magic when dealing with variables, calling code or object methods,
|
|
indexing into lists, hashes, etc.
|
|
|
|
The stash has L<clone()> and L<declone()> methods which are used by the
|
|
template processor to make temporary copies of the stash for
|
|
localising changes made to variables.
|
|
|
|
=head1 PUBLIC METHODS
|
|
|
|
=head2 new(\%params)
|
|
|
|
The C<new()> constructor method creates and returns a reference to a new
|
|
C<Template::Stash> object.
|
|
|
|
my $stash = Template::Stash->new();
|
|
|
|
A hash reference may be passed to provide variables and values which
|
|
should be used to initialise the stash.
|
|
|
|
my $stash = Template::Stash->new({ var1 => 'value1',
|
|
var2 => 'value2' });
|
|
|
|
=head2 get($variable)
|
|
|
|
The C<get()> method retrieves the variable named by the first parameter.
|
|
|
|
$value = $stash->get('var1');
|
|
|
|
Dotted compound variables can be retrieved by specifying the variable
|
|
elements by reference to a list. Each node in the variable occupies
|
|
two entries in the list. The first gives the name of the variable
|
|
element, the second is a reference to a list of arguments for that
|
|
element, or C<0> if none.
|
|
|
|
[% foo.bar(10).baz(20) %]
|
|
|
|
$stash->get([ 'foo', 0, 'bar', [ 10 ], 'baz', [ 20 ] ]);
|
|
|
|
=head2 set($variable, $value, $default)
|
|
|
|
The C<set()> method sets the variable name in the first parameter to the
|
|
value specified in the second.
|
|
|
|
$stash->set('var1', 'value1');
|
|
|
|
If the third parameter evaluates to a true value, the variable is
|
|
set only if it did not have a true value before.
|
|
|
|
$stash->set('var2', 'default_value', 1);
|
|
|
|
Dotted compound variables may be specified as per L<get()> above.
|
|
|
|
[% foo.bar = 30 %]
|
|
|
|
$stash->set([ 'foo', 0, 'bar', 0 ], 30);
|
|
|
|
The magical variable 'C<IMPORT>' can be specified whose corresponding
|
|
value should be a hash reference. The contents of the hash array are
|
|
copied (i.e. imported) into the current namespace.
|
|
|
|
# foo.bar = baz, foo.wiz = waz
|
|
$stash->set('foo', { 'bar' => 'baz', 'wiz' => 'waz' });
|
|
|
|
# import 'foo' into main namespace: bar = baz, wiz = waz
|
|
$stash->set('IMPORT', $stash->get('foo'));
|
|
|
|
=head2 update($variables)
|
|
|
|
This method can be used to set or update several variables in one go.
|
|
|
|
$stash->update({
|
|
foo => 10,
|
|
bar => 20,
|
|
});
|
|
|
|
=head2 getref($variable)
|
|
|
|
This undocumented feature returns a closure which can be called to get the
|
|
value of a variable. It is used to implement variable references which are
|
|
evaluated lazily.
|
|
|
|
[% x = \foo.bar.baz %] # x is a reference to foo.bar.baz
|
|
[% x %] # evalautes foo.bar.baz
|
|
|
|
=head2 clone(\%params)
|
|
|
|
The C<clone()> method creates and returns a new C<Template::Stash> object
|
|
which represents a localised copy of the parent stash. Variables can be freely
|
|
updated in the cloned stash and when L<declone()> is called, the original stash
|
|
is returned with all its members intact and in the same state as they were
|
|
before C<clone()> was called.
|
|
|
|
For convenience, a hash of parameters may be passed into C<clone()> which
|
|
is used to update any simple variable (i.e. those that don't contain any
|
|
namespace elements like C<foo> and C<bar> but not C<foo.bar>) variables while
|
|
cloning the stash. For adding and updating complex variables, the L<set()>
|
|
method should be used after calling C<clone().> This will correctly resolve
|
|
and/or create any necessary namespace hashes.
|
|
|
|
A cloned stash maintains a reference to the stash that it was copied
|
|
from in its C<_PARENT> member.
|
|
|
|
=head2 declone()
|
|
|
|
The C<declone()> method returns the C<_PARENT> reference and can be used to
|
|
restore the state of a stash as described above.
|
|
|
|
=head2 define_vmethod($type, $name, $code)
|
|
|
|
This method can be used to define new virtual methods. The first argument
|
|
should be either C<scalar> or C<item> to define scalar virtual method, C<hash>
|
|
to define hash virtual methods, or either C<array> or C<list> for list virtual
|
|
methods. The second argument should be the name of the new method. The third
|
|
argument should be a reference to a subroutine implementing the method. The
|
|
data item on which the virtual method is called is passed to the subroutine as
|
|
the first argument.
|
|
|
|
$stash->define_vmethod(
|
|
item => ucfirst => sub {
|
|
my $text = shift;
|
|
return ucfirst $text
|
|
}
|
|
);
|
|
|
|
=head1 INTERNAL METHODS
|
|
|
|
=head2 dotop($root, $item, \@args, $lvalue)
|
|
|
|
This is the core C<dot> operation method which evaluates elements of
|
|
variables against their root.
|
|
|
|
=head2 undefined($ident, $args)
|
|
|
|
This method is called when L<get()> encounters an undefined value. If the
|
|
L<STRICT|Template::Manual::Config#STRICT> option is in effect then it will
|
|
throw an exception indicating the use of an undefined value. Otherwise it
|
|
will silently return an empty string.
|
|
|
|
The method can be redefined in a subclass to implement alternate handling
|
|
of undefined values.
|
|
|
|
=head1 AUTHOR
|
|
|
|
Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (C) 1996-2013 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.
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<Template>, L<Template::Context>
|
|
|
|
=cut
|
|
|
|
# Local Variables:
|
|
# mode: perl
|
|
# perl-indent-level: 4
|
|
# indent-tabs-mode: nil
|
|
# End:
|
|
#
|
|
# vim: expandtab shiftwidth=4:
|