2005-03-06: 0.97-am1 "initial release"v0.97-am1

This is mainly the lastest vdradmin (v0.97) with different patches applied:
- vdradmin-0.97 has been taken from linvdr-0.7.
- xpix's BigPatch_0.9pre5 (ported from vdradmin-0.95 to vdradmin-0.97 (see HISTORY.bigpatch).
- included changes from vdradmin-0.95-ct-10 (see HISTORY.ct).
- included vdradmin-0.95_0.9_pre5_fb1.diff (see HISTORY.macfly).
- included vdradmin-0.96-rename.diff which also needs an applied "vdr-aio21_svdrprename.patch" patch (don't know the author right now).

My own changes:
- included missing "Was läuft heute?" template (found at www.vdr-portal.de).
- fixed some rendering problems with "New Timer" and "New Autotimer" on KDE's Konqueror.
- Beautified recordings listing (at least in my eyes ;-)
- Added "Size" selectbox to TV template.

2 files changed, 957 insertions, 0 deletions

diff --git a/lib/Template/Stash/Context.pm b/lib/Template/Stash/Context.pm
new file mode 100644
index 0000000..8f9cfdb
--- /dev/null
+++ b/lib/Template/Stash/Context.pm
@@ -0,0 +1,781 @@
+#============================================================= -*-Perl-*-
+#
+# Template::Stash::Context
+#
+# DESCRIPTION
+#   This is an alternate stash object which includes a patch from 
+#   Craig Barratt to implement various new virtual methods to allow
+#   dotted template variable to denote if object methods and subroutines
+#   should be called in scalar or list context.  It adds a little overhead
+#   to each stash call and I'm a little wary of doing that.  So for now,
+#   it's implemented as a separate stash module which will allow us to 
+#   test it out, benchmark it and switch it in or out as we require.
+#
+#   This is what Craig has to say about it:
+#   
+#   Here's a better set of features for the core.  Attached is a new version
+#   of Stash.pm (based on TT2.02) that:
+#   
+#     - supports the special op "scalar" that forces scalar context on
+#   	function calls, eg:
+#   
+#   	    cgi.param("foo").scalar
+#   
+#   	calls cgi.param("foo") in scalar context (unlike my wimpy
+#   	scalar op from last night).  Array context is the default.
+#   
+#   	With non-function operands, scalar behaves like the perl
+#   	version (eg: no-op for scalar, size for arrays, etc).
+#   
+#     - supports the special op "ref" that behaves like the perl ref.
+#   	If applied to a function the function is not called.  Eg:
+#   
+#   	    cgi.param("foo").ref
+#   
+#   	does *not* call cgi.param and evaluates to "CODE".  Similarly,
+#   	HASH.ref, ARRAY.ref return what you expect.
+#   
+#     - adds a new scalar and list op called "array" that is a no-op for
+#   	arrays and promotes scalars to one-element arrays.
+#   
+#     - allows scalar ops to be applied to arrays and hashes in place,
+#   	eg: ARRAY.repeat(3) repeats each element in place.
+#   
+#     - allows list ops to be applied to scalars by promoting the scalars
+#   	to one-element arrays (like an implicit "array").  So you can
+#   	do things like SCALAR.size, SCALAR.join and get a useful result.
+#   
+#   	This also means you can now use x.0 to safely get the first element
+#   	whether x is an array or scalar.
+#   
+#   The new Stash.pm passes the TT2.02 test suite.  But I haven't tested the
+#   new features very much.  One nagging implementation problem is that the
+#   "scalar" and "ref" ops have higher precedence than user variable names.
+#   
+# AUTHORS
+#   Andy Wardley  <abw@kfs.org>
+#   Craig Barratt <craig@arraycomm.com>
+#
+# COPYRIGHT
+#   Copyright (C) 1996-2001 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: Context.pm,v 1.53 2003/04/24 09:14:47 abw Exp $
+#
+#============================================================================
+
+package Template::Stash::Context;
+
+require 5.004;
+
+use strict;
+use Template::Stash;
+use vars qw( $VERSION $DEBUG $ROOT_OPS $SCALAR_OPS $HASH_OPS $LIST_OPS );
+
+$VERSION = sprintf("%d.%02d", q$Revision: 1.53 $ =~ /(\d+)\.(\d+)/);
+
+
+#========================================================================
+#                    -- PACKAGE VARIABLES AND SUBS --
+#========================================================================
+
+#------------------------------------------------------------------------
+# copy virtual methods from those in the regular Template::Stash
+#------------------------------------------------------------------------
+
+$ROOT_OPS = { 
+    %$Template::Stash::ROOT_OPS,
+    defined $ROOT_OPS ? %$ROOT_OPS : (),
+};
+
+$SCALAR_OPS = { 
+    %$Template::Stash::SCALAR_OPS,
+    'array' => sub { return [$_[0]] },
+    defined $SCALAR_OPS ? %$SCALAR_OPS : (),
+};
+
+$LIST_OPS = { 
+    %$Template::Stash::LIST_OPS,
+    'array' => sub { return $_[0] },
+    defined $LIST_OPS ? %$LIST_OPS : (),
+};
+		    
+$HASH_OPS = { 
+    %$Template::Stash::HASH_OPS,
+    defined $HASH_OPS ? %$HASH_OPS : (),
+};
+ 
+
+
+#========================================================================
+#                      -----  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 && UNIVERSAL::isa($import, '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'
+	|| ($ident =~ /\./) 
+	&& ($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) {
+	    if ( $i + 2 <= $size && ($ident->[$i+2] eq "scalar"
+                                    || $ident->[$i+2] eq "ref") ) {
+                $result = $self->_dotop($root, @$ident[$i, $i+1], 0,
+                                        $ident->[$i+2]);
+                $i += 2;
+	    } else {
+                $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 : '';
+}
+
+
+#------------------------------------------------------------------------
+# 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'
+	    || ($ident =~ /\./) 
+	    && ($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.  
+# WARNING: still experimental!
+#------------------------------------------------------------------------
+
+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 && UNIVERSAL::isa($import, 'HASH')) {
+	@$self{ keys %$import } = values %$import;
+	delete $params->{ import };
+    }
+
+    @$self{ keys %$params } = values %$params;
+}
+
+
+#========================================================================
+#                  -----  PRIVATE OBJECT METHODS -----
+#========================================================================
+
+#------------------------------------------------------------------------
+# _dotop($root, $item, \@args, $lvalue, $nextItem)
+#
+# 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, $nextItem) = @_;
+    my $rootref = ref $root;
+    my ($value, @result, $ret, $retVal);
+    $nextItem ||= "";
+    my $scalarContext = 1 if ( $nextItem eq "scalar" );
+    my $returnRef = 1     if ( $nextItem eq "ref" );
+
+    $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
+    # or if an attempt is made to access a private member, starting _ or .
+    return undef
+	unless defined($root) and defined($item) and $item !~ /^[\._]/;
+
+    if (ref(\$root) eq "SCALAR" && !$lvalue &&
+            (($value = $LIST_OPS->{ $item }) || $item =~ /^-?\d+$/) ) {
+        #
+        # Promote scalar to one element list, to be processed below.
+        #
+        $rootref = 'ARRAY';
+        $root = [$root];
+    }
+    if ($rootref eq __PACKAGE__ || $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 })) {
+            ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
+                                                     $scalarContext);
+            return $retVal if ( $ret );                     ## RETURN
+        }
+	elsif ($lvalue) {
+	    # we create an intermediate hash if this is an lvalue
+	    return $root->{ $item } = { };		    ## RETURN
+	}
+	elsif ($value = $HASH_OPS->{ $item }) {
+	    @result = &$value($root, @$args);		    ## @result
+	}
+	elsif (ref $item eq 'ARRAY') {
+	    # hash slice
+	    return [@$root{@$item}];                       ## RETURN
+	}
+	elsif ($value = $SCALAR_OPS->{ $item }) {
+	    #
+	    # Apply scalar ops to every hash element, in place.
+	    #
+	    foreach my $key ( keys %$root ) {
+                $root->{$key} = &$value($root->{$key}, @$args);
+            }
+	}
+    }
+    elsif ($rootref eq 'ARRAY') {
+
+	# if root is an ARRAY then we check for a LIST_OPS pseudo-method 
+	# (except for l-values for which it doesn't make any sense)
+	# or return the numerical index into the array, or undef
+
+	if (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
+	    @result = &$value($root, @$args);		    ## @result
+	}
+	elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
+	    #
+	    # Apply scalar ops to every array element, in place.
+	    #
+	    for ( my $i = 0 ; $i < @$root ; $i++ ) {
+                $root->[$i] = &$value($root->[$i], @$args); ## @result
+            }
+	}
+	elsif ($item =~ /^-?\d+$/) {
+	    $value = $root->[$item];
+            ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
+                                                     $scalarContext);
+            return $retVal if ( $ret );                     ## RETURN
+	}
+        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. 
+
+    elsif (ref($root) && UNIVERSAL::can($root, '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.
+        return ref $root->can($item) if ( $returnRef );       ## RETURN
+	eval {
+            @result = $scalarContext ? scalar $root->$item(@$args)
+                                     : $root->$item(@$args);  ## @result
+        };
+
+	if ($@) {
+	    # failed to call object method, so try some fallbacks
+	    if (UNIVERSAL::isa($root, 'HASH')
+                    && defined($value = $root->{ $item })) {
+                ($ret, $retVal, @result) = _dotop_return($value, $args,
+                                                    $returnRef, $scalarContext);
+                return $retVal if ( $ret );                     ## RETURN
+	    }
+	    elsif (UNIVERSAL::isa($root, 'ARRAY') 
+		   && ($value = $LIST_OPS->{ $item })) {
+		@result = &$value($root, @$args);
+	    }
+	    else {
+		@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 ($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 ref(@result > 1 ? [ @result ] : $result[0])
+                                            if ( $returnRef );  ## RETURN
+	if ( $scalarContext ) {
+            return scalar @result if ( @result > 1 );           ## RETURN
+            return scalar(@{$result[0]}) if ( ref $result[0] eq "ARRAY" );
+            return scalar(%{$result[0]}) if ( ref $result[0] eq "HASH" );
+            return $result[0];                                  ## RETURN
+        } else {
+            return @result > 1 ? [ @result ] : $result[0];      ## RETURN
+        }
+    }
+    elsif (defined $result[1]) {
+	die $result[1];					    ## DIE
+    }
+    elsif ($self->{ _DEBUG }) {
+	die "$item is undefined\n";			    ## DIE
+    }
+
+    return undef;
+}
+
+#------------------------------------------------------------------------
+# ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
+#                                          $scalarContext);
+#
+# Handle the various return processing for _dotop
+#------------------------------------------------------------------------
+sub _dotop_return
+{
+    my($value, $args, $returnRef, $scalarContext) = @_;
+    my(@result);
+
+    return (1, ref $value) if ( $returnRef );                     ## RETURN
+    if ( $scalarContext ) {
+        return (1, scalar(@$value)) if ref $value eq 'ARRAY';     ## RETURN
+        return (1, scalar(%$value)) if ref $value eq 'HASH';      ## RETURN
+        return (1, scalar($value))  unless ref $value eq 'CODE';  ## RETURN;
+        @result = scalar &$value(@$args)                          ## @result;
+    } else {
+        return (1, $value) unless ref $value eq 'CODE';           ## RETURN
+        @result = &$value(@$args);                                ## @result
+    }
+    return (0, undef, @result);
+}
+
+
+#------------------------------------------------------------------------
+# _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 $result;
+    $args ||= [ ];
+    $default ||= 0;
+
+#    print(STDERR "_assign(root=$root, item=$item, args=[@$args], \n",
+#                         "value=$value, default=$default)\n")
+#	if $DEBUG;
+
+    # return undef without an error if either side of the dot is unviable
+    # or if an attempt is made to update a private member, starting _ or .
+    return undef						## RETURN
+	unless $root and defined $item and $item !~ /^[\._]/;
+    
+    if ($rootref eq 'HASH' || $rootref eq __PACKAGE__) {
+#	if ($item eq 'IMPORT' && UNIVERSAL::isa($value, 'HASH')) {
+#	    # import hash entries into root hash
+#	    @$root{ keys %$value } = values %$value;
+#	    return '';						## RETURN
+#	}
+	# 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 (UNIVERSAL::isa($root, 'UNIVERSAL')) {
+	# try to call the item as a method of an object
+	return $root->$item(@$args, $value);			## 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;
+    my $indent = shift || 1;
+    my $buffer = '    ';
+    my $pad    = $buffer x $indent;
+    my $text   = '';
+    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;
+
+	if (ref($value) eq 'ARRAY') {
+	    $value = "$value [@$value]";
+	}
+	$text .= sprintf("$pad%-8s => $value\n", $key);
+	next if $key =~ /^\./;
+	if (UNIVERSAL::isa($value, 'HASH')) {
+	    $text .= _dump($value, $indent + 1);
+	}
+    }
+    $text;
+}
+
+
+1;
+
+__END__
+
+
+#------------------------------------------------------------------------
+# IMPORTANT NOTE
+#   This documentation is generated automatically from source
+#   templates.  Any changes you make here may be lost.
+# 
+#   The 'docsrc' documentation source bundle is available for download
+#   from http://www.template-toolkit.org/docs.html and contains all
+#   the source templates, XML files, scripts, etc., from which the
+#   documentation for the Template Toolkit is built.
+#------------------------------------------------------------------------
+
+=head1 NAME
+
+Template::Stash::Context - Experimetal stash allowing list/scalar context definition
+
+=head1 SYNOPSIS
+
+    use Template;
+    use Template::Stash::Context;
+
+    my $stash = Template::Stash::Context->new(\%vars);
+    my $tt2   = Template->new({ STASH => $stash });
+
+=head1 DESCRIPTION
+
+This is an alternate stash object which includes a patch from 
+Craig Barratt to implement various new virtual methods to allow
+dotted template variable to denote if object methods and subroutines
+should be called in scalar or list context.  It adds a little overhead
+to each stash call and I'm a little wary of applying that to the core
+default stash without investigating the effects first. So for now,
+it's implemented as a separate stash module which will allow us to 
+test it out, benchmark it and switch it in or out as we require.
+
+This is what Craig has to say about it:
+
+Here's a better set of features for the core.  Attached is a new version
+of Stash.pm (based on TT2.02) that:
+
+* supports the special op "scalar" that forces scalar context on
+function calls, eg:
+
+    cgi.param("foo").scalar
+
+calls cgi.param("foo") in scalar context (unlike my wimpy
+scalar op from last night).  Array context is the default.
+
+With non-function operands, scalar behaves like the perl
+version (eg: no-op for scalar, size for arrays, etc).
+
+* supports the special op "ref" that behaves like the perl ref.
+If applied to a function the function is not called.  Eg:
+
+    cgi.param("foo").ref
+
+does *not* call cgi.param and evaluates to "CODE".  Similarly,
+HASH.ref, ARRAY.ref return what you expect.
+
+* adds a new scalar and list op called "array" that is a no-op for
+arrays and promotes scalars to one-element arrays.
+
+* allows scalar ops to be applied to arrays and hashes in place,
+eg: ARRAY.repeat(3) repeats each element in place.
+
+* allows list ops to be applied to scalars by promoting the scalars
+to one-element arrays (like an implicit "array").  So you can
+do things like SCALAR.size, SCALAR.join and get a useful result.
+
+This also means you can now use x.0 to safely get the first element
+whether x is an array or scalar.
+
+The new Stash.pm passes the TT2.02 test suite.  But I haven't tested the
+new features very much.  One nagging implementation problem is that the
+"scalar" and "ref" ops have higher precedence than user variable names.
+
+=head1 AUTHOR
+
+Andy Wardley E<lt>abw@andywardley.comE<gt>
+
+L<http://www.andywardley.com/|http://www.andywardley.com/>
+
+
+
+
+=head1 VERSION
+
+1.53, distributed as part of the
+Template Toolkit version 2.10, released on 24 July 2003.
+
+=head1 COPYRIGHT
+
+  Copyright (C) 1996-2003 Andy Wardley.  All Rights Reserved.
+  Copyright (C) 1998-2002 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.
+
+=head1 SEE ALSO
+
+L<Template::Stash|Template::Stash>
diff --git a/lib/Template/Stash/XS.pm b/lib/Template/Stash/XS.pm
new file mode 100644
index 0000000..ca37c08
--- /dev/null
+++ b/lib/Template/Stash/XS.pm
@@ -0,0 +1,176 @@
+#============================================================= -*-Perl-*-
+# 
+# Template::Stash::XS
+# 
+# DESCRIPTION
+#
+#   Perl bootstrap for XS module. Inherits methods from 
+#   Template::Stash when not implemented in the XS module.
+#
+#========================================================================
+
+package Template::Stash::XS;
+
+use Template;
+use Template::Stash;
+
+BEGIN {
+  require DynaLoader;
+  @Template::Stash::XS::ISA = qw( DynaLoader Template::Stash );
+
+  eval {
+    bootstrap Template::Stash::XS $Template::VERSION;
+  };
+  if ($@) {
+    die "Couldn't load Template::Stash::XS $Template::VERSION:\n\n$@\n";
+  }
+}
+
+
+sub DESTROY {
+  # no op
+  1;
+}
+
+
+# catch missing method calls here so perl doesn't barf 
+# trying to load *.al files 
+sub AUTOLOAD {
+  my ($self, @args) = @_;
+  my @c             = caller(0);
+  my $auto	    = $AUTOLOAD;
+
+  $auto =~ s/.*:://;
+  $self =~ s/=.*//;
+
+  die "Can't locate object method \"$auto\"" .
+      " via package \"$self\" at $c[1] line $c[2]\n";
+}
+
+1;
+
+__END__
+
+
+#------------------------------------------------------------------------
+# IMPORTANT NOTE
+#   This documentation is generated automatically from source
+#   templates.  Any changes you make here may be lost.
+# 
+#   The 'docsrc' documentation source bundle is available for download
+#   from http://www.template-toolkit.org/docs.html and contains all
+#   the source templates, XML files, scripts, etc., from which the
+#   documentation for the Template Toolkit is built.
+#------------------------------------------------------------------------
+
+=head1 NAME
+
+Template::Stash::XS - Experimetal high-speed stash written in XS
+
+=head1 SYNOPSIS
+
+    use Template;
+    use Template::Stash::XS;
+
+    my $stash = Template::Stash::XS->new(\%vars);
+    my $tt2   = Template->new({ STASH => $stash });
+
+=head1 DESCRIPTION
+
+This module loads the XS version of Template::Stash::XS. It should 
+behave very much like the old one, but run about twice as fast. 
+See the synopsis above for usage information.
+
+Only a few methods (such as get and set) have been implemented in XS. 
+The others are inherited from Template::Stash.
+
+=head1 NOTE
+
+To always use the XS version of Stash, modify the Template/Config.pm 
+module near line 45:
+
+ $STASH    = 'Template::Stash::XS';
+
+If you make this change, then there is no need to explicitly create 
+an instance of Template::Stash::XS as seen in the SYNOPSIS above. Just
+use Template as normal.
+
+Alternatively, in your code add this line before creating a Template
+object:
+
+ $Template::Config::STASH = 'Template::Stash::XS';
+
+To use the original, pure-perl version restore this line in 
+Template/Config.pm:
+
+ $STASH    = 'Template::Stash';
+
+Or in your code:
+
+ $Template::Config::STASH = 'Template::Stash';
+
+You can elect to have this performed once for you at installation
+time by answering 'y' or 'n' to the question that asks if you want
+to make the XS Stash the default.
+
+=head1 BUGS
+
+Please report bugs to the Template Toolkit mailing list
+templates@template-toolkit.org
+
+As of version 2.05 of the Template Toolkit, use of the XS Stash is
+known to have 2 potentially troublesome side effects.  The first
+problem is that accesses to tied hashes (e.g. Apache::Session) may not
+work as expected.  This should be fixed in an imminent release.  If
+you are using tied hashes then it is suggested that you use the
+regular Stash by default, or write a thin wrapper around your tied
+hashes to enable the XS Stash to access items via regular method
+calls.
+
+The second potential problem is that enabling the XS Stash causes all
+the Template Toolkit modules to be installed in an architecture
+dependant library, e.g. in
+
+    /usr/lib/perl5/site_perl/5.6.0/i386-linux/Template
+
+instead of 
+
+    /usr/lib/perl5/site_perl/5.6.0/Template
+
+At the time of writing, we're not sure why this is happening but it's
+likely that this is either a bug or intentional feature in the Perl
+ExtUtils::MakeMaker module.  As far as I know, Perl always checks the
+architecture dependant directories before the architecture independant
+ones.  Therefore, a newer version of the Template Toolkit installed
+with the XS Stash enabled should be used by Perl in preference to any
+existing version using the regular stash.  However, if you install a 
+future version of the Template Toolkit with the XS Stash disabled, you
+may find that Perl continues to use the older version with XS Stash 
+enabled in preference.
+
+=head1 AUTHORS
+
+Andy Wardley E<lt>abw@tt2.orgE<gt>
+
+Doug Steinwand E<lt>dsteinwand@citysearch.comE<gt>
+
+=head1 VERSION
+
+Template Toolkit version 2.10, released on 24 July 2003.
+
+
+
+=head1 COPYRIGHT
+
+  Copyright (C) 1996-2003 Andy Wardley.  All Rights Reserved.
+  Copyright (C) 1998-2002 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.
+
+
+
+=head1 SEE ALSO
+
+L<Template::Stash|Template::Stash>
+