[Templates-cvs] cvs commit: TT3/lib/Template Stash.pm
cvs@template-toolkit.org
cvs@template-toolkit.org
Wed, 10 Nov 2004 18:16:08 +0000
cvs 04/11/10 18:16:08
Added: lib/Template Stash.pm
Log:
* first stab at the stash
Revision Changes Path
1.1 TT3/lib/Template/Stash.pm
Index: Stash.pm
===================================================================
#========================================================================
#
# Template::Stash
#
# DESCRIPTION
# Autonomous variable management object. Sounds quite fancy that,
# doesn't it?
#
# AUTHOR
# Andy Wardley <abw@wardley.org>
#
# COPYRIGHT
# Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
# Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
# Copyright (C) 2004 Fotango Ltd.
#
# This module is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
#
# TODO
# * at present this is a quick hack to get backwards compatability
# with TT2 templates working.
#
# REVISION
# $Id: Stash.pm,v 1.1 2004/11/10 18:16:07 abw Exp $
#
#========================================================================
package Template::Stash;
use strict;
use warnings;
use Template::Base;
use vars qw( $VERSION $DEBUG $ERROR $THROW $MAX_DEPTH );
use base qw( Template::Base );
$VERSION = sprintf("%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/);
$DEBUG = 0 unless defined $DEBUG;
$ERROR = '';
$THROW = 'stash';
$MAX_DEPTH = 64;
sub init {
my ($self, $config) = @_;
@$self{ keys %$config } = values %$config;
$self->{ variables } ||= { };
$self->{ max_depth } ||= $MAX_DEPTH;
return $self;
}
sub get {
my ($self, $name) = @_;
return $self->{ variables }->{ $name }
if exists $self->{ variables }->{ $name };
return $self->{ variables }->{ name }
= $self->{ component }->search( variables => $name );
}
sub set {
my ($self, $name, $value) = @_;
$self->{ variables }->{ $name } = $value;
}
sub dotop {
my ($self, $root, $nodes, $opts) = @_;
my ($node, $args, $last, $rootref, $method);
my $vmethods = $self->{ vmethods };
$opts ||= { };
$opts->{ last } = '';
# Here's the basic outline. We iterate over each $node in
# $nodes. Each can be a reference to something (hash, list,
# code, etc.) for special cases. In the usual case, it's a
# plain text string with the next item in $nodes providing
# the arguments or 0. In each case we evaluate $node against
# the current $root, which of course all depends on what $root
# is. We Do The Right Thing and set $root to the result. If
# $root turns out to be a code reference then we call the code
# and set $root to whatever it returns. Repeat to fade.
NODE: while (@$nodes) {
$node = shift @$nodes;
$self->debug("dotop: $root . $node\n") if $self->{ DEBUG };
# TODO: should call undefined() ?
return $self->error("undefined value in dotop nodes")
unless defined $node;
if (ref $node) {
# $node is a reference to one of: an object that can
# dotop(), a code reference which we call, a hash or list
# reference which we delegate to dotop_hash() and
# dotop_list() respectively, a scalar which we de-ref and
# shove back onto the front of $nodes for next time, or
# something else that we can't do anything about
if (UNIVERSAL::can($node, 'dotop')) {
$root = $node->dotop($root, $node, $nodes, $opts);
}
elsif (UNIVERSAL::isa($node, 'CODE')) {
$root = $node->($self, $root, $nodes, $opts);
}
elsif (UNIVERSAL::isa($node, 'HASH')) {
$root = $self->dotop_hash($root, $node, $nodes, $opts);
}
elsif (UNIVERSAL::isa($node, 'ARRAY')) {
$root = $self->dotop_list($root, $node, $nodes, $opts);
}
elsif (UNIVERSAL::isa($node, 'SCALAR')) {
unshift(@$nodes, $$node); # ready for next time
}
else {
return $self->error("invalid dotop node: $node");
}
next;
}
# If we get here then $node is plain text and the next item
# in the $nodes list should be the relevant arguments or 0.
# We also need to make checks on $root and $node to make sure
# we don't expose private variables, mess with undefined
# values, and so on.
$args = shift @$nodes;
return $self->error("access to $node denied")
if $node =~ /^[\._]/;
return $self->undefined($node, $nodes, $opts)
unless defined $root;
# TODO: look for root ops, to allow things like undef.defined
# or code.ref to work
unless ($rootref = ref $root) {
# if $root is not a reference then the only thing we can do
# is to call a text virtual method on it, or upgrade it to
# a single item list and call a list vmethod. But we can
# only do this on the right side of '='. No lvalues allowed.
if ($opts->{ lvalue }) {
# drop-through to return below
}
elsif ($method = $vmethods->{ text }->{ $node }) {
goto CALL_METHOD;
}
elsif ($method = $vmethods->{ list }->{ $node }) {
$root = [ $root ];
goto CALL_METHOD;
}
return $self->undefined($node, $nodes, $opts);
}
# Now the usual case where $root on the LHS of a dotop is a ref.
# We first look to see if $root is a plain old hash, array or
# scalar reference. Then we look to see if it is an object
# that can() do the method. Failing that we look to see if
# we can expose the object as a hash, array or scalar, in
# which case we set the $exposed flag and try the DOTOP again.
# If it fails second time around then we give up.
my $exposed = 0;
DOTOP: {
if ($rootref eq 'HASH') {
# look in the hash for the item, or auto-vivify
# it if this is an lvalue, or call a virtual method.
$self->debug("hash.$node\n") if $self->{ DEBUG };
if (exists $root->{ $node }) {
$root = $root->{ $node };
goto CALL_CODE;
}
elsif ($opts->{ lvalue }) {
$root = $root->{ $node } = $self->autovivify($nodes)
|| return $self->undefined($node, $nodes, $opts);
next NODE;
}
elsif ($method = $vmethods->{ hash }->{ $node }) {
goto CALL_METHOD;
}
return $self->undefined($node, $nodes, $opts);
}
elsif ($rootref eq 'ARRAY') {
# look in the list for any numerical items, or auto-vivify
# them for lvalues. Otherwise look for a virtual method.
$self->debug("list.$node\n") if $self->{ DEBUG };
if ($node =~ /^[-+]?\d+$/) {
if (exists $root->[$node]) {
$root = $root->[$node];
goto CALL_CODE;
}
elsif ($opts->{ lvalue }) {
$root = $root->[ $node ] = $self->autovivify($nodes)
|| return $self->undefined($node, $nodes, $opts);
next NODE;
}
}
elsif ($opts->{ lvalue }) {
# drop-through to return below
}
elsif ($method = $vmethods->{ list }->{ $node }) {
goto CALL_METHOD;
}
return $self->undefined($node, $nodes, $opts);
}
elsif ($rootref eq 'SCALAR') {
# the only thing we can do with a scalar ref is to call
# a text virtual method on it
$self->debug("text.$node\n") if $self->{ DEBUG };
if ($opts->{ lvalue }) {
# drop-through to return below
}
elsif ($method = $vmethods->{ text }->{ $node }) {
goto CALL_METHOD;
}
return $self->undefined($node, $nodes, $opts);
}
elsif ($method = UNIVERSAL::can($root, $node)
|| UNIVERSAL::san($root, 'AUTOLOAD')) {
$self->debug("object.$node\n") if $self->{ DEBUG };
goto CALL_METHOD;
}
elsif (! $exposed++) {
# see if the object can be exposed as a HASH, ARRAY or SCALAR
# reference and retry the dotop with a hard-coded $rootref
foreach (qw( HASH ARRAY SCALAR )) {
if (UNIVERSAL::isa($root, $_)) {
$rootref = $_;
redo DOTOP;
}
}
# NOTE: may drop-through here
}
return $self->undefined($node, $nodes, $opts);
} # DOTOP
CALL_CODE:
# TODO: ability to call in list/scalar context?
$root = &$root($args ? @$args : ())
if UNIVERSAL::isa($root, 'CODE');
next NODE;
CALL_METHOD:
# TODO: list/scalar context?
$root = &$method($root, $args ? @$args : ());
next NODE;
} # while
continue {
$opts->{ last } = $node;
}
return $root;
}
sub autovivify {
my ($self, $nodes) = @_;
my $next = @$nodes && $nodes->[0];
$next = $next->{ name } if ref $next eq 'HASH';
$next = '' unless defined $next;
if ($next =~ /^[-+]?\d+$/) {
$self->debug("auto-vivified list for $next\n") if $self->{ DEBUG };
return [ ];
}
else {
$self->DEBUG("auto-vivified hash for $next)\n") if $DEBUG;
return { };
}
}
sub dotop_hash {
die "dotop_hash() not yet implemented\n";
}
sub dotop_list {
die "dotop_list() not yet implemented\n";
}
sub undefined {
my ($self, $node, $nodes, $opts) = @_;
my $prefix = $opts->{ last } ? "$opts->{ last }." : '';
print STDERR "${prefix}$node is undefined\n";
return undef;
}
1;
__END__
=head1 NAME
Template::Stash - TODO
=head1 SYNOPSIS
TODO
=head1 DESCRIPTION
TODO
=head1 METHODS
TODO
=head1 AUTHOR
Andy Wardley E<lt>abw@wardley.orgE<gt>
=head1 VERSION
$Revision: 1.1 $
=head1 COPYRIGHT
Copyright (C) 1996-2004 Andy Wardley. All Rights Reserved.
Copyright (C) 1998-2002 Canon Research Centre Europe Ltd.
Copyright (C) 2004 Fotango Ltd.
This module is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.
=cut
# Local Variables:
# mode: perl
# perl-indent-level: 4
# indent-tabs-mode: nil
# End:
#
# vim: expandtab shiftwidth=4: