local-lib5/lib/perl5/i486-linux-gnu-thread-multi/Template/Stash/Context.pm

   1 #============================================================= -*-Perl-*-
   2 #
   3 # Template::Stash::Context
   4 #
   5 # DESCRIPTION
   6 #   This is an alternate stash object which includes a patch from
   7 #   Craig Barratt to implement various new virtual methods to allow
   8 #   dotted template variable to denote if object methods and subroutines
   9 #   should be called in scalar or list context.  It adds a little overhead
  10 #   to each stash call and I'm a little wary of doing that.  So for now,
  11 #   it's implemented as a separate stash module which will allow us to
  12 #   test it out, benchmark it and switch it in or out as we require.
  13 #
  14 #   This is what Craig has to say about it:
  15 #
  16 #   Here's a better set of features for the core.  Attached is a new version
  17 #   of Stash.pm (based on TT2.02) that:
  18 #
  19 #     - supports the special op "scalar" that forces scalar context on
  20 #       function calls, eg:
  21 #
  22 #           cgi.param("foo").scalar
  23 #
  24 #       calls cgi.param("foo") in scalar context (unlike my wimpy
  25 #       scalar op from last night).  Array context is the default.
  26 #
  27 #       With non-function operands, scalar behaves like the perl
  28 #       version (eg: no-op for scalar, size for arrays, etc).
  29 #
  30 #     - supports the special op "ref" that behaves like the perl ref.
  31 #       If applied to a function the function is not called.  Eg:
  32 #
  33 #           cgi.param("foo").ref
  34 #
  35 #       does *not* call cgi.param and evaluates to "CODE".  Similarly,
  36 #       HASH.ref, ARRAY.ref return what you expect.
  37 #
  38 #     - adds a new scalar and list op called "array" that is a no-op for
  39 #       arrays and promotes scalars to one-element arrays.
  40 #
  41 #     - allows scalar ops to be applied to arrays and hashes in place,
  42 #       eg: ARRAY.repeat(3) repeats each element in place.
  43 #
  44 #     - allows list ops to be applied to scalars by promoting the scalars
  45 #       to one-element arrays (like an implicit "array").  So you can
  46 #       do things like SCALAR.size, SCALAR.join and get a useful result.
  47 #
  48 #       This also means you can now use x.0 to safely get the first element
  49 #       whether x is an array or scalar.
  50 #
  51 #   The new Stash.pm passes the TT2.02 test suite.  But I haven't tested the
  52 #   new features very much.  One nagging implementation problem is that the
  53 #   "scalar" and "ref" ops have higher precedence than user variable names.
  54 #
  55 # AUTHORS
  56 #   Andy Wardley  <abw@kfs.org>
  57 #   Craig Barratt <craig@arraycomm.com>
  58 #
  59 # COPYRIGHT
  60 #   Copyright (C) 1996-2001 Andy Wardley.  All Rights Reserved.
  61 #   Copyright (C) 1998-2001 Canon Research Centre Europe Ltd.
  62 #
  63 #   This module is free software; you can redistribute it and/or
  64 #   modify it under the same terms as Perl itself.
  65 #
  66 #============================================================================
  67
  68 package Template::Stash::Context;
  69
  70 use strict;
  71 use warnings;
  72 use base 'Template::Stash';
  73
  74 our $VERSION = 1.63;
  75 our $DEBUG   = 0 unless defined $DEBUG;
  76
  77
  78 #========================================================================
  79 #                    -- PACKAGE VARIABLES AND SUBS --
  80 #========================================================================
  81
  82 #------------------------------------------------------------------------
  83 # copy virtual methods from those in the regular Template::Stash
  84 #------------------------------------------------------------------------
  85
  86 our $ROOT_OPS = {
  87     %$Template::Stash::ROOT_OPS,
  88     defined $ROOT_OPS ? %$ROOT_OPS : (),
  89 };
  90
  91 our $SCALAR_OPS = {
  92     %$Template::Stash::SCALAR_OPS,
  93     'array' => sub { return [$_[0]] },
  94     defined $SCALAR_OPS ? %$SCALAR_OPS : (),
  95 };
  96
  97 our $LIST_OPS = {
  98     %$Template::Stash::LIST_OPS,
  99     'array' => sub { return $_[0] },
 100     defined $LIST_OPS ? %$LIST_OPS : (),
 101 };
 102
 103 our $HASH_OPS = {
 104     %$Template::Stash::HASH_OPS,
 105     defined $HASH_OPS ? %$HASH_OPS : (),
 106 };
 107
 108
 109
 110 #========================================================================
 111 #                      -----  CLASS METHODS -----
 112 #========================================================================
 113
 114 #------------------------------------------------------------------------
 115 # new(\%params)
 116 #
 117 # Constructor method which creates a new Template::Stash object.
 118 # An optional hash reference may be passed containing variable
 119 # definitions that will be used to initialise the stash.
 120 #
 121 # Returns a reference to a newly created Template::Stash.
 122 #------------------------------------------------------------------------
 123
 124 sub new {
 125     my $class  = shift;
 126     my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ };
 127
 128     my $self   = {
 129         global  => { },
 130         %$params,
 131         %$ROOT_OPS,
 132         '_PARENT' => undef,
 133         '_CLASS'  => $class,
 134     };
 135
 136     bless $self, $class;
 137 }
 138
 139
 140 #========================================================================
 141 #                   -----  PUBLIC OBJECT METHODS -----
 142 #========================================================================
 143
 144 #------------------------------------------------------------------------
 145 # clone(\%params)
 146 #
 147 # Creates a copy of the current stash object to effect localisation
 148 # of variables.  The new stash is blessed into the same class as the
 149 # parent (which may be a derived class) and has a '_PARENT' member added
 150 # which contains a reference to the parent stash that created it
 151 # ($self).  This member is used in a successive declone() method call to
 152 # return the reference to the parent.
 153 #
 154 # A parameter may be provided which should reference a hash of
 155 # variable/values which should be defined in the new stash.  The
 156 # update() method is called to define these new variables in the cloned
 157 # stash.
 158 #
 159 # Returns a reference to a cloned Template::Stash.
 160 #------------------------------------------------------------------------
 161
 162 sub clone {
 163     my ($self, $params) = @_;
 164     $params ||= { };
 165
 166     # look out for magical 'import' argument which imports another hash
 167     my $import = $params->{ import };
 168     if (defined $import && UNIVERSAL::isa($import, 'HASH')) {
 169         delete $params->{ import };
 170     }
 171     else {
 172         undef $import;
 173     }
 174
 175     my $clone = bless {
 176         %$self,                 # copy all parent members
 177         %$params,               # copy all new data
 178         '_PARENT' => $self,     # link to parent
 179     }, ref $self;
 180
 181     # perform hash import if defined
 182     &{ $HASH_OPS->{ import }}($clone, $import)
 183         if defined $import;
 184
 185     return $clone;
 186 }
 187
 188
 189 #------------------------------------------------------------------------
 190 # declone($export)
 191 #
 192 # Returns a reference to the PARENT stash.  When called in the following
 193 # manner:
 194 #    $stash = $stash->declone();
 195 # the reference count on the current stash will drop to 0 and be "freed"
 196 # and the caller will be left with a reference to the parent.  This
 197 # contains the state of the stash before it was cloned.
 198 #------------------------------------------------------------------------
 199
 200 sub declone {
 201     my $self = shift;
 202     $self->{ _PARENT } || $self;
 203 }
 204
 205
 206 #------------------------------------------------------------------------
 207 # get($ident)
 208 #
 209 # Returns the value for an variable stored in the stash.  The variable
 210 # may be specified as a simple string, e.g. 'foo', or as an array
 211 # reference representing compound variables.  In the latter case, each
 212 # pair of successive elements in the list represent a node in the
 213 # compound variable.  The first is the variable name, the second a
 214 # list reference of arguments or 0 if undefined.  So, the compound
 215 # variable [% foo.bar('foo').baz %] would be represented as the list
 216 # [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ].  Returns the value of the
 217 # identifier or an empty string if undefined.  Errors are thrown via
 218 # die().
 219 #------------------------------------------------------------------------
 220
 221 sub get {
 222     my ($self, $ident, $args) = @_;
 223     my ($root, $result);
 224     $root = $self;
 225
 226     if (ref $ident eq 'ARRAY'
 227         || ($ident =~ /\./)
 228         && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) {
 229         my $size = $#$ident;
 230
 231         # if $ident is a list reference, then we evaluate each item in the
 232         # identifier against the previous result, using the root stash
 233         # ($self) as the first implicit 'result'...
 234
 235         foreach (my $i = 0; $i <= $size; $i += 2) {
 236             if ( $i + 2 <= $size && ($ident->[$i+2] eq "scalar"
 237                                     || $ident->[$i+2] eq "ref") ) {
 238                 $result = $self->_dotop($root, @$ident[$i, $i+1], 0,
 239                                         $ident->[$i+2]);
 240                 $i += 2;
 241             } else {
 242                 $result = $self->_dotop($root, @$ident[$i, $i+1]);
 243             }
 244             last unless defined $result;
 245             $root = $result;
 246         }
 247     }
 248     else {
 249         $result = $self->_dotop($root, $ident, $args);
 250     }
 251
 252     return defined $result
 253         ? $result
 254         : $self->undefined($ident, $args);
 255 }
 256
 257
 258 #------------------------------------------------------------------------
 259 # set($ident, $value, $default)
 260 #
 261 # Updates the value for a variable in the stash.  The first parameter
 262 # should be the variable name or array, as per get().  The second
 263 # parameter should be the intended value for the variable.  The third,
 264 # optional parameter is a flag which may be set to indicate 'default'
 265 # mode.  When set true, the variable will only be updated if it is
 266 # currently undefined or has a false value.  The magical 'IMPORT'
 267 # variable identifier may be used to indicate that $value is a hash
 268 # reference whose values should be imported.  Returns the value set,
 269 # or an empty string if not set (e.g. default mode).  In the case of
 270 # IMPORT, returns the number of items imported from the hash.
 271 #------------------------------------------------------------------------
 272
 273 sub set {
 274     my ($self, $ident, $value, $default) = @_;
 275     my ($root, $result, $error);
 276
 277     $root = $self;
 278
 279     ELEMENT: {
 280         if (ref $ident eq 'ARRAY'
 281             || ($ident =~ /\./)
 282             && ($ident = [ map { s/\(.*$//; ($_, 0) }
 283                            split(/\./, $ident) ])) {
 284
 285             # a compound identifier may contain multiple elements (e.g.
 286             # foo.bar.baz) and we must first resolve all but the last,
 287             # using _dotop() with the $lvalue flag set which will create
 288             # intermediate hashes if necessary...
 289             my $size = $#$ident;
 290             foreach (my $i = 0; $i < $size - 2; $i += 2) {
 291                 $result = $self->_dotop($root, @$ident[$i, $i+1], 1);
 292                 last ELEMENT unless defined $result;
 293                 $root = $result;
 294             }
 295
 296             # then we call _assign() to assign the value to the last element
 297             $result = $self->_assign($root, @$ident[$size-1, $size],
 298                                      $value, $default);
 299         }
 300         else {
 301             $result = $self->_assign($root, $ident, 0, $value, $default);
 302         }
 303     }
 304
 305     return defined $result ? $result : '';
 306 }
 307
 308
 309 #------------------------------------------------------------------------
 310 # getref($ident)
 311 #
 312 # Returns a "reference" to a particular item.  This is represented as a
 313 # closure which will return the actual stash item when called.
 314 # WARNING: still experimental!
 315 #------------------------------------------------------------------------
 316
 317 sub getref {
 318     my ($self, $ident, $args) = @_;
 319     my ($root, $item, $result);
 320     $root = $self;
 321
 322     if (ref $ident eq 'ARRAY') {
 323         my $size = $#$ident;
 324
 325         foreach (my $i = 0; $i <= $size; $i += 2) {
 326             ($item, $args) = @$ident[$i, $i + 1];
 327             last if $i >= $size - 2;  # don't evaluate last node
 328             last unless defined
 329                 ($root = $self->_dotop($root, $item, $args));
 330         }
 331     }
 332     else {
 333         $item = $ident;
 334     }
 335
 336     if (defined $root) {
 337         return sub { my @args = (@{$args||[]}, @_);
 338                      $self->_dotop($root, $item, \@args);
 339                  }
 340     }
 341     else {
 342         return sub { '' };
 343     }
 344 }
 345
 346
 347
 348
 349 #------------------------------------------------------------------------
 350 # update(\%params)
 351 #
 352 # Update multiple variables en masse.  No magic is performed.  Simple
 353 # variable names only.
 354 #------------------------------------------------------------------------
 355
 356 sub update {
 357     my ($self, $params) = @_;
 358
 359     # look out for magical 'import' argument to import another hash
 360     my $import = $params->{ import };
 361     if (defined $import && UNIVERSAL::isa($import, 'HASH')) {
 362         @$self{ keys %$import } = values %$import;
 363         delete $params->{ import };
 364     }
 365
 366     @$self{ keys %$params } = values %$params;
 367 }
 368
 369
 370 #========================================================================
 371 #                  -----  PRIVATE OBJECT METHODS -----
 372 #========================================================================
 373
 374 #------------------------------------------------------------------------
 375 # _dotop($root, $item, \@args, $lvalue, $nextItem)
 376 #
 377 # This is the core 'dot' operation method which evaluates elements of
 378 # variables against their root.  All variables have an implicit root
 379 # which is the stash object itself (a hash).  Thus, a non-compound
 380 # variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is
 381 # '(stash.)foo.bar'.  The first parameter is a reference to the current
 382 # root, initially the stash itself.  The second parameter contains the
 383 # name of the variable element, e.g. 'foo'.  The third optional
 384 # parameter is a reference to a list of any parenthesised arguments
 385 # specified for the variable, which are passed to sub-routines, object
 386 # methods, etc.  The final parameter is an optional flag to indicate
 387 # if this variable is being evaluated on the left side of an assignment
 388 # (e.g. foo.bar.baz = 10).  When set true, intermediated hashes will
 389 # be created (e.g. bar) if necessary.
 390 #
 391 # Returns the result of evaluating the item against the root, having
 392 # performed any variable "magic".  The value returned can then be used
 393 # as the root of the next _dotop() in a compound sequence.  Returns
 394 # undef if the variable is undefined.
 395 #------------------------------------------------------------------------
 396
 397 sub _dotop {
 398     my ($self, $root, $item, $args, $lvalue, $nextItem) = @_;
 399     my $rootref = ref $root;
 400     my ($value, @result, $ret, $retVal);
 401     $nextItem ||= "";
 402     my $scalarContext = 1 if ( $nextItem eq "scalar" );
 403     my $returnRef = 1     if ( $nextItem eq "ref" );
 404
 405     $args ||= [ ];
 406     $lvalue ||= 0;
 407
 408 #    print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n"
 409 #       if $DEBUG;
 410
 411     # return undef without an error if either side of the dot is unviable
 412     # or if an attempt is made to access a private member, starting _ or .
 413     return undef
 414         unless defined($root) and defined($item) and $item !~ /^[\._]/;
 415
 416     if (ref(\$root) eq "SCALAR" && !$lvalue &&
 417             (($value = $LIST_OPS->{ $item }) || $item =~ /^-?\d+$/) ) {
 418         #
 419         # Promote scalar to one element list, to be processed below.
 420         #
 421         $rootref = 'ARRAY';
 422         $root = [$root];
 423     }
 424     if ($rootref eq $self->{_CLASS} || $rootref eq 'HASH') {
 425
 426         # if $root is a regular HASH or a Template::Stash kinda HASH (the
 427         # *real* root of everything).  We first lookup the named key
 428         # in the hash, or create an empty hash in its place if undefined
 429         # and the $lvalue flag is set.  Otherwise, we check the HASH_OPS
 430         # pseudo-methods table, calling the code if found, or return undef.
 431
 432         if (defined($value = $root->{ $item })) {
 433             ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
 434                                                      $scalarContext);
 435             return $retVal if ( $ret );                     ## RETURN
 436         }
 437         elsif ($lvalue) {
 438             # we create an intermediate hash if this is an lvalue
 439             return $root->{ $item } = { };                  ## RETURN
 440         }
 441         elsif ($value = $HASH_OPS->{ $item }) {
 442             @result = &$value($root, @$args);               ## @result
 443         }
 444         elsif (ref $item eq 'ARRAY') {
 445             # hash slice
 446             return [@$root{@$item}];                       ## RETURN
 447         }
 448         elsif ($value = $SCALAR_OPS->{ $item }) {
 449             #
 450             # Apply scalar ops to every hash element, in place.
 451             #
 452             foreach my $key ( keys %$root ) {
 453                 $root->{$key} = &$value($root->{$key}, @$args);
 454             }
 455         }
 456     }
 457     elsif ($rootref eq 'ARRAY') {
 458
 459         # if root is an ARRAY then we check for a LIST_OPS pseudo-method
 460         # (except for l-values for which it doesn't make any sense)
 461         # or return the numerical index into the array, or undef
 462
 463         if (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
 464             @result = &$value($root, @$args);               ## @result
 465         }
 466         elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
 467             #
 468             # Apply scalar ops to every array element, in place.
 469             #
 470             for ( my $i = 0 ; $i < @$root ; $i++ ) {
 471                 $root->[$i] = &$value($root->[$i], @$args); ## @result
 472             }
 473         }
 474         elsif ($item =~ /^-?\d+$/) {
 475             $value = $root->[$item];
 476             ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
 477                                                      $scalarContext);
 478             return $retVal if ( $ret );                     ## RETURN
 479         }
 480         elsif (ref $item eq 'ARRAY' ) {
 481             # array slice
 482             return [@$root[@$item]];                        ## RETURN
 483         }
 484     }
 485
 486     # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL')
 487     # doesn't appear to work with CGI, returning true for the first call
 488     # and false for all subsequent calls.
 489
 490     elsif (ref($root) && UNIVERSAL::can($root, 'can')) {
 491
 492         # if $root is a blessed reference (i.e. inherits from the
 493         # UNIVERSAL object base class) then we call the item as a method.
 494         # If that fails then we try to fallback on HASH behaviour if
 495         # possible.
 496         return ref $root->can($item) if ( $returnRef );       ## RETURN
 497         eval {
 498             @result = $scalarContext ? scalar $root->$item(@$args)
 499                                      : $root->$item(@$args);  ## @result
 500         };
 501
 502         if ($@) {
 503             # failed to call object method, so try some fallbacks
 504             if (UNIVERSAL::isa($root, 'HASH')
 505                     && defined($value = $root->{ $item })) {
 506                 ($ret, $retVal, @result) = _dotop_return($value, $args,
 507                                                     $returnRef, $scalarContext);
 508                 return $retVal if ( $ret );                     ## RETURN
 509             }
 510             elsif (UNIVERSAL::isa($root, 'ARRAY')
 511                    && ($value = $LIST_OPS->{ $item })) {
 512                 @result = &$value($root, @$args);
 513             }
 514             else {
 515                 @result = (undef, $@);
 516             }
 517         }
 518     }
 519     elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
 520
 521         # at this point, it doesn't look like we've got a reference to
 522         # anything we know about, so we try the SCALAR_OPS pseudo-methods
 523         # table (but not for l-values)
 524
 525         @result = &$value($root, @$args);                   ## @result
 526     }
 527     elsif ($self->{ _DEBUG }) {
 528         die "don't know how to access [ $root ].$item\n";   ## DIE
 529     }
 530     else {
 531         @result = ();
 532     }
 533
 534     # fold multiple return items into a list unless first item is undef
 535     if (defined $result[0]) {
 536         return ref(@result > 1 ? [ @result ] : $result[0])
 537                                             if ( $returnRef );  ## RETURN
 538         if ( $scalarContext ) {
 539             return scalar @result if ( @result > 1 );           ## RETURN
 540             return scalar(@{$result[0]}) if ( ref $result[0] eq "ARRAY" );
 541             return scalar(%{$result[0]}) if ( ref $result[0] eq "HASH" );
 542             return $result[0];                                  ## RETURN
 543         } else {
 544             return @result > 1 ? [ @result ] : $result[0];      ## RETURN
 545         }
 546     }
 547     elsif (defined $result[1]) {
 548         die $result[1];                                     ## DIE
 549     }
 550     elsif ($self->{ _DEBUG }) {
 551         die "$item is undefined\n";                         ## DIE
 552     }
 553
 554     return undef;
 555 }
 556
 557 #------------------------------------------------------------------------
 558 # ($ret, $retVal, @result) = _dotop_return($value, $args, $returnRef,
 559 #                                          $scalarContext);
 560 #
 561 # Handle the various return processing for _dotop
 562 #------------------------------------------------------------------------
 563
 564 sub _dotop_return
 565 {
 566     my($value, $args, $returnRef, $scalarContext) = @_;
 567     my(@result);
 568
 569     return (1, ref $value) if ( $returnRef );                     ## RETURN
 570     if ( $scalarContext ) {
 571         return (1, scalar(@$value)) if ref $value eq 'ARRAY';     ## RETURN
 572         return (1, scalar(%$value)) if ref $value eq 'HASH';      ## RETURN
 573         return (1, scalar($value))  unless ref $value eq 'CODE';  ## RETURN;
 574         @result = scalar &$value(@$args)                          ## @result;
 575     } else {
 576         return (1, $value) unless ref $value eq 'CODE';           ## RETURN
 577         @result = &$value(@$args);                                ## @result
 578     }
 579     return (0, undef, @result);
 580 }
 581
 582
 583 #------------------------------------------------------------------------
 584 # _assign($root, $item, \@args, $value, $default)
 585 #
 586 # Similar to _dotop() above, but assigns a value to the given variable
 587 # instead of simply returning it.  The first three parameters are the
 588 # root item, the item and arguments, as per _dotop(), followed by the
 589 # value to which the variable should be set and an optional $default
 590 # flag.  If set true, the variable will only be set if currently false
 591 # (undefined/zero)
 592 #------------------------------------------------------------------------
 593
 594 sub _assign {
 595     my ($self, $root, $item, $args, $value, $default) = @_;
 596     my $rootref = ref $root;
 597     my $result;
 598     $args ||= [ ];
 599     $default ||= 0;
 600
 601 #    print(STDERR "_assign(root=$root, item=$item, args=[@$args], \n",
 602 #                         "value=$value, default=$default)\n")
 603 #       if $DEBUG;
 604
 605     # return undef without an error if either side of the dot is unviable
 606     # or if an attempt is made to update a private member, starting _ or .
 607     return undef                                                ## RETURN
 608         unless $root and defined $item and $item !~ /^[\._]/;
 609
 610     if ($rootref eq 'HASH' || $rootref eq $self->{_CLASS}) {
 611         # if the root is a hash we set the named key
 612         return ($root->{ $item } = $value)                      ## RETURN
 613             unless $default && $root->{ $item };
 614     }
 615     elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) {
 616             # or set a list item by index number
 617             return ($root->[$item] = $value)                    ## RETURN
 618                 unless $default && $root->{ $item };
 619     }
 620     elsif (UNIVERSAL::isa($root, 'UNIVERSAL')) {
 621         # try to call the item as a method of an object
 622         return $root->$item(@$args, $value);                    ## RETURN
 623     }
 624     else {
 625         die "don't know how to assign to [$root].[$item]\n";    ## DIE
 626     }
 627
 628     return undef;
 629 }
 630
 631
 632 #------------------------------------------------------------------------
 633 # _dump()
 634 #
 635 # Debug method which returns a string representing the internal state
 636 # of the object.  The method calls itself recursively to dump sub-hashes.
 637 #------------------------------------------------------------------------
 638
 639 sub _dump {
 640     my $self   = shift;
 641     my $indent = shift || 1;
 642     my $buffer = '    ';
 643     my $pad    = $buffer x $indent;
 644     my $text   = '';
 645     local $" = ', ';
 646
 647     my ($key, $value);
 648
 649
 650     return $text . "...excessive recursion, terminating\n"
 651         if $indent > 32;
 652
 653     foreach $key (keys %$self) {
 654
 655         $value = $self->{ $key };
 656         $value = '<undef>' unless defined $value;
 657
 658         if (ref($value) eq 'ARRAY') {
 659             $value = "$value [@$value]";
 660         }
 661         $text .= sprintf("$pad%-8s => $value\n", $key);
 662         next if $key =~ /^\./;
 663         if (UNIVERSAL::isa($value, 'HASH')) {
 664             $text .= _dump($value, $indent + 1);
 665         }
 666     }
 667     $text;
 668 }
 669
 670
 671 1;
 672
 673 __END__
 674
 675 =head1 NAME
 676
 677 Template::Stash::Context - Experimetal stash allowing list/scalar context definition
 678
 679 =head1 SYNOPSIS
 680
 681     use Template;
 682     use Template::Stash::Context;
 683
 684     my $stash = Template::Stash::Context->new(\%vars);
 685     my $tt2   = Template->new({ STASH => $stash });
 686
 687 =head1 DESCRIPTION
 688
 689 This is an alternate stash object which includes a patch from
 690 Craig Barratt to implement various new virtual methods to allow
 691 dotted template variable to denote if object methods and subroutines
 692 should be called in scalar or list context.  It adds a little overhead
 693 to each stash call and I'm a little wary of applying that to the core
 694 default stash without investigating the effects first. So for now,
 695 it's implemented as a separate stash module which will allow us to
 696 test it out, benchmark it and switch it in or out as we require.
 697
 698 This is what Craig has to say about it:
 699
 700 Here's a better set of features for the core.  Attached is a new version
 701 of Stash.pm (based on TT2.02) that:
 702
 703 * supports the special op "scalar" that forces scalar context on
 704 function calls, eg:
 705
 706     cgi.param("foo").scalar
 707
 708 calls cgi.param("foo") in scalar context (unlike my wimpy
 709 scalar op from last night).  Array context is the default.
 710
 711 With non-function operands, scalar behaves like the perl
 712 version (eg: no-op for scalar, size for arrays, etc).
 713
 714 * supports the special op "ref" that behaves like the perl ref.
 715 If applied to a function the function is not called.  Eg:
 716
 717     cgi.param("foo").ref
 718
 719 does *not* call cgi.param and evaluates to "CODE".  Similarly,
 720 HASH.ref, ARRAY.ref return what you expect.
 721
 722 * adds a new scalar and list op called "array" that is a no-op for
 723 arrays and promotes scalars to one-element arrays.
 724
 725 * allows scalar ops to be applied to arrays and hashes in place,
 726 eg: ARRAY.repeat(3) repeats each element in place.
 727
 728 * allows list ops to be applied to scalars by promoting the scalars
 729 to one-element arrays (like an implicit "array").  So you can
 730 do things like SCALAR.size, SCALAR.join and get a useful result.
 731
 732 This also means you can now use x.0 to safely get the first element
 733 whether x is an array or scalar.
 734
 735 The new Stash.pm passes the TT2.02 test suite.  But I haven't tested the
 736 new features very much.  One nagging implementation problem is that the
 737 "scalar" and "ref" ops have higher precedence than user variable names.
 738
 739 =head1 AUTHOR
 740
 741 Andy Wardley E<lt>abw@wardley.orgE<gt>
 742
 743 L<http://wardley.org/|http://wardley.org/>
 744
 745
 746
 747
 748 =head1 VERSION
 749
 750 1.63, distributed as part of the
 751 Template Toolkit version 2.19, released on 27 April 2007.
 752
 753 =head1 COPYRIGHT
 754
 755   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
 756
 757
 758 This module is free software; you can redistribute it and/or
 759 modify it under the same terms as Perl itself.
 760
 761 =head1 SEE ALSO
 762
 763 L<Template::Stash|Template::Stash>
 764
 765 =cut
 766
 767 # Local Variables:
 768 # mode: perl
 769 # perl-indent-level: 4
 770 # indent-tabs-mode: nil
 771 # End:
 772 #
 773 # vim: expandtab shiftwidth=4: