File Coverage

lib/Template/Stash.pm
Criterion Covered Total %
statement 154 191 80.6
branch 98 148 66.2
condition 54 87 62.0
subroutine 18 21 85.7
pod 9 9 100.0
total 333 456 73.0


line stmt bran cond sub pod time code
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
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 84     84   2198 use strict;
  84         91  
  84         2221  
23 84     84   257 use warnings;
  84         90  
  84         1612  
24 84     84   23623 use Template::VMethods;
  84         148  
  84         2208  
25 84     84   691 use Template::Exception;
  84         85  
  84         1605  
26 84     84   253 use Scalar::Util qw( blessed reftype );
  84         95  
  84         173556  
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 8     8 1 12 my ($class, $type, $name, $sub) = @_;
75 8         6 my $op;
76 8         12 $type = lc $type;
77              
78 8 100       45 if ($type =~ /^scalar|item$/) {
    100          
    50          
79 1         1 $op = $SCALAR_OPS;
80             }
81             elsif ($type eq 'hash') {
82 3         5 $op = $HASH_OPS;
83             }
84             elsif ($type =~ /^list|array$/) {
85 4         4 $op = $LIST_OPS;
86             }
87             else {
88 0         0 die "invalid vmethod type: $type\n";
89             }
90              
91 8         11 $op->{ $name } = $sub;
92              
93 8         13 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 167     167 1 399 my $class = shift;
113 167 50       468 my $params = ref $_[0] eq 'HASH' ? shift(@_) : { @_ };
114              
115 167         846 my $self = {
116             global => { },
117             %$params,
118             %$ROOT_OPS,
119             '_PARENT' => undef,
120             };
121              
122 167         1421 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 1513     1513 1 1474 my ($self, $params) = @_;
150 1513   100     2441 $params ||= { };
151              
152             # look out for magical 'import' argument which imports another hash
153 1513         1590 my $import = $params->{ import };
154 1513 100 66     2943 if (defined $import && ref $import eq 'HASH') {
155 1         2 delete $params->{ import };
156             }
157             else {
158 1512         1365 undef $import;
159             }
160              
161 1513         14459 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 1513 100       3343 &{ $HASH_OPS->{ import } }($clone, $import)
  1         6  
169             if defined $import;
170              
171 1513         2664 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 1513     1513 1 1157 my $self = shift;
188 1513 50       3581 $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 608     608 1 1487 my ($self, $ident, $args) = @_;
209 608         419 my ($root, $result);
210 608         424 $root = $self;
211              
212 608 100 100     1666 if (ref $ident eq 'ARRAY'
      66        
213             || ($ident =~ /\./)
214 14         16 && ($ident = [ map { s/\(.*$//; ($_, 0) } split(/\./, $ident) ])) {
  14         32  
215 311         278 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 311         499 foreach (my $i = 0; $i <= $size; $i += 2) {
222 685         968 $result = $self->_dotop($root, @$ident[$i, $i+1]);
223 684 100       924 last unless defined $result;
224 676         1096 $root = $result;
225             }
226             }
227             else {
228 297         470 $result = $self->_dotop($root, $ident, $args);
229             }
230              
231 605 100       1257 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 509     509 1 812 my ($self, $ident, $value, $default) = @_;
254 509         369 my ($root, $result, $error);
255              
256 509         645 $root = $self;
257              
258             ELEMENT: {
259 509 100 100     335 if (ref $ident eq 'ARRAY'
  509   66     1611  
260             || ($ident =~ /\./)
261 2         2 && ($ident = [ map { s/\(.*$//; ($_, 0) }
  2         6  
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 9         15 my $size = $#$ident;
269 9         26 foreach (my $i = 0; $i < $size - 2; $i += 2) {
270 11         25 $result = $self->_dotop($root, @$ident[$i, $i+1], 1);
271 11 50       30 last ELEMENT unless defined $result;
272 11         22 $root = $result;
273             }
274            
275             # then we call _assign() to assign the value to the last element
276 9         21 $result = $self->_assign($root, @$ident[$size-1, $size],
277             $value, $default);
278             }
279             else {
280 500         671 $result = $self->_assign($root, $ident, 0, $value, $default);
281             }
282             }
283            
284 509 100       911 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             #------------------------------------------------------------------------
294              
295             sub getref {
296 6     6 1 41 my ($self, $ident, $args) = @_;
297 6         6 my ($root, $item, $result);
298 6         7 $root = $self;
299              
300 6 100       13 if (ref $ident eq 'ARRAY') {
301 3         5 my $size = $#$ident;
302            
303 3         8 foreach (my $i = 0; $i <= $size; $i += 2) {
304 6         13 ($item, $args) = @$ident[$i, $i + 1];
305 6 100       15 last if $i >= $size - 2; # don't evaluate last node
306             last unless defined
307 3 50       7 ($root = $self->_dotop($root, $item, $args));
308             }
309             }
310             else {
311 3         5 $item = $ident;
312             }
313            
314 6 50       13 if (defined $root) {
315 11 100   11   73 return sub { my @args = (@{$args||[]}, @_);
  11         57  
316 11         35 $self->_dotop($root, $item, \@args);
317             }
318 6         74 }
319             else {
320 0     0   0 return sub { '' };
  0         0  
321             }
322             }
323              
324              
325              
326              
327             #------------------------------------------------------------------------
328             # update(\%params)
329             #
330             # Update multiple variables en masse. No magic is performed. Simple
331             # variable names only.
332             #------------------------------------------------------------------------
333              
334             sub update {
335 1320     1320 1 1216 my ($self, $params) = @_;
336              
337             # look out for magical 'import' argument to import another hash
338 1320         1466 my $import = $params->{ import };
339 1320 100 66     2572 if (defined $import && ref $import eq 'HASH') {
340 1         4 @$self{ keys %$import } = values %$import;
341 1         2 delete $params->{ import };
342             }
343              
344 1320         3522 @$self{ keys %$params } = values %$params;
345             }
346              
347              
348             #------------------------------------------------------------------------
349             # undefined($ident, $args)
350             #
351             # Method called when a get() returns an undefined value. Can be redefined
352             # in a subclass to implement alternate handling.
353             #------------------------------------------------------------------------
354              
355             sub undefined {
356 1456     1456 1 3429 my ($self, $ident, $args) = @_;
357              
358 1456 100       2062 if ($self->{ _STRICT }) {
359             # Sorry, but we can't provide a sensible source file and line without
360             # re-designing the whole architecture of TT (see TT3)
361             die Template::Exception->new(
362             $UNDEF_TYPE,
363             sprintf(
364             $UNDEF_INFO,
365             $self->_reconstruct_ident($ident)
366             )
367 11 50       30 ) if $self->{ _STRICT };
368             }
369             else {
370             # There was a time when I thought this was a good idea. But it's not.
371 1445         3370 return '';
372             }
373             }
374              
375             sub _reconstruct_ident {
376 11     11   9 my ($self, $ident) = @_;
377 11         8 my ($name, $args, @output);
378 11 100       26 my @input = ref $ident eq 'ARRAY' ? @$ident : ($ident);
379              
380 11         19 while (@input) {
381 15         14 $name = shift @input;
382 15   100     38 $args = shift @input || 0;
383 15 100 66     29 $name .= '(' . join(', ', map { /^\d+$/ ? $_ : "'$_'" } @$args) . ')'
  4 100       17  
384             if $args && ref $args eq 'ARRAY';
385 15         25 push(@output, $name);
386             }
387            
388 11         63 return join('.', @output);
389             }
390              
391              
392             #========================================================================
393             # ----- PRIVATE OBJECT METHODS -----
394             #========================================================================
395              
396             #------------------------------------------------------------------------
397             # _dotop($root, $item, \@args, $lvalue)
398             #
399             # This is the core 'dot' operation method which evaluates elements of
400             # variables against their root. All variables have an implicit root
401             # which is the stash object itself (a hash). Thus, a non-compound
402             # variable 'foo' is actually '(stash.)foo', the compound 'foo.bar' is
403             # '(stash.)foo.bar'. The first parameter is a reference to the current
404             # root, initially the stash itself. The second parameter contains the
405             # name of the variable element, e.g. 'foo'. The third optional
406             # parameter is a reference to a list of any parenthesised arguments
407             # specified for the variable, which are passed to sub-routines, object
408             # methods, etc. The final parameter is an optional flag to indicate
409             # if this variable is being evaluated on the left side of an assignment
410             # (e.g. foo.bar.baz = 10). When set true, intermediated hashes will
411             # be created (e.g. bar) if necessary.
412             #
413             # Returns the result of evaluating the item against the root, having
414             # performed any variable "magic". The value returned can then be used
415             # as the root of the next _dotop() in a compound sequence. Returns
416             # undef if the variable is undefined.
417             #------------------------------------------------------------------------
418              
419             sub _dotop {
420 1019     1019   957 my ($self, $root, $item, $args, $lvalue) = @_;
421 1019         930 my $rootref = ref $root;
422 1019   100     3439 my $atroot = (blessed $root && $root->isa(ref $self));
423 1019         763 my ($value, @result);
424              
425 1019   100     2122 $args ||= [ ];
426 1019   100     2054 $lvalue ||= 0;
427              
428             # print STDERR "_dotop(root=$root, item=$item, args=[@$args])\n"
429             # if $DEBUG;
430              
431             # return undef without an error if either side of the dot is unviable
432 1019 50 33     2824 return undef unless defined($root) and defined($item);
433              
434             # or if an attempt is made to access a private member, starting _ or .
435 1019 50 33     4337 return undef if $PRIVATE && $item =~ /$PRIVATE/;
436              
437 1019 100 100     2671 if ($atroot || $rootref eq 'HASH') {
    100 66        
    100 66        
    100 33        
    50          
    0          
438             # if $root is a regular HASH or a Template::Stash kinda HASH (the
439             # *real* root of everything). We first lookup the named key
440             # in the hash, or create an empty hash in its place if undefined
441             # and the $lvalue flag is set. Otherwise, we check the HASH_OPS
442             # pseudo-methods table, calling the code if found, or return undef.
443            
444 740 100 100     2083 if (defined($value = $root->{ $item })) {
    100 100        
    100          
    100          
445 491 100       1194 return $value unless ref $value eq 'CODE'; ## RETURN
446 17         40 @result = &$value(@$args); ## @result
447             }
448             elsif ($lvalue) {
449             # we create an intermediate hash if this is an lvalue
450 1         9 return $root->{ $item } = { }; ## RETURN
451             }
452             # ugly hack: only allow import vmeth to be called on root stash
453             elsif (($value = $HASH_OPS->{ $item })
454             && ! $atroot || $item eq 'import') {
455 40         84 @result = &$value($root, @$args); ## @result
456             }
457             elsif ( ref $item eq 'ARRAY' ) {
458             # hash slice
459 2         5 return [@$root{@$item}]; ## RETURN
460             }
461             }
462             elsif ($rootref eq 'ARRAY') {
463             # if root is an ARRAY then we check for a LIST_OPS pseudo-method
464             # or return the numerical index into the array, or undef
465 149 100       301 if ($value = $LIST_OPS->{ $item }) {
    100          
    50          
466 140         307 @result = &$value($root, @$args); ## @result
467             }
468             elsif ($item =~ /^-?\d+$/) {
469 8         13 $value = $root->[$item];
470 8 50       37 return $value unless ref $value eq 'CODE'; ## RETURN
471 0         0 @result = &$value(@$args); ## @result
472             }
473             elsif ( ref $item eq 'ARRAY' ) {
474             # array slice
475 1         4 return [@$root[@$item]]; ## RETURN
476             }
477             }
478            
479             # NOTE: we do the can-can because UNIVSERAL::isa($something, 'UNIVERSAL')
480             # doesn't appear to work with CGI, returning true for the first call
481             # and false for all subsequent calls.
482            
483             # UPDATE: that doesn't appear to be the case any more
484            
485             elsif (blessed($root) && $root->can('can')) {
486              
487             # if $root is a blessed reference (i.e. inherits from the
488             # UNIVERSAL object base class) then we call the item as a method.
489             # If that fails then we try to fallback on HASH behaviour if
490             # possible.
491 37         33 eval { @result = $root->$item(@$args); };
  37         157  
492            
493 37 100       133 if ($@) {
494             # temporary hack - required to propagate errors thrown
495             # by views; if $@ is a ref (e.g. Template::Exception
496             # object then we assume it's a real error that needs
497             # real throwing
498              
499 12   33     20 my $class = ref($root) || $root;
500 12 100 66     183 die $@ if ref($@) || ($@ !~ /Can't locate object method "\Q$item\E" via package "\Q$class\E"/);
501              
502             # failed to call object method, so try some fallbacks
503 11 100       33 if (reftype $root eq 'HASH') {
    50          
    0          
    0          
    0          
504 6 100       17 if( defined($value = $root->{ $item })) {
    100          
    50          
505 3 50       13 return $value unless ref $value eq 'CODE'; ## RETURN
506 0         0 @result = &$value(@$args);
507             }
508             elsif ($value = $HASH_OPS->{ $item }) {
509 2         7 @result = &$value($root, @$args);
510             }
511             elsif ($value = $LIST_OPS->{ $item }) {
512 1         3 @result = &$value([$root], @$args);
513             }
514             }
515             elsif (reftype $root eq 'ARRAY') {
516 5 100       16 if( $value = $LIST_OPS->{ $item }) {
    50          
    0          
517 3         9 @result = &$value($root, @$args);
518             }
519             elsif( $item =~ /^-?\d+$/ ) {
520 2         3 $value = $root->[$item];
521 2 50       8 return $value unless ref $value eq 'CODE'; ## RETURN
522 0         0 @result = &$value(@$args); ## @result
523             }
524             elsif ( ref $item eq 'ARRAY' ) {
525             # array slice
526 0         0 return [@$root[@$item]]; ## RETURN
527             }
528             }
529             elsif ($value = $SCALAR_OPS->{ $item }) {
530 0         0 @result = &$value($root, @$args);
531             }
532             elsif ($value = $LIST_OPS->{ $item }) {
533 0         0 @result = &$value([$root], @$args);
534             }
535             elsif ($self->{ _DEBUG }) {
536 0         0 @result = (undef, $@);
537             }
538             }
539             }
540             elsif (($value = $SCALAR_OPS->{ $item }) && ! $lvalue) {
541             # at this point, it doesn't look like we've got a reference to
542             # anything we know about, so we try the SCALAR_OPS pseudo-methods
543             # table (but not for l-values)
544 92         189 @result = &$value($root, @$args); ## @result
545             }
546             elsif (($value = $LIST_OPS->{ $item }) && ! $lvalue) {
547             # last-ditch: can we promote a scalar to a one-element
548             # list and apply a LIST_OPS virtual method?
549 1         4 @result = &$value([$root], @$args);
550             }
551             elsif ($self->{ _DEBUG }) {
552 0         0 die "don't know how to access [ $root ].$item\n"; ## DIE
553             }
554             else {
555 0         0 @result = ();
556             }
557              
558             # fold multiple return items into a list unless first item is undef
559 527 100       1320 if (defined $result[0]) {
    50          
    100          
560             return ## RETURN
561 317 50       735 scalar @result > 1 ? [ @result ] : $result[0];
562             }
563             elsif (defined $result[1]) {
564 0         0 die $result[1]; ## DIE
565             }
566             elsif ($self->{ _DEBUG }) {
567 2         12 die "$item is undefined\n"; ## DIE
568             }
569              
570 208         327 return undef;
571             }
572              
573              
574             #------------------------------------------------------------------------
575             # _assign($root, $item, \@args, $value, $default)
576             #
577             # Similar to _dotop() above, but assigns a value to the given variable
578             # instead of simply returning it. The first three parameters are the
579             # root item, the item and arguments, as per _dotop(), followed by the
580             # value to which the variable should be set and an optional $default
581             # flag. If set true, the variable will only be set if currently false
582             # (undefined/zero)
583             #------------------------------------------------------------------------
584              
585             sub _assign {
586 509     509   512 my ($self, $root, $item, $args, $value, $default) = @_;
587 509         516 my $rootref = ref $root;
588 509         711 my $atroot = ($root eq $self);
589 509         321 my $result;
590 509   50     1278 $args ||= [ ];
591 509   50     1116 $default ||= 0;
592              
593             # return undef without an error if either side of the dot is unviable
594 509 50 33     1368 return undef unless $root and defined $item;
595              
596             # or if an attempt is made to update a private member, starting _ or .
597 509 50 33     2182 return undef if $PRIVATE && $item =~ /$PRIVATE/;
598            
599 509 100 100     1309 if ($rootref eq 'HASH' || $atroot) {
    50 33        
    0          
600             # if the root is a hash we set the named key
601             return ($root->{ $item } = $value) ## RETURN
602 508 50 33     1750 unless $default && $root->{ $item };
603             }
604             elsif ($rootref eq 'ARRAY' && $item =~ /^-?\d+$/) {
605             # or set a list item by index number
606             return ($root->[$item] = $value) ## RETURN
607 1 50 33     7 unless $default && $root->{ $item };
608             }
609             elsif (blessed($root)) {
610             # try to call the item as a method of an object
611            
612 0 0 0       return $root->$item(@$args, $value) ## RETURN
613             unless $default && $root->$item();
614            
615             # 2 issues:
616             # - method call should be wrapped in eval { }
617             # - fallback on hash methods if object method not found
618             #
619             # eval { $result = $root->$item(@$args, $value); };
620             #
621             # if ($@) {
622             # die $@ if ref($@) || ($@ !~ /Can't locate object method/);
623             #
624             # # failed to call object method, so try some fallbacks
625             # if (UNIVERSAL::isa($root, 'HASH') && exists $root->{ $item }) {
626             # $result = ($root->{ $item } = $value)
627             # unless $default && $root->{ $item };
628             # }
629             # }
630             # return $result; ## RETURN
631             }
632             else {
633 0           die "don't know how to assign to [$root].[$item]\n"; ## DIE
634             }
635              
636 0           return undef;
637             }
638              
639              
640             #------------------------------------------------------------------------
641             # _dump()
642             #
643             # Debug method which returns a string representing the internal state
644             # of the object. The method calls itself recursively to dump sub-hashes.
645             #------------------------------------------------------------------------
646              
647             sub _dump {
648 0     0     my $self = shift;
649 0           return "[Template::Stash] " . $self->_dump_frame(2);
650             }
651              
652             sub _dump_frame {
653 0     0     my ($self, $indent) = @_;
654 0   0       $indent ||= 1;
655 0           my $buffer = ' ';
656 0           my $pad = $buffer x $indent;
657 0           my $text = "{\n";
658 0           local $" = ', ';
659              
660 0           my ($key, $value);
661              
662 0 0         return $text . "...excessive recursion, terminating\n"
663             if $indent > 32;
664            
665 0           foreach $key (keys %$self) {
666 0           $value = $self->{ $key };
667 0 0         $value = '' unless defined $value;
668 0 0         next if $key =~ /^\./;
669 0 0         if (ref($value) eq 'ARRAY') {
    0          
670 0 0         $value = '[ ' . join(', ', map { defined $_ ? $_ : '' }
  0            
671             @$value) . ' ]';
672             }
673             elsif (ref $value eq 'HASH') {
674 0           $value = _dump_frame($value, $indent + 1);
675             }
676            
677 0           $text .= sprintf("$pad%-16s => $value\n", $key);
678             }
679 0           $text .= $buffer x ($indent - 1) . '}';
680 0           return $text;
681             }
682              
683              
684             1;
685              
686             __END__