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

   1 #============================================================= -*-Perl-*-
   2 #
   3 # Template::Stash
   4 #
   5 # DESCRIPTION
   6 #   Definition of an object class which stores and manages access to
   7 #   variables for the Template Toolkit.
   8 #
   9 # AUTHOR
  10 #   Andy Wardley   <abw@wardley.org>
  11 #
  12 # COPYRIGHT
  13 #   Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
  14 #
  15 #   This module is free software; you can redistribute it and/or
  16 #   modify it under the same terms as Perl itself.
  17 #
  18 #============================================================================
  19
  20 package Template::Stash;
  21
  22 use strict;
  23 use warnings;
  24 use Template::VMethods;
  25 use Template::Exception;
  26 use Scalar::Util qw( blessed reftype );
  27
  28 our $VERSION    = 2.91;
  29 our $DEBUG      = 0 unless defined $DEBUG;
  30 our $PRIVATE    = qr/^[_.]/;
  31 our $UNDEF_TYPE = 'var.undef';
  32 our $UNDEF_INFO = 'undefined variable: %s';
  33
  34 # alias _dotop() to dotop() so that we have a consistent method name
  35 # between the Perl and XS stash implementations
  36 *dotop = \&_dotop;
  37
  38
  39 #------------------------------------------------------------------------
  40 # Virtual Methods
  41 #
  42 # If any of $ROOT_OPS, $SCALAR_OPS, $HASH_OPS or $LIST_OPS are already
  43 # defined then we merge their contents with the default virtual methods
  44 # define by Template::VMethods.  Otherwise we can directly alias the
  45 # corresponding Template::VMethod package vars.
  46 #------------------------------------------------------------------------
  47
  48 our $ROOT_OPS = defined $ROOT_OPS
  49     ? { %{$Template::VMethods::ROOT_VMETHODS}, %$ROOT_OPS }
  50     : $Template::VMethods::ROOT_VMETHODS;
  51
  52 our $SCALAR_OPS = defined $SCALAR_OPS
  53     ? { %{$Template::VMethods::TEXT_VMETHODS}, %$SCALAR_OPS }
  54     : $Template::VMethods::TEXT_VMETHODS;
  55
  56 our $HASH_OPS = defined $HASH_OPS
  57     ? { %{$Template::VMethods::HASH_VMETHODS}, %$HASH_OPS }
  58     : $Template::VMethods::HASH_VMETHODS;
  59
  60 our $LIST_OPS = defined $LIST_OPS
  61     ? { %{$Template::VMethods::LIST_VMETHODS}, %$LIST_OPS }
  62     : $Template::VMethods::LIST_VMETHODS;
  63
  64
  65 #------------------------------------------------------------------------
  66 # define_vmethod($type, $name, \&sub)
  67 #
  68 # Defines a virtual method of type $type (SCALAR, HASH, or LIST), with
  69 # name $name, that invokes &sub when called.  It is expected that &sub
  70 # be able to handle the type that it will be called upon.
  71 #------------------------------------------------------------------------
  72
  73 sub define_vmethod {
  74     my ($class, $type, $name, $sub) = @_;
  75     my $op;
  76     $type = lc $type;
  77
  78     if ($type =~ /^scalar|item$/) {
  79         $op = $SCALAR_OPS;
  80     }
  81     elsif ($type eq 'hash') {
  82         $op = $HASH_OPS;
  83     }
  84     elsif ($type =~ /^list|array$/) {
  85         $op = $LIST_OPS;
  86     }
  87     else {
  88         die "invalid vmethod type: $type\n";
  89     }
  90
  91     $op->{ $name } = $sub;
  92
  93     return 1;
  94 }
  95
  96
  97 #========================================================================
  98 #                      -----  CLASS METHODS -----
  99 #========================================================================
 100
 101 #------------------------------------------------------------------------
 102 # new(\%params)
 103 #
 104 # Constructor method which creates a new Template::Stash object.
 105 # An optional hash reference may be passed containing variable
 106 # definitions that will be used to initialise the stash.
 107 #
 108 # Returns a reference to a newly created Template::Stash.
 109 #------------------------------------------------------------------------
 110
 111 sub new {
 112     my $class  = shift;
 113     my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ };
 114
 115     my $self   = {
 116         global  => { },
 117         %$params,
 118         %$ROOT_OPS,
 119         '_PARENT' => undef,
 120     };
 121
 122     bless $self, $class;
 123 }
 124
 125
 126 #========================================================================
 127 #                   -----  PUBLIC OBJECT METHODS -----
 128 #========================================================================
 129
 130 #------------------------------------------------------------------------
 131 # clone(\%params)
 132 #
 133 # Creates a copy of the current stash object to effect localisation
 134 # of variables.  The new stash is blessed into the same class as the
 135 # parent (which may be a derived class) and has a '_PARENT' member added
 136 # which contains a reference to the parent stash that created it
 137 # ($self).  This member is used in a successive declone() method call to
 138 # return the reference to the parent.
 139 #
 140 # A parameter may be provided which should reference a hash of
 141 # variable/values which should be defined in the new stash.  The
 142 # update() method is called to define these new variables in the cloned
 143 # stash.
 144 #
 145 # Returns a reference to a cloned Template::Stash.
 146 #------------------------------------------------------------------------
 147
 148 sub clone {
 149     my ($self, $params) = @_;
 150     $params ||= { };
 151
 152     # look out for magical 'import' argument which imports another hash
 153     my $import = $params->{ import };
 154     if (defined $import && ref $import eq 'HASH') {
 155         delete $params->{ import };
 156     }
 157     else {
 158         undef $import;
 159     }
 160
 161     my $clone = bless {
 162         %$self,         # copy all parent members
 163         %$params,       # copy all new data
 164         '_PARENT' => $self,     # link to parent
 165     }, ref $self;
 166
 167     # perform hash import if defined
 168     &{ $HASH_OPS->{ import } }($clone, $import)
 169         if defined $import;
 170
 171     return $clone;
 172 }
 173
 174
 175 #------------------------------------------------------------------------
 176 # declone($export)
 177 #
 178 # Returns a reference to the PARENT stash.  When called in the following
 179 # manner:
 180 #    $stash = $stash->declone();
 181 # the reference count on the current stash will drop to 0 and be "freed"
 182 # and the caller will be left with a reference to the parent.  This
 183 # contains the state of the stash before it was cloned.
 184 #------------------------------------------------------------------------
 185
 186 sub declone {
 187     my $self = shift;
 188     $self->{ _PARENT } || $self;
 189 }
 190
 191
 192 #------------------------------------------------------------------------
 193 # get($ident)
 194 #
 195 # Returns the value for an variable stored in the stash.  The variable
 196 # may be specified as a simple string, e.g. 'foo', or as an array
 197 # reference representing compound variables.  In the latter case, each
 198 # pair of successive elements in the list represent a node in the
 199 # compound variable.  The first is the variable name, the second a
 200 # list reference of arguments or 0 if undefined.  So, the compound
 201 # variable [% foo.bar('foo').baz %] would be represented as the list
 202 # [ 'foo', 0, 'bar', ['foo'], 'baz', 0 ].  Returns the value of the
 203 # identifier or an empty string if undefined.  Errors are thrown via
 204 # die().
 205 #------------------------------------------------------------------------
 206
 207 sub get {
 208     my ($self, $ident, $args) = @_;
 209     my ($root, $result);
 210     $root = $self;
 211
 212     if (ref $ident eq 'ARRAY'
 213         || ($ident =~ /\./)
 214         && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) {
 215         my $size = $#$ident;
 216
 217         # if $ident is a list reference, then we evaluate each item in the
 218         # identifier against the previous result, using the root stash
 219         # ($self) as the first implicit 'result'...
 220
 221         foreach (my $i = 0; $i <= $size; $i += 2) {
 222             $result = $self->_dotop($root, @$ident[$i, $i+1]);
 223             last unless defined $result;
 224             $root = $result;
 225         }
 226     }
 227     else {
 228         $result = $self->_dotop($root, $ident, $args);
 229     }
 230
 231     return defined $result
 232         ? $result
 233         : $self->undefined($ident, $args);
 234 }
 235
 236
 237 #------------------------------------------------------------------------
 238 # set($ident, $value, $default)
 239 #
 240 # Updates the value for a variable in the stash.  The first parameter
 241 # should be the variable name or array, as per get().  The second
 242 # parameter should be the intended value for the variable.  The third,
 243 # optional parameter is a flag which may be set to indicate 'default'
 244 # mode.  When set true, the variable will only be updated if it is
 245 # currently undefined or has a false value.  The magical 'IMPORT'
 246 # variable identifier may be used to indicate that $value is a hash
 247 # reference whose values should be imported.  Returns the value set,
 248 # or an empty string if not set (e.g. default mode).  In the case of
 249 # IMPORT, returns the number of items imported from the hash.
 250 #------------------------------------------------------------------------
 251
 252 sub set {
 253     my ($self, $ident, $value, $default) = @_;
 254     my ($root, $result, $error);
 255
 256     $root = $self;
 257
 258     ELEMENT: {
 259         if (ref $ident eq 'ARRAY'
 260             || ($ident =~ /\./)
 261             && ($ident = [ map { s/\(.*$//; ($_, 0) }
 262                            split(/\./, $ident) ])) {
 263
 264             # a compound identifier may contain multiple elements (e.g.
 265             # foo.bar.baz) and we must first resolve all but the last,
 266             # using _dotop() with the $lvalue flag set which will create
 267             # intermediate hashes if necessary...
 268             my $size = $#$ident;
 269             foreach (my $i = 0; $i < $size - 2; $i += 2) {
 270                 $result = $self->_dotop($root, @$ident[$i, $i+1], 1);
 271                 last ELEMENT unless defined $result;
 272                 $root = $result;
 273             }
 274
 275             # then we call _assign() to assign the value to the last element
 276             $result = $self->_assign($root, @$ident[$size-1, $size],
 277                                      $value, $default);
 278         }
 279         else {
 280             $result = $self->_assign($root, $ident, 0, $value, $default);
 281         }
 282     }
 283
 284     return defined $result ? $result : '';
 285 }
 286
 287
 288 #------------------------------------------------------------------------
 289 # getref($ident)
 290 #
 291 # Returns a "reference" to a particular item.  This is represented as a
 292 # closure which will return the actual stash item when called.
 293 # WARNING: still experimental!
 294 #------------------------------------------------------------------------
 295
 296 sub getref {
 297     my ($self, $ident, $args) = @_;
 298     my ($root, $item, $result);
 299     $root = $self;
 300
 301     if (ref $ident eq 'ARRAY') {
 302         my $size = $#$ident;
 303
 304         foreach (my $i = 0; $i <= $size; $i += 2) {
 305             ($item, $args) = @$ident[$i, $i + 1];
 306             last if $i >= $size - 2;  # don't evaluate last node
 307             last unless defined
 308                 ($root = $self->_dotop($root, $item, $args));
 309         }
 310     }
 311     else {
 312         $item = $ident;
 313     }
 314
 315     if (defined $root) {
 316         return sub { my @args = (@{$args||[]}, @_);
 317                      $self->_dotop($root, $item, \@args);
 318                  }
 319     }
 320     else {
 321         return sub { '' };
 322     }
 323 }
 324
 325
 326
 327
 328 #------------------------------------------------------------------------
 329 # update(\%params)
 330 #
 331 # Update multiple variables en masse.  No magic is performed.  Simple
 332 # variable names only.
 333 #------------------------------------------------------------------------
 334
 335 sub update {
 336     my ($self, $params) = @_;
 337
 338     # look out for magical 'import' argument to import another hash
 339     my $import = $params->{ import };
 340     if (defined $import && ref $import eq 'HASH') {
 341         @$self{ keys %$import } = values %$import;
 342         delete $params->{ import };
 343     }
 344
 345     @$self{ keys %$params } = values %$params;
 346 }
 347
 348
 349 #------------------------------------------------------------------------
 350 # undefined($ident, $args)
 351 #
 352 # Method called when a get() returns an undefined value.  Can be redefined
 353 # in a subclass to implement alternate handling.
 354 #------------------------------------------------------------------------
 355
 356 sub undefined {
 357     my ($self, $ident, $args) = @_;
 358
 359     if ($self->{ _STRICT }) {
 360         # Sorry, but we can't provide a sensible source file and line without
 361         # re-designing the whole architecure of TT (see TT3)
 362         die Template::Exception->new(
 363             $UNDEF_TYPE,
 364             sprintf(
 365                 $UNDEF_INFO,
 366                 $self->_reconstruct_ident($ident)
 367             )
 368         ) if $self->{ _STRICT };
 369     }
 370     else {
 371         # There was a time when I thought this was a good idea. But it's not.
 372         return '';
 373     }
 374 }
 375
 376 sub _reconstruct_ident {
 377     my ($self, $ident) = @_;
 378     my ($name, $args, @output);
 379     my @input = ref $ident eq 'ARRAY' ? @$ident : ($ident);
 380
 381     while (@input) {
 382         $name = shift @input;
 383         $args = shift @input || 0;
 384         $name .= '(' . join(', ', map { /^\d+$/ ? $_ : "'$_'" } @$args) . ')'
 385             if $args && ref $args eq 'ARRAY';
 386         push(@output, $name);
 387     }
 388
 389     return join('.', @output);
 390 }
 391
 392
 393 #========================================================================
 394 #                  -----  PRIVATE OBJECT METHODS -----
 395 #========================================================================
 396
 397 #------------------------------------------------------------------------
 398 # _dotop($root, $item, \@args, $lvalue)
 399 #
 400 # This is the core 'dot' operation method which evaluates elements of
 401 # variables against their root.  All variables have an implicit root
 402 # which is the stash object itself (a hash).  Thus, a non-compound
 403 # variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is
 404 # '(stash.)foo.bar'.  The first parameter is a reference to the current
 405 # root, initially the stash itself.  The second parameter contains the
 406 # name of the variable element, e.g. 'foo'.  The third optional
 407 # parameter is a reference to a list of any parenthesised arguments
 408 # specified for the variable, which are passed to sub-routines, object
 409 # methods, etc.  The final parameter is an optional flag to indicate
 410 # if this variable is being evaluated on the left side of an assignment
 411 # (e.g. foo.bar.baz = 10).  When set true, intermediated hashes will
 412 # be created (e.g. bar) if necessary.
 413 #
 414 # Returns the result of evaluating the item against the root, having
 415 # performed any variable "magic".  The value returned can then be used
 416 # as the root of the next _dotop() in a compound sequence.  Returns
 417 # undef if the variable is undefined.
 418 #------------------------------------------------------------------------
 419
 420 sub _dotop {
 421     my ($self, $root, $item, $args, $lvalue) = @_;
 422     my $rootref = ref $root;
 423     my $atroot  = (blessed $root && $root->isa(ref $self));
 424     my ($value, @result);
 425
 426     $args ||= [ ];
 427     $lvalue ||= 0;
 428
 429 #    print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n"
 430 #   if $DEBUG;
 431
 432     # return undef without an error if either side of the dot is unviable
 433     return undef unless defined($root) and defined($item);
 434
 435     # or if an attempt is made to access a private member, starting _ or .
 436     return undef if $PRIVATE && $item =~ /$PRIVATE/;
 437
 438     if ($atroot || $rootref eq 'HASH') {
 439         # if $root is a regular HASH or a Template::Stash kinda HASH (the
 440         # *real* root of everything).  We first lookup the named key
 441         # in the hash, or create an empty hash in its place if undefined
 442         # and the $lvalue flag is set.  Otherwise, we check the HASH_OPS
 443         # pseudo-methods table, calling the code if found, or return undef.
 444
 445         if (defined($value = $root->{ $item })) {
 446             return $value unless ref $value eq 'CODE';      ## RETURN
 447             @result = &$value(@$args);                      ## @result
 448         }
 449         elsif ($lvalue) {
 450             # we create an intermediate hash if this is an lvalue
 451             return $root->{ $item } = { };                  ## RETURN
 452         }
 453         # ugly hack: only allow import vmeth to be called on root stash
 454         elsif (($value = $HASH_OPS->{ $item })
 455                && ! $atroot || $item eq 'import') {
 456             @result = &$value($root, @$args);               ## @result
 457         }
 458         elsif ( ref $item eq 'ARRAY' ) {
 459             # hash slice
 460             return [@$root{@$item}];                        ## RETURN
 461         }
 462     }
 463     elsif ($rootref eq 'ARRAY') {
 464         # if root is an ARRAY then we check for a LIST_OPS pseudo-method
 465         # or return the numerical index into the array, or undef
 466         if ($value = $LIST_OPS->{ $item }) {
 467             @result = &$value($root, @$args);               ## @result
 468         }
 469         elsif ($item =~ /^-?\d+$/) {
 470             $value = $root->[$item];
 471             return $value unless ref $value eq 'CODE';      ## RETURN
 472             @result = &$value(@$args);                      ## @result
 473         }
 474         elsif ( ref $item eq 'ARRAY' ) {
 475             # array slice
 476             return [@$root[@$item]];                        ## RETURN
 477         }
 478     }
 479
 480     # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL')
 481     # doesn't appear to work with CGI, returning true for the first call
 482     # and false for all subsequent calls.
 483
 484     # UPDATE: that doesn't appear to be the case any more
 485
 486     elsif (blessed($root) && $root->can('can')) {
 487
 488         # if $root is a blessed reference (i.e. inherits from the
 489         # UNIVERSAL object base class) then we call the item as a method.
 490         # If that fails then we try to fallback on HASH behaviour if
 491         # possible.
 492         eval { @result = $root->$item(@$args); };
 493
 494         if ($@) {
 495             # temporary hack - required to propogate errors thrown
 496             # by views; if $@ is a ref (e.g. Template::Exception
 497             # object then we assume it's a real error that needs
 498             # real throwing
 499
 500             my $class = ref($root) || $root;
 501             die $@ if ref($@) || ($@ !~ /Can't locate object method "\Q$item\E" via package "\Q$class\E"/);
 502
 503             # failed to call object method, so try some fallbacks
 504             if (reftype $root eq 'HASH') {
 505                 if( defined($value = $root->{ $item })) {
 506                     return $value unless ref $value eq 'CODE';      ## RETURN
 507                     @result = &$value(@$args);
 508                 }
 509                 elsif ($value = $HASH_OPS->{ $item }) {
 510                     @result = &$value($root, @$args);
 511                 }
 512                 elsif ($value = $LIST_OPS->{ $item }) {
 513                     @result = &$value([$root], @$args);
 514                 }
 515             }
 516             elsif (reftype $root eq 'ARRAY') {
 517                 if( $value = $LIST_OPS->{ $item }) {
 518                    @result = &$value($root, @$args);
 519                 }
 520                 elsif( $item =~ /^-?\d+$/ ) {
 521                    $value = $root->[$item];
 522                    return $value unless ref $value eq 'CODE';      ## RETURN
 523                    @result = &$value(@$args);                      ## @result
 524                 }
 525                 elsif ( ref $item eq 'ARRAY' ) {
 526                     # array slice
 527                     return [@$root[@$item]];                        ## RETURN
 528                 }
 529             }
 530             elsif ($value = $SCALAR_OPS->{ $item }) {
 531                 @result = &$value($root, @$args);
 532             }
 533             elsif ($value = $LIST_OPS->{ $item }) {
 534                 @result = &$value([$root], @$args);
 535             }
 536             elsif ($self->{ _DEBUG }) {
 537                 @result = (undef, $@);
 538             }
 539         }
 540     }
 541     elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
 542         # at this point, it doesn't look like we've got a reference to
 543         # anything we know about, so we try the SCALAR_OPS pseudo-methods
 544         # table (but not for l-values)
 545         @result = &$value($root, @$args);           ## @result
 546     }
 547     elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
 548         # last-ditch: can we promote a scalar to a one-element
 549         # list and apply a LIST_OPS virtual method?
 550         @result = &$value([$root], @$args);
 551     }
 552     elsif ($self->{ _DEBUG }) {
 553         die "don't know how to access [ $root ].$item\n";   ## DIE
 554     }
 555     else {
 556         @result = ();
 557     }
 558
 559     # fold multiple return items into a list unless first item is undef
 560     if (defined $result[0]) {
 561         return                              ## RETURN
 562         scalar @result > 1 ? [ @result ] : $result[0];
 563     }
 564     elsif (defined $result[1]) {
 565         die $result[1];                     ## DIE
 566     }
 567     elsif ($self->{ _DEBUG }) {
 568         die "$item is undefined\n";         ## DIE
 569     }
 570
 571     return undef;
 572 }
 573
 574
 575 #------------------------------------------------------------------------
 576 # _assign($root, $item, \@args, $value, $default)
 577 #
 578 # Similar to _dotop() above, but assigns a value to the given variable
 579 # instead of simply returning it.  The first three parameters are the
 580 # root item, the item and arguments, as per _dotop(), followed by the
 581 # value to which the variable should be set and an optional $default
 582 # flag.  If set true, the variable will only be set if currently false
 583 # (undefined/zero)
 584 #------------------------------------------------------------------------
 585
 586 sub _assign {
 587     my ($self, $root, $item, $args, $value, $default) = @_;
 588     my $rootref = ref $root;
 589     my $atroot  = ($root eq $self);
 590     my $result;
 591     $args ||= [ ];
 592     $default ||= 0;
 593
 594     # return undef without an error if either side of the dot is unviable
 595     return undef unless $root and defined $item;
 596
 597     # or if an attempt is made to update a private member, starting _ or .
 598     return undef if $PRIVATE && $item =~ /$PRIVATE/;
 599
 600     if ($rootref eq 'HASH' || $atroot) {
 601         # if the root is a hash we set the named key
 602         return ($root->{ $item } = $value)          ## RETURN
 603             unless $default && $root->{ $item };
 604     }
 605     elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) {
 606         # or set a list item by index number
 607         return ($root->[$item] = $value)            ## RETURN
 608             unless $default && $root->{ $item };
 609     }
 610     elsif (blessed($root)) {
 611         # try to call the item as a method of an object
 612
 613         return $root->$item(@$args, $value)         ## RETURN
 614             unless $default && $root->$item();
 615
 616 # 2 issues:
 617 #   - method call should be wrapped in eval { }
 618 #   - fallback on hash methods if object method not found
 619 #
 620 #     eval { $result = $root->$item(@$args, $value); };
 621 #
 622 #     if ($@) {
 623 #         die $@ if ref($@) || ($@ !~ /Can't locate object method/);
 624 #
 625 #         # failed to call object method, so try some fallbacks
 626 #         if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) {
 627 #         $result = ($root->{ $item } = $value)
 628 #             unless $default && $root->{ $item };
 629 #         }
 630 #     }
 631 #     return $result;                       ## RETURN
 632     }
 633     else {
 634         die "don't know how to assign to [$root].[$item]\n";    ## DIE
 635     }
 636
 637     return undef;
 638 }
 639
 640
 641 #------------------------------------------------------------------------
 642 # _dump()
 643 #
 644 # Debug method which returns a string representing the internal state
 645 # of the object.  The method calls itself recursively to dump sub-hashes.
 646 #------------------------------------------------------------------------
 647
 648 sub _dump {
 649     my $self   = shift;
 650     return "[Template::Stash] " . $self->_dump_frame(2);
 651 }
 652
 653 sub _dump_frame {
 654     my ($self, $indent) = @_;
 655     $indent ||= 1;
 656     my $buffer = '    ';
 657     my $pad    = $buffer x $indent;
 658     my $text   = "{\n";
 659     local $" = ', ';
 660
 661     my ($key, $value);
 662
 663     return $text . "...excessive recursion, terminating\n"
 664         if $indent > 32;
 665
 666     foreach $key (keys %$self) {
 667         $value = $self->{ $key };
 668         $value = '<undef>' unless defined $value;
 669         next if $key =~ /^\./;
 670         if (ref($value) eq 'ARRAY') {
 671             $value = '[ ' . join(', ', map { defined $_ ? $_ : '<undef>' }
 672                                  @$value) . ' ]';
 673         }
 674         elsif (ref $value eq 'HASH') {
 675             $value = _dump_frame($value, $indent + 1);
 676         }
 677
 678         $text .= sprintf("$pad%-16s => $value\n", $key);
 679     }
 680     $text .= $buffer x ($indent - 1) . '}';
 681     return $text;
 682 }
 683
 684
 685 1;
 686
 687 __END__
 688
 689 =head1 NAME
 690
 691 Template::Stash - Magical storage for template variables
 692
 693 =head1 SYNOPSIS
 694
 695     use Template::Stash;
 696
 697     my $stash = Template::Stash->new(\%vars);
 698
 699     # get variable values
 700     $value = $stash->get($variable);
 701     $value = $stash->get(\@compound);
 702
 703     # set variable value
 704     $stash->set($variable, $value);
 705     $stash->set(\@compound, $value);
 706
 707     # default variable value
 708     $stash->set($variable, $value, 1);
 709     $stash->set(\@compound, $value, 1);
 710
 711     # set variable values en masse
 712     $stash->update(\%new_vars)
 713
 714     # methods for (de-)localising variables
 715     $stash = $stash->clone(\%new_vars);
 716     $stash = $stash->declone();
 717
 718 =head1 DESCRIPTION
 719
 720 The C<Template::Stash> module defines an object class which is used to store
 721 variable values for the runtime use of the template processor.  Variable
 722 values are stored internally in a hash reference (which itself is blessed
 723 to create the object) and are accessible via the L<get()> and L<set()> methods.
 724
 725 Variables may reference hash arrays, lists, subroutines and objects
 726 as well as simple values.  The stash automatically performs the right
 727 magic when dealing with variables, calling code or object methods,
 728 indexing into lists, hashes, etc.
 729
 730 The stash has L<clone()> and L<declone()> methods which are used by the
 731 template processor to make temporary copies of the stash for
 732 localising changes made to variables.
 733
 734 =head1 PUBLIC METHODS
 735
 736 =head2 new(\%params)
 737
 738 The C<new()> constructor method creates and returns a reference to a new
 739 C<Template::Stash> object.
 740
 741     my $stash = Template::Stash->new();
 742
 743 A hash reference may be passed to provide variables and values which
 744 should be used to initialise the stash.
 745
 746     my $stash = Template::Stash->new({ var1 => 'value1',
 747                                        var2 => 'value2' });
 748
 749 =head2 get($variable)
 750
 751 The C<get()> method retrieves the variable named by the first parameter.
 752
 753     $value = $stash->get('var1');
 754
 755 Dotted compound variables can be retrieved by specifying the variable
 756 elements by reference to a list.  Each node in the variable occupies
 757 two entries in the list.  The first gives the name of the variable
 758 element, the second is a reference to a list of arguments for that
 759 element, or C<0> if none.
 760
 761     [% foo.bar(10).baz(20) %]
 762
 763     $stash->get([ 'foo', 0, 'bar', [ 10 ], 'baz', [ 20 ] ]);
 764
 765 =head2 set($variable, $value, $default)
 766
 767 The C<set()> method sets the variable name in the first parameter to the
 768 value specified in the second.
 769
 770     $stash->set('var1', 'value1');
 771
 772 If the third parameter evaluates to a true value, the variable is
 773 set only if it did not have a true value before.
 774
 775     $stash->set('var2', 'default_value', 1);
 776
 777 Dotted compound variables may be specified as per L<get()> above.
 778
 779     [% foo.bar = 30 %]
 780
 781     $stash->set([ 'foo', 0, 'bar', 0 ], 30);
 782
 783 The magical variable 'C<IMPORT>' can be specified whose corresponding
 784 value should be a hash reference.  The contents of the hash array are
 785 copied (i.e. imported) into the current namespace.
 786
 787     # foo.bar = baz, foo.wiz = waz
 788     $stash->set('foo', { 'bar' => 'baz', 'wiz' => 'waz' });
 789
 790     # import 'foo' into main namespace: bar = baz, wiz = waz
 791     $stash->set('IMPORT', $stash->get('foo'));
 792
 793 =head2 clone(\%params)
 794
 795 The C<clone()> method creates and returns a new C<Template::Stash> object
 796 which represents a localised copy of the parent stash. Variables can be freely
 797 updated in the cloned stash and when L<declone()> is called, the original stash
 798 is returned with all its members intact and in the same state as they were
 799 before C<clone()> was called.
 800
 801 For convenience, a hash of parameters may be passed into C<clone()> which
 802 is used to update any simple variable (i.e. those that don't contain any
 803 namespace elements like C<foo> and C<bar> but not C<foo.bar>) variables while
 804 cloning the stash.  For adding and updating complex variables, the L<set()>
 805 method should be used after calling C<clone().>  This will correctly resolve
 806 and/or create any necessary namespace hashes.
 807
 808 A cloned stash maintains a reference to the stash that it was copied
 809 from in its C<_PARENT> member.
 810
 811 =head2 declone()
 812
 813 The C<declone()> method returns the C<_PARENT> reference and can be used to
 814 restore the state of a stash as described above.
 815
 816 =head1 AUTHOR
 817
 818 Andy Wardley E<lt>abw@wardley.orgE<gt> L<http://wardley.org/>
 819
 820 =head1 COPYRIGHT
 821
 822 Copyright (C) 1996-2007 Andy Wardley.  All Rights Reserved.
 823
 824 This module is free software; you can redistribute it and/or
 825 modify it under the same terms as Perl itself.
 826
 827 =head1 SEE ALSO
 828
 829 L<Template>, L<Template::Context>
 830
 831 =cut
 832
 833 # Local Variables:
 834 # mode: perl
 835 # perl-indent-level: 4
 836 # indent-tabs-mode: nil
 837 # End:
 838 #
 839 # vim: expandtab shiftwidth=4: