File Coverage

lib/Template/Context.pm
Criterion Covered Total %
statement 263 295 89.1
branch 131 182 71.9
condition 59 89 66.2
subroutine 34 36 94.4
pod 21 21 100.0
total 508 623 81.5


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::Context
4             #
5             # DESCRIPTION
6             # Module defining a context in which a template document is processed.
7             # This is the runtime processing interface through which templates
8             # can access the functionality of the Template Toolkit.
9             #
10             # AUTHOR
11             # Andy Wardley
12             #
13             # COPYRIGHT
14             # Copyright (C) 1996-2007 Andy Wardley. All Rights Reserved.
15             #
16             # This module is free software; you can redistribute it and/or
17             # modify it under the same terms as Perl itself.
18             #
19             #============================================================================
20              
21             package Template::Context;
22              
23 80     80   1654 use strict;
  80         159  
  80         11917  
24 80     80   880 use warnings;
  80         449  
  80         6903  
25 80     80   575 use base 'Template::Base';
  80         164  
  80         10193  
26              
27 80     80   1632 use Template::Base;
  80         151  
  80         2251  
28 80     80   416 use Template::Config;
  80         157  
  80         2202  
29 80     80   459 use Template::Constants;
  80         154  
  80         4485  
30 80     80   704 use Template::Exception;
  80         153  
  80         2603  
31 80     80   443 use Scalar::Util 'blessed';
  80         162  
  80         4864  
32              
33 80     80   495 use constant DOCUMENT => 'Template::Document';
  80         154  
  80         5417  
34 80     80   411 use constant EXCEPTION => 'Template::Exception';
  80         168  
  80         3772  
35 80     80   561 use constant BADGER_EXCEPTION => 'Badger::Exception';
  80         377  
  80         446540  
36              
37             our $VERSION = 2.98;
38             our $DEBUG = 0 unless defined $DEBUG;
39             our $DEBUG_FORMAT = "\n## \$file line \$line : [% \$text %] ##\n";
40             our $VIEW_CLASS = 'Template::View';
41             our $AUTOLOAD;
42              
43             #========================================================================
44             # ----- PUBLIC METHODS -----
45             #========================================================================
46              
47             #------------------------------------------------------------------------
48             # template($name)
49             #
50             # General purpose method to fetch a template and return it in compiled
51             # form. In the usual case, the $name parameter will be a simple string
52             # containing the name of a template (e.g. 'header'). It may also be
53             # a reference to Template::Document object (or sub-class) or a Perl
54             # sub-routine. These are considered to be compiled templates and are
55             # returned intact. Finally, it may be a reference to any other kind
56             # of valid input source accepted by Template::Provider (e.g. scalar
57             # ref, glob, IO handle, etc).
58             #
59             # Templates may be cached at one of 3 different levels. The internal
60             # BLOCKS member is a local cache which holds references to all
61             # template blocks used or imported via PROCESS since the context's
62             # reset() method was last called. This is checked first and if the
63             # template is not found, the method then walks down the BLOCKSTACK
64             # list. This contains references to the block definition tables in
65             # any enclosing Template::Documents that we're visiting (e.g. we've
66             # been called via an INCLUDE and we want to access a BLOCK defined in
67             # the template that INCLUDE'd us). If nothing is defined, then we
68             # iterate through the LOAD_TEMPLATES providers list as a 'chain of
69             # responsibility' (see Design Patterns) asking each object to fetch()
70             # the template if it can.
71             #
72             # Returns the compiled template. On error, undef is returned and
73             # the internal ERROR value (read via error()) is set to contain an
74             # error message of the form "$name: $error".
75             #------------------------------------------------------------------------
76              
77             sub template {
78 2904     2904 1 10998 my ($self, $name) = @_;
79 2904         4124 my ($prefix, $blocks, $defblocks, $provider, $template, $error);
80 0         0 my ($shortname, $blockname, $providers);
81              
82 2904 50       8067 $self->debug("template($name)") if $self->{ DEBUG };
83              
84             # references to Template::Document (or sub-class) objects, or
85             # CODE references are assumed to be pre-compiled templates and are
86             # returned intact
87 2904 100 66     33253 return $name
      100        
88             if (blessed($name) && $name->isa(DOCUMENT))
89             || ref($name) eq 'CODE';
90              
91 1612         2305 $shortname = $name;
92              
93 1612 100       4197 unless (ref $name) {
94            
95 423 50       1096 $self->debug("looking for block [$name]") if $self->{ DEBUG };
96              
97             # we first look in the BLOCKS hash for a BLOCK that may have
98             # been imported from a template (via PROCESS)
99             return $template
100 423 100       1812 if ($template = $self->{ BLOCKS }->{ $name });
101            
102             # then we iterate through the BLKSTACK list to see if any of the
103             # Template::Documents we're visiting define this BLOCK
104 236         366 foreach $blocks (@{ $self->{ BLKSTACK } }) {
  236         586  
105 141 100 66     2364 return $template
106             if $blocks && ($template = $blocks->{ $name });
107             }
108            
109             # now it's time to ask the providers, so we look to see if any
110             # prefix is specified to indicate the desired provider set.
111 217 50       861 if ($^O eq 'MSWin32') {
112             # let C:/foo through
113 0 0       0 $prefix = $1 if $shortname =~ s/^(\w{2,})://o;
114             }
115             else {
116 217 100       915 $prefix = $1 if $shortname =~ s/^(\w+)://;
117             }
118            
119 217 100       553 if (defined $prefix) {
120 3   50     14 $providers = $self->{ PREFIX_MAP }->{ $prefix }
121             || return $self->throw( Template::Constants::ERROR_FILE,
122             "no providers for template prefix '$prefix'");
123             }
124             }
125             $providers = $self->{ PREFIX_MAP }->{ default }
126             || $self->{ LOAD_TEMPLATES }
127 1406 100 33     9432 unless $providers;
128              
129              
130             # Finally we try the regular template providers which will
131             # handle references to files, text, etc., as well as templates
132             # reference by name. If
133              
134 1406         2179 $blockname = '';
135 1406         3961 while ($shortname) {
136             $self->debug("asking providers for [$shortname] [$blockname]")
137 1410 50       4004 if $self->{ DEBUG };
138              
139 1410         2907 foreach my $provider (@$providers) {
140 1410         6369 ($template, $error) = $provider->fetch($shortname, $prefix);
141 1410 100       7577 if ($error) {
    100          
142 45 100       186 if ($error == Template::Constants::STATUS_ERROR) {
143             # $template contains exception object
144 6 50 66     86 if (blessed($template) && $template->isa(EXCEPTION)
      66        
145             && $template->type eq Template::Constants::ERROR_FILE) {
146 0         0 $self->throw($template);
147             }
148             else {
149 6         32 $self->throw( Template::Constants::ERROR_FILE, $template );
150             }
151             }
152             # DECLINE is ok, carry on
153             }
154             elsif (length $blockname) {
155 4 100       19 return $template
156             if $template = $template->blocks->{ $blockname };
157             }
158             else {
159 1361         21485 return $template;
160             }
161             }
162            
163 40 100 66     303 last if ref $shortname || ! $self->{ EXPOSE_BLOCKS };
164 5 100       47 $shortname =~ s{/([^/]+)$}{} || last;
165 4 50       19 $blockname = length $blockname ? "$1/$blockname" : $1;
166             }
167            
168 36         188 $self->throw(Template::Constants::ERROR_FILE, "$name: not found");
169             }
170              
171              
172             #------------------------------------------------------------------------
173             # plugin($name, \@args)
174             #
175             # Calls on each of the LOAD_PLUGINS providers in turn to fetch() (i.e. load
176             # and instantiate) a plugin of the specified name. Additional parameters
177             # passed are propagated to the new() constructor for the plugin.
178             # Returns a reference to a new plugin object or other reference. On
179             # error, undef is returned and the appropriate error message is set for
180             # subsequent retrieval via error().
181             #------------------------------------------------------------------------
182              
183             sub plugin {
184 209     209 1 2029 my ($self, $name, $args) = @_;
185 209         332 my ($provider, $plugin, $error);
186            
187             $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')')
188 209 0       721 if $self->{ DEBUG };
    50          
189            
190             # request the named plugin from each of the LOAD_PLUGINS providers in turn
191 209         353 foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) {
  209         753  
192 209         1351 ($plugin, $error) = $provider->fetch($name, $args, $self);
193 209 100       4142 return $plugin unless $error;
194 6 100       25 if ($error == Template::Constants::STATUS_ERROR) {
195 3 50       20 $self->throw($plugin) if ref $plugin;
196 0         0 $self->throw(Template::Constants::ERROR_PLUGIN, $plugin);
197             }
198             }
199            
200 3         19 $self->throw(Template::Constants::ERROR_PLUGIN, "$name: plugin not found");
201             }
202              
203              
204             #------------------------------------------------------------------------
205             # filter($name, \@args, $alias)
206             #
207             # Similar to plugin() above, but querying the LOAD_FILTERS providers to
208             # return filter instances. An alias may be provided which is used to
209             # save the returned filter in a local cache.
210             #------------------------------------------------------------------------
211              
212             sub filter {
213 161     161 1 3430 my ($self, $name, $args, $alias) = @_;
214 161         217 my ($provider, $filter, $error);
215            
216             $self->debug("filter($name, ",
217             defined $args ? @$args : '[ ]',
218             defined $alias ? $alias : '', ')')
219 161 0       590 if $self->{ DEBUG };
    0          
    50          
220            
221             # use any cached version of the filter if no params provided
222             return $filter
223             if ! $args && ! ref $name
224 161 100 100     1135 && ($filter = $self->{ FILTER_CACHE }->{ $name });
      100        
225            
226             # request the named filter from each of the FILTERS providers in turn
227 150         489 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  150         690  
228 150         790 ($filter, $error) = $provider->fetch($name, $args, $self);
229 150 100       595 last unless $error;
230 9 50       26 if ($error == Template::Constants::STATUS_ERROR) {
231 9 100       38 $self->throw($filter) if ref $filter;
232 5         20 $self->throw(Template::Constants::ERROR_FILTER, $filter);
233             }
234             # return $self->error($filter)
235             # if $error == &Template::Constants::STATUS_ERROR;
236             }
237            
238 141 50       345 return $self->error("$name: filter not found")
239             unless $filter;
240            
241             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
242             # commented out by abw on 19 Nov 2001 to fix problem with xmlstyle
243             # plugin which may re-define a filter by calling define_filter()
244             # multiple times. With the automatic aliasing/caching below, any
245             # new filter definition isn't seen. Don't think this will cause
246             # any problems as filters explicitly supplied with aliases will
247             # still work as expected.
248             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
249             # alias defaults to name if undefined
250             # $alias = $name
251             # unless defined($alias) or ref($name) or $args;
252              
253             # cache FILTER if alias is valid
254 141 100       308 $self->{ FILTER_CACHE }->{ $alias } = $filter
255             if $alias;
256              
257 141         1307 return $filter;
258             }
259              
260              
261             #------------------------------------------------------------------------
262             # view(\%config)
263             #
264             # Create a new Template::View bound to this context.
265             #------------------------------------------------------------------------
266              
267             sub view {
268 34     34 1 1735 my $self = shift;
269 34         910 require Template::View;
270 34   66     395 return $VIEW_CLASS->new($self, @_)
271             || $self->throw(&Template::Constants::ERROR_VIEW,
272             $VIEW_CLASS->error);
273             }
274              
275              
276             #------------------------------------------------------------------------
277             # process($template, \%params) [% PROCESS template var=val ... %]
278             # process($template, \%params, $local) [% INCLUDE template var=val ... %]
279             #
280             # Processes the template named or referenced by the first parameter.
281             # The optional second parameter may reference a hash array of variable
282             # definitions. These are set before the template is processed by
283             # calling update() on the stash. Note that, unless the third parameter
284             # is true, the context is not localised and these, and any other
285             # variables set in the template will retain their new values after this
286             # method returns. The third parameter is in place so that this method
287             # can handle INCLUDE calls: the stash will be localized.
288             #
289             # Returns the output of processing the template. Errors are thrown
290             # as Template::Exception objects via die().
291             #------------------------------------------------------------------------
292              
293             sub process {
294 1578     1578 1 3547 my ($self, $template, $params, $localize) = @_;
295 1578         4662 my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) };
296 1578         2325 my (@compiled, $name, $compiled);
297 0         0 my ($stash, $component, $tblocks, $error, $tmpout);
298 1578         2442 my $output = '';
299            
300 1578 100       6679 $template = [ $template ] unless ref $template eq 'ARRAY';
301            
302             $self->debug("process([ ", join(', '), @$template, ' ], ',
303             defined $params ? $params : '', ', ',
304             $localize ? '' : '', ')')
305 1578 0       5166 if $self->{ DEBUG };
    0          
    50          
306            
307             # fetch compiled template for each name specified
308 1578         3053 foreach $name (@$template) {
309 1580         4399 push(@compiled, $self->template($name));
310             }
311              
312 1558 100       4465 if ($localize) {
313             # localise the variable stash with any parameters passed
314 261         2616 $stash = $self->{ STASH } = $self->{ STASH }->clone($params);
315             } else {
316             # update stash with any new parameters passed
317 1297         6671 $self->{ STASH }->update($params);
318 1297         2820 $stash = $self->{ STASH };
319             }
320              
321 1558         2454 eval {
322             # save current component
323 1558         1908 eval { $component = $stash->get('component') };
  1558         24376  
324              
325 1558         3533 foreach $name (@$template) {
326 1560         2549 $compiled = shift @compiled;
327 1560 100       6841 my $element = ref $compiled eq 'CODE'
    100          
328             ? { (name => (ref $name ? '' : $name), modtime => time()) }
329             : $compiled;
330              
331 1560 100 66     11697 if (blessed($component) && $component->isa(DOCUMENT)) {
332 285         832 $element->{ caller } = $component->{ name };
333 285   100     1608 $element->{ callers } = $component->{ callers } || [];
334 285         423 push(@{$element->{ callers }}, $element->{ caller });
  285         763  
335             }
336              
337 1560         15416 $stash->set('component', $element);
338            
339 1560 100       4245 unless ($localize) {
340             # merge any local blocks defined in the Template::Document
341             # into our local BLOCKS cache
342 1298 50 66     22735 @$blocks{ keys %$tblocks } = values %$tblocks
      66        
343             if (blessed($compiled) && $compiled->isa(DOCUMENT))
344             && ($tblocks = $compiled->blocks);
345             }
346            
347 1560 100       6150 if (ref $compiled eq 'CODE') {
    50          
348 214         4614 $tmpout = &$compiled($self);
349             }
350             elsif (ref $compiled) {
351 1346         5923 $tmpout = $compiled->process($self);
352             }
353             else {
354 0         0 $self->throw('file',
355             "invalid template reference: $compiled");
356             }
357            
358 1538 100       6815 if ($trim) {
359 116         256 for ($tmpout) {
360 116         330 s/^\s+//;
361 116         1428 s/\s+$//;
362             }
363             }
364 1538         3109 $output .= $tmpout;
365              
366             # pop last item from callers.
367             # NOTE - this will not be called if template throws an
368             # error. The whole issue of caller and callers should be
369             # revisited to try and avoid putting this info directly into
370             # the component data structure. Perhaps use a local element
371             # instead?
372              
373 1538 100 66     9358 pop(@{$element->{ callers }})
  278         1054  
374             if (blessed($component) && $component->isa(DOCUMENT));
375             }
376 1536         15038 $stash->set('component', $component);
377             };
378 1558         2561 $error = $@;
379            
380 1558 100       3716 if ($localize) {
381             # ensure stash is delocalised before dying
382 261         1517 $self->{ STASH } = $self->{ STASH }->declone();
383             }
384            
385 1558 50       8067 $self->throw(ref $error
    100          
386             ? $error : (Template::Constants::ERROR_FILE, $error))
387             if $error;
388            
389 1536         9305 return $output;
390             }
391              
392              
393             #------------------------------------------------------------------------
394             # include($template, \%params) [% INCLUDE template var = val, ... %]
395             #
396             # Similar to process() above but processing the template in a local
397             # context. Any variables passed by reference to a hash as the second
398             # parameter will be set before the template is processed and then
399             # revert to their original values before the method returns. Similarly,
400             # any changes made to non-global variables within the template will
401             # persist only until the template is processed.
402             #
403             # Returns the output of processing the template. Errors are thrown
404             # as Template::Exception objects via die().
405             #------------------------------------------------------------------------
406              
407             sub include {
408 279     279 1 4002837 my ($self, $template, $params) = @_;
409 279         1211 return $self->process($template, $params, 'localize me!');
410             }
411              
412             #------------------------------------------------------------------------
413             # insert($file)
414             #
415             # Insert the contents of a file without parsing.
416             #------------------------------------------------------------------------
417              
418             sub insert {
419 15     15 1 190 my ($self, $file) = @_;
420 15         23 my ($prefix, $providers, $text, $error);
421 15         27 my $output = '';
422              
423 15 100       59 my $files = ref $file eq 'ARRAY' ? $file : [ $file ];
424              
425             $self->debug("insert([ ", join(', '), @$files, " ])")
426 15 50       48 if $self->{ DEBUG };
427              
428              
429 15         34 FILE: foreach $file (@$files) {
430 17         26 my $name = $file;
431              
432 17 50       63 if ($^O eq 'MSWin32') {
433             # let C:/foo through
434 0 0       0 $prefix = $1 if $name =~ s/^(\w{2,})://o;
435             }
436             else {
437 17 100       73 $prefix = $1 if $name =~ s/^(\w+)://;
438             }
439              
440 17 100       35 if (defined $prefix) {
441 1   50     5 $providers = $self->{ PREFIX_MAP }->{ $prefix }
442             || return $self->throw(Template::Constants::ERROR_FILE,
443             "no providers for file prefix '$prefix'");
444             }
445             else {
446             $providers = $self->{ PREFIX_MAP }->{ default }
447 16   33     91 || $self->{ LOAD_TEMPLATES };
448             }
449              
450 17         35 foreach my $provider (@$providers) {
451 17         71 ($text, $error) = $provider->load($name, $prefix);
452 17 100       64 next FILE unless $error;
453 5 100       21 if ($error == Template::Constants::STATUS_ERROR) {
454 2 50       8 $self->throw($text) if ref $text;
455 2         6 $self->throw(Template::Constants::ERROR_FILE, $text);
456             }
457             }
458 3         18 $self->throw(Template::Constants::ERROR_FILE, "$file: not found");
459             }
460             continue {
461 12         38 $output .= $text;
462             }
463 10         39 return $output;
464             }
465              
466              
467             #------------------------------------------------------------------------
468             # throw($type, $info, \$output) [% THROW errtype "Error info" %]
469             #
470             # Throws a Template::Exception object by calling die(). This method
471             # may be passed a reference to an existing Template::Exception object;
472             # a single value containing an error message which is used to
473             # instantiate a Template::Exception of type 'undef'; or a pair of
474             # values representing the exception type and info from which a
475             # Template::Exception object is instantiated. e.g.
476             #
477             # $context->throw($exception);
478             # $context->throw("I'm sorry Dave, I can't do that");
479             # $context->throw('denied', "I'm sorry Dave, I can't do that");
480             #
481             # An optional third parameter can be supplied in the last case which
482             # is a reference to the current output buffer containing the results
483             # of processing the template up to the point at which the exception
484             # was thrown. The RETURN and STOP directives, for example, use this
485             # to propagate output back to the user, but it can safely be ignored
486             # in most cases.
487             #
488             # This method rides on a one-way ticket to die() oblivion. It does not
489             # return in any real sense of the word, but should get caught by a
490             # surrounding eval { } block (e.g. a BLOCK or TRY) and handled
491             # accordingly, or returned to the caller as an uncaught exception.
492             #------------------------------------------------------------------------
493              
494             sub throw {
495 138     138 1 1004 my ($self, $error, $info, $output) = @_;
496 138         304 local $" = ', ';
497              
498             # die! die! die!
499 138 100 66     2692 if (blessed($error) && $error->isa(EXCEPTION)) {
    50 33        
    100          
500 30         357 die $error;
501             }
502             elsif (blessed($error) && $error->isa(BADGER_EXCEPTION)) {
503             # convert a Badger::Exception to a Template::Exception so that
504             # things continue to work during the transition to Badger
505 0         0 die EXCEPTION->new($error->type, $error->info);
506             }
507             elsif (defined $info) {
508 103         1649 die (EXCEPTION->new($error, $info, $output));
509             }
510             else {
511 5   50     16 $error ||= '';
512 5         38 die (EXCEPTION->new('undef', $error, $output));
513             }
514              
515             # not reached
516             }
517              
518              
519             #------------------------------------------------------------------------
520             # catch($error, \$output)
521             #
522             # Called by various directives after catching an error thrown via die()
523             # from within an eval { } block. The first parameter contains the error
524             # which may be a sanitized reference to a Template::Exception object
525             # (such as that raised by the throw() method above, a plugin object,
526             # and so on) or an error message thrown via die from somewhere in user
527             # code. The latter are coerced into 'undef' Template::Exception objects.
528             # Like throw() above, a reference to a scalar may be passed as an
529             # additional parameter to represent the current output buffer
530             # localised within the eval block. As exceptions are thrown upwards
531             # and outwards from nested blocks, the catch() method reconstructs the
532             # correct output buffer from these fragments, storing it in the
533             # exception object for passing further onwards and upwards.
534             #
535             # Returns a reference to a Template::Exception object..
536             #------------------------------------------------------------------------
537              
538             sub catch {
539 156     156 1 1893 my ($self, $error, $output) = @_;
540              
541 156 100 33     2358 if ( blessed($error)
      66        
542             && ( $error->isa(EXCEPTION) || $error->isa(BADGER_EXCEPTION) ) ) {
543 141 100       956 $error->text($output) if $output;
544 141         379 return $error;
545             }
546             else {
547 15         141 return EXCEPTION->new('undef', $error, $output);
548             }
549             }
550              
551              
552             #------------------------------------------------------------------------
553             # localise(\%params)
554             # delocalise()
555             #
556             # The localise() method creates a local copy of the current stash,
557             # allowing the existing state of variables to be saved and later
558             # restored via delocalise().
559             #
560             # A reference to a hash array may be passed containing local variable
561             # definitions which should be added to the cloned namespace. These
562             # values persist until delocalisation.
563             #------------------------------------------------------------------------
564              
565             sub localise {
566 1226     1226 1 2500 my $self = shift;
567 1226         8543 $self->{ STASH } = $self->{ STASH }->clone(@_);
568             }
569              
570             sub delocalise {
571 1226     1226 1 2228 my $self = shift;
572 1226         5145 $self->{ STASH } = $self->{ STASH }->declone();
573             }
574              
575              
576             #------------------------------------------------------------------------
577             # visit($document, $blocks)
578             #
579             # Each Template::Document calls the visit() method on the context
580             # before processing itself. It passes a reference to the hash array
581             # of named BLOCKs defined within the document, allowing them to be
582             # added to the internal BLKSTACK list which is subsequently used by
583             # template() to resolve templates.
584             # from a provider.
585             #------------------------------------------------------------------------
586              
587             sub visit {
588 1349     1349 1 7990 my ($self, $document, $blocks) = @_;
589 1349         2020 unshift(@{ $self->{ BLKSTACK } }, $blocks)
  1349         4928  
590             }
591              
592              
593             #------------------------------------------------------------------------
594             # leave()
595             #
596             # The leave() method is called when the document has finished
597             # processing itself. This removes the entry from the BLKSTACK list
598             # that was added visit() above. For persistence of BLOCK definitions,
599             # the process() method (i.e. the PROCESS directive) does some extra
600             # magic to copy BLOCKs into a shared hash.
601             #------------------------------------------------------------------------
602              
603             sub leave {
604 1347     1347 1 2371 my $self = shift;
605 1347         2916 shift(@{ $self->{ BLKSTACK } });
  1347         4278  
606             }
607              
608              
609             #------------------------------------------------------------------------
610             # define_block($name, $block)
611             #
612             # Adds a new BLOCK definition to the local BLOCKS cache. $block may
613             # be specified as a reference to a sub-routine or Template::Document
614             # object or as text which is compiled into a template. Returns a true
615             # value (the $block reference or compiled block reference) if
616             # successful or undef on failure. Call error() to retrieve the
617             # relevant error message (i.e. compilation failure).
618             #------------------------------------------------------------------------
619              
620             sub define_block {
621 0     0 1 0 my ($self, $name, $block) = @_;
622 0 0 0     0 $block = $self->template(\$block)
623             || return undef
624             unless ref $block;
625 0         0 $self->{ BLOCKS }->{ $name } = $block;
626             }
627              
628              
629             #------------------------------------------------------------------------
630             # define_filter($name, $filter, $is_dynamic)
631             #
632             # Adds a new FILTER definition to the local FILTER_CACHE.
633             #------------------------------------------------------------------------
634              
635             sub define_filter {
636 7     7 1 147 my ($self, $name, $filter, $is_dynamic) = @_;
637 7         12 my ($result, $error);
638 7 100       29 $filter = [ $filter, 1 ] if $is_dynamic;
639              
640 7         21 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  7         28  
641 7         50 ($result, $error) = $provider->store($name, $filter);
642 7 50       37 return 1 unless $error;
643 0 0       0 $self->throw(&Template::Constants::ERROR_FILTER, $result)
644             if $error == &Template::Constants::STATUS_ERROR;
645             }
646 0         0 $self->throw(&Template::Constants::ERROR_FILTER,
647             "FILTER providers declined to store filter $name");
648             }
649              
650              
651             #------------------------------------------------------------------------
652             # define_vmethod($type, $name, \&sub)
653             #
654             # Passes $type, $name, and &sub on to stash->define_vmethod().
655             #------------------------------------------------------------------------
656              
657             sub define_vmethod {
658 8     8 1 42 my $self = shift;
659 8         29 $self->stash->define_vmethod(@_);
660             }
661              
662              
663             #------------------------------------------------------------------------
664             # define_view($name, $params)
665             #
666             # Defines a new view.
667             #------------------------------------------------------------------------
668              
669             sub define_view {
670 2     2 1 4 my ($self, $name, $params) = @_;
671 2         4 my $base;
672              
673 2 100       7 if (defined $params->{ base }) {
674 1         17 my $base = $self->{ STASH }->get($params->{ base });
675              
676 1 50       7 return $self->throw(
677             &Template::Constants::ERROR_VIEW,
678             "view base is not defined: $params->{ base }"
679             ) unless $base;
680              
681 1 50 33     24 return $self->throw(
682             &Template::Constants::ERROR_VIEW,
683             "view base is not a $VIEW_CLASS object: $params->{ base } => $base"
684             ) unless blessed($base) && $base->isa($VIEW_CLASS);
685            
686 1         4 $params->{ base } = $base;
687             }
688 2         9 my $view = $self->view($params);
689 2         278 $view->seal();
690 2         68 $self->{ STASH }->set($name, $view);
691             }
692              
693              
694             #------------------------------------------------------------------------
695             # define_views($views)
696             #
697             # Defines multiple new views.
698             #------------------------------------------------------------------------
699              
700             sub define_views {
701 1     1 1 3 my ($self, $views) = @_;
702            
703             # a list reference is better because the order is deterministic (and so
704             # allows an earlier VIEW to be the base for a later VIEW), but we'll
705             # accept a hash reference and assume that the user knows the order of
706             # processing is undefined
707 1 50       18 $views = [ %$views ]
708             if ref $views eq 'HASH';
709            
710             # make of copy so we don't destroy the original list reference
711 1         5 my @items = @$views;
712 1         9 my ($name, $view);
713            
714 1         5 while (@items) {
715 2         11 $self->define_view(splice(@items, 0, 2));
716             }
717             }
718              
719              
720             #------------------------------------------------------------------------
721             # reset()
722             #
723             # Reset the state of the internal BLOCKS hash to clear any BLOCK
724             # definitions imported via the PROCESS directive. Any original
725             # BLOCKS definitions passed to the constructor will be restored.
726             #------------------------------------------------------------------------
727              
728             sub reset {
729 1180     1180 1 2165 my ($self, $blocks) = @_;
730 1180         3324 $self->{ BLKSTACK } = [ ];
731 1180         10886 $self->{ BLOCKS } = { %{ $self->{ INIT_BLOCKS } } };
  1180         5265  
732             }
733              
734              
735             #------------------------------------------------------------------------
736             # stash()
737             #
738             # Simple accessor methods to return the STASH values. This is likely
739             # to be called quite often so we provide a direct method rather than
740             # relying on the slower AUTOLOAD.
741             #------------------------------------------------------------------------
742              
743             sub stash {
744 1566     1566 1 31684 return $_[0]->{ STASH };
745             }
746              
747              
748             #------------------------------------------------------------------------
749             # debugging($command, @args, \%params)
750             #
751             # Method for controlling the debugging status of the context. The first
752             # argument can be 'on' or 'off' to enable/disable debugging, 'format'
753             # to define the format of the debug message, or 'msg' to generate a
754             # debugging message reporting the file, line, message text, etc.,
755             # according to the current debug format.
756             #------------------------------------------------------------------------
757              
758             sub debugging {
759 15     15 1 153 my $self = shift;
760 15 100       39 my $hash = ref $_[-1] eq 'HASH' ? pop : { };
761 15         30 my @args = @_;
762              
763 15 50       33 if (@args) {
764 15 100       83 if ($args[0] =~ /^on|1$/i) {
    100          
765 3         5 $self->{ DEBUG_DIRS } = 1;
766 3         5 shift(@args);
767             }
768             elsif ($args[0] =~ /^off|0$/i) {
769 3         6 $self->{ DEBUG_DIRS } = 0;
770 3         6 shift(@args);
771             }
772             }
773              
774 15 100       31 if (@args) {
775 9 50       27 if ($args[0] =~ /^msg$/i) {
    0          
776 9 50       25 return unless $self->{ DEBUG_DIRS };
777 9         17 my $format = $self->{ DEBUG_FORMAT };
778 9 50       22 $format = $DEBUG_FORMAT unless defined $format;
779 9         48 $format =~ s/\$(\w+)/$hash->{ $1 }/ge;
  27         89  
780 9         43 return $format;
781             }
782             elsif ($args[0] =~ /^format$/i) {
783 0         0 $self->{ DEBUG_FORMAT } = $args[1];
784             }
785             # else ignore
786             }
787              
788 6         15 return '';
789             }
790              
791              
792             #------------------------------------------------------------------------
793             # AUTOLOAD
794             #
795             # Provides pseudo-methods for read-only access to various internal
796             # members. For example, templates(), plugins(), filters(),
797             # eval_perl(), load_perl(), etc. These aren't called very often, or
798             # may never be called at all.
799             #------------------------------------------------------------------------
800              
801             sub AUTOLOAD {
802 26     26   211 my $self = shift;
803 26         66 my $method = $AUTOLOAD;
804 26         45 my $result;
805              
806 26         150 $method =~ s/.*:://;
807 26 50       88 return if $method eq 'DESTROY';
808              
809 26 50       232 warn "no such context method/member: $method\n"
810             unless defined ($result = $self->{ uc $method });
811              
812 26         206 return $result;
813             }
814              
815              
816             #------------------------------------------------------------------------
817             # DESTROY
818             #
819             # Stash may contain references back to the Context via macro closures,
820             # etc. This breaks the circular references.
821             #------------------------------------------------------------------------
822              
823             sub DESTROY {
824 132     132   1518 my $self = shift;
825 132         1108 undef $self->{ STASH };
826             }
827              
828              
829              
830             #========================================================================
831             # -- PRIVATE METHODS --
832             #========================================================================
833              
834             #------------------------------------------------------------------------
835             # _init(\%config)
836             #
837             # Initialisation method called by Template::Base::new()
838             #------------------------------------------------------------------------
839              
840             sub _init {
841 148     148   348 my ($self, $config) = @_;
842 148         244 my ($name, $item, $method, $block, $blocks);
843 148         519 my @itemlut = (
844             LOAD_TEMPLATES => 'provider',
845             LOAD_PLUGINS => 'plugins',
846             LOAD_FILTERS => 'filters'
847             );
848              
849             # LOAD_TEMPLATE, LOAD_PLUGINS, LOAD_FILTERS - lists of providers
850 148         771 while (($name, $method) = splice(@itemlut, 0, 2)) {
851 444   50     3357 $item = $config->{ $name }
852             || Template::Config->$method($config)
853             || return $self->error($Template::Config::ERROR);
854 444 100       3339 $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ];
855             }
856              
857 148         4656 my $providers = $self->{ LOAD_TEMPLATES };
858 148   100     963 my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { };
859 148         749 while (my ($key, $val) = each %$prefix_map) {
860 4         24 $prefix_map->{ $key } = [ ref $val ? $val :
861 3 50       23 map { $providers->[$_] } split(/\D+/, $val) ]
    50          
862             unless ref $val eq 'ARRAY';
863             }
864              
865             # STASH
866 148   66     680 $self->{ STASH } = $config->{ STASH } || do {
867             my $predefs = $config->{ VARIABLES }
868             || $config->{ PRE_DEFINE }
869             || { };
870              
871             # hack to get stash to know about debug mode
872             $predefs->{ _DEBUG } = ( ($config->{ DEBUG } || 0)
873             & &Template::Constants::DEBUG_UNDEF ) ? 1 : 0
874             unless defined $predefs->{ _DEBUG };
875             $predefs->{ _STRICT } = $config->{ STRICT };
876            
877             Template::Config->stash($predefs)
878             || return $self->error($Template::Config::ERROR);
879             };
880            
881             # compile any template BLOCKS specified as text
882 148   100     1115 $blocks = $config->{ BLOCKS } || { };
883             $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = {
884 52         112 map {
885 148         817 $block = $blocks->{ $_ };
886 52 100 50     189 $block = $self->template(\$block)
887             || return undef
888             unless ref $block;
889 52         195 ($_ => $block);
890             }
891             keys %$blocks
892             };
893              
894             # define any VIEWS
895             $self->define_views( $config->{ VIEWS } )
896 148 100       784 if $config->{ VIEWS };
897              
898             # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
899             # RECURSION - flag indicating is recursion into templates is supported
900             # EVAL_PERL - flag indicating if PERL blocks should be processed
901             # TRIM - flag to remove leading and trailing whitespace from output
902             # BLKSTACK - list of hashes of BLOCKs defined in current template(s)
903             # CONFIG - original configuration hash
904             # EXPOSE_BLOCKS - make blocks visible as pseudo-files
905             # DEBUG_FORMAT - format for generating template runtime debugging messages
906             # DEBUG - format for generating template runtime debugging messages
907              
908 148   100     925 $self->{ RECURSION } = $config->{ RECURSION } || 0;
909 148   100     912 $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0;
910 148   100     2962 $self->{ TRIM } = $config->{ TRIM } || 0;
911 148         389 $self->{ BLKSTACK } = [ ];
912 148         329 $self->{ CONFIG } = $config;
913             $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS }
914             ? $config->{ EXPOSE_BLOCKS }
915 148 100       705 : 0;
916              
917 148         529 $self->{ DEBUG_FORMAT } = $config->{ DEBUG_FORMAT };
918 148   100     996 $self->{ DEBUG_DIRS } = ($config->{ DEBUG } || 0)
919             & Template::Constants::DEBUG_DIRS;
920             $self->{ DEBUG } = defined $config->{ DEBUG }
921 148 100       627 ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT
922             | Template::Constants::DEBUG_FLAGS )
923             : $DEBUG;
924              
925 148         2749 return $self;
926             }
927              
928              
929             #------------------------------------------------------------------------
930             # _dump()
931             #
932             # Debug method which returns a string representing the internal state
933             # of the context object.
934             #------------------------------------------------------------------------
935              
936             sub _dump {
937 0     0     my $self = shift;
938 0           my $output = "[Template::Context] {\n";
939 0           my $format = " %-16s => %s\n";
940 0           my $key;
941              
942 0           foreach $key (qw( RECURSION EVAL_PERL TRIM )) {
943 0           $output .= sprintf($format, $key, $self->{ $key });
944             }
945 0           foreach my $pname (qw( LOAD_TEMPLATES LOAD_PLUGINS LOAD_FILTERS )) {
946 0           my $provtext = "[\n";
947 0           foreach my $prov (@{ $self->{ $pname } }) {
  0            
948 0           $provtext .= $prov->_dump();
949             # $provtext .= ",\n";
950             }
951 0           $provtext =~ s/\n/\n /g;
952 0           $provtext =~ s/\s+$//;
953 0           $provtext .= ",\n ]";
954 0           $output .= sprintf($format, $pname, $provtext);
955             }
956 0           $output .= sprintf($format, STASH => $self->{ STASH }->_dump());
957 0           $output .= '}';
958 0           return $output;
959             }
960              
961              
962             1;
963              
964             __END__