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   1230 use strict;
  80         169  
  80         3651  
24 80     80   452 use warnings;
  80         162  
  80         4073  
25 80     80   448 use base 'Template::Base';
  80         150  
  80         11368  
26              
27 80     80   464 use Template::Base;
  80         159  
  80         9757  
28 80     80   442 use Template::Config;
  80         172  
  80         2887  
29 80     80   520 use Template::Constants;
  80         166  
  80         4248  
30 80     80   579 use Template::Exception;
  80         178  
  80         2532  
31 80     80   462 use Scalar::Util 'blessed';
  80         156  
  80         5211  
32              
33 80     80   480 use constant DOCUMENT => 'Template::Document';
  80         161  
  80         5773  
34 80     80   445 use constant EXCEPTION => 'Template::Exception';
  80         200  
  80         3856  
35 80     80   587 use constant BADGER_EXCEPTION => 'Badger::Exception';
  80         321  
  80         415149  
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 2920     2920 1 4887 my ($self, $name) = @_;
79 2920         3937 my ($prefix, $blocks, $defblocks, $provider, $template, $error);
80 0         0 my ($shortname, $blockname, $providers);
81              
82 2920 50       14928 $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 2920 100 66     35019 return $name
      100        
88             if (blessed($name) && $name->isa(DOCUMENT))
89             || ref($name) eq 'CODE';
90              
91 1620         2326 $shortname = $name;
92              
93 1620 100       4544 unless (ref $name) {
94            
95 423 50       1139 $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       1818 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         344 foreach $blocks (@{ $self->{ BLKSTACK } }) {
  236         569  
105 141 100 66     1346 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       867 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       772 $prefix = $1 if $shortname =~ s/^(\w+)://;
117             }
118            
119 217 100       553 if (defined $prefix) {
120 3   50     13 $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 1414 100 33     10139 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 1414         3035 $blockname = '';
135 1414         3879 while ($shortname) {
136             $self->debug("asking providers for [$shortname] [$blockname]")
137 1418 50       4199 if $self->{ DEBUG };
138              
139 1418         3082 foreach my $provider (@$providers) {
140 1418         6879 ($template, $error) = $provider->fetch($shortname, $prefix);
141 1418 100       6105 if ($error) {
    100          
142 45 100       180 if ($error == Template::Constants::STATUS_ERROR) {
143             # $template contains exception object
144 6 50 66     93 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         30 $self->throw( Template::Constants::ERROR_FILE, $template );
150             }
151             }
152             # DECLINE is ok, carry on
153             }
154             elsif (length $blockname) {
155 4 100       20 return $template
156             if $template = $template->blocks->{ $blockname };
157             }
158             else {
159 1369         7596 return $template;
160             }
161             }
162            
163 40 100 66     280 last if ref $shortname || ! $self->{ EXPOSE_BLOCKS };
164 5 100       47 $shortname =~ s{/([^/]+)$}{} || last;
165 4 50       18 $blockname = length $blockname ? "$1/$blockname" : $1;
166             }
167            
168 36         173 $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 210     210 1 2040 my ($self, $name, $args) = @_;
185 210         352 my ($provider, $plugin, $error);
186            
187             $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')')
188 210 0       784 if $self->{ DEBUG };
    50          
189            
190             # request the named plugin from each of the LOAD_PLUGINS providers in turn
191 210         325 foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) {
  210         725  
192 210         1358 ($plugin, $error) = $provider->fetch($name, $args, $self);
193 210 100       2869 return $plugin unless $error;
194 6 100       28 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         24 $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 167     167 1 4325 my ($self, $name, $args, $alias) = @_;
214 167         249 my ($provider, $filter, $error);
215            
216             $self->debug("filter($name, ",
217             defined $args ? @$args : '[ ]',
218             defined $alias ? $alias : '', ')')
219 167 0       455 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 167 100 100     1240 && ($filter = $self->{ FILTER_CACHE }->{ $name });
      100        
225            
226             # request the named filter from each of the FILTERS providers in turn
227 156         199 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  156         455  
228 156         717 ($filter, $error) = $provider->fetch($name, $args, $self);
229 156 100       471 last unless $error;
230 9 50       20 if ($error == Template::Constants::STATUS_ERROR) {
231 9 100       30 $self->throw($filter) if ref $filter;
232 5         21 $self->throw(Template::Constants::ERROR_FILTER, $filter);
233             }
234             # return $self->error($filter)
235             # if $error == &Template::Constants::STATUS_ERROR;
236             }
237            
238 147 50       355 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 147 100       329 $self->{ FILTER_CACHE }->{ $alias } = $filter
255             if $alias;
256              
257 147         361 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 350 my $self = shift;
269 34         901 require Template::View;
270 34   66     230 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 1586     1586 1 3554 my ($self, $template, $params, $localize) = @_;
295 1586         4598 my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) };
296 1586         2326 my (@compiled, $name, $compiled);
297 0         0 my ($stash, $component, $tblocks, $error, $tmpout);
298 1586         2602 my $output = '';
299            
300 1586 100       6564 $template = [ $template ] unless ref $template eq 'ARRAY';
301            
302             $self->debug("process([ ", join(', '), @$template, ' ], ',
303             defined $params ? $params : '', ', ',
304             $localize ? '' : '', ')')
305 1586 0       5356 if $self->{ DEBUG };
    0          
    50          
306            
307             # fetch compiled template for each name specified
308 1586         3017 foreach $name (@$template) {
309 1588         5318 push(@compiled, $self->template($name));
310             }
311              
312 1566 100       4080 if ($localize) {
313             # localise the variable stash with any parameters passed
314 261         1241 $stash = $self->{ STASH } = $self->{ STASH }->clone($params);
315             } else {
316             # update stash with any new parameters passed
317 1305         7037 $self->{ STASH }->update($params);
318 1305         2882 $stash = $self->{ STASH };
319             }
320              
321 1566         2667 eval {
322             # save current component
323 1566         2020 eval { $component = $stash->get('component') };
  1566         28816  
324              
325 1566         4390 foreach $name (@$template) {
326 1568         2552 $compiled = shift @compiled;
327 1568 100       5412 my $element = ref $compiled eq 'CODE'
    100          
328             ? { (name => (ref $name ? '' : $name), modtime => time()) }
329             : $compiled;
330              
331 1568 100 66     8052 if (blessed($component) && $component->isa(DOCUMENT)) {
332 285         944 $element->{ caller } = $component->{ name };
333 285   100     1572 $element->{ callers } = $component->{ callers } || [];
334 285         426 push(@{$element->{ callers }}, $element->{ caller });
  285         777  
335             }
336              
337 1568         16556 $stash->set('component', $element);
338            
339 1568 100       4207 unless ($localize) {
340             # merge any local blocks defined in the Template::Document
341             # into our local BLOCKS cache
342 1306 50 66     15401 @$blocks{ keys %$tblocks } = values %$tblocks
      66        
343             if (blessed($compiled) && $compiled->isa(DOCUMENT))
344             && ($tblocks = $compiled->blocks);
345             }
346            
347 1568 100       6520 if (ref $compiled eq 'CODE') {
    50          
348 214         3793 $tmpout = &$compiled($self);
349             }
350             elsif (ref $compiled) {
351 1354         6537 $tmpout = $compiled->process($self);
352             }
353             else {
354 0         0 $self->throw('file',
355             "invalid template reference: $compiled");
356             }
357            
358 1546 100       6826 if ($trim) {
359 116         218 for ($tmpout) {
360 116         299 s/^\s+//;
361 116         746 s/\s+$//;
362             }
363             }
364 1546         3242 $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 1546 100 66     10251 pop(@{$element->{ callers }})
  278         1038  
374             if (blessed($component) && $component->isa(DOCUMENT));
375             }
376 1544         12986 $stash->set('component', $component);
377             };
378 1566         2616 $error = $@;
379            
380 1566 100       3882 if ($localize) {
381             # ensure stash is delocalised before dying
382 261         1091 $self->{ STASH } = $self->{ STASH }->declone();
383             }
384            
385 1566 50       3687 $self->throw(ref $error
    100          
386             ? $error : (Template::Constants::ERROR_FILE, $error))
387             if $error;
388            
389 1544         8868 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 4002880 my ($self, $template, $params) = @_;
409 279         1119 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 175 my ($self, $file) = @_;
420 15         24 my ($prefix, $providers, $text, $error);
421 15         28 my $output = '';
422              
423 15 100       55 my $files = ref $file eq 'ARRAY' ? $file : [ $file ];
424              
425             $self->debug("insert([ ", join(', '), @$files, " ])")
426 15 50       52 if $self->{ DEBUG };
427              
428              
429 15         30 FILE: foreach $file (@$files) {
430 17         24 my $name = $file;
431              
432 17 50       65 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       60 $prefix = $1 if $name =~ s/^(\w+)://;
438             }
439              
440 17 100       38 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     97 || $self->{ LOAD_TEMPLATES };
448             }
449              
450 17         35 foreach my $provider (@$providers) {
451 17         74 ($text, $error) = $provider->load($name, $prefix);
452 17 100       194 next FILE unless $error;
453 5 100       19 if ($error == Template::Constants::STATUS_ERROR) {
454 2 50       7 $self->throw($text) if ref $text;
455 2         6 $self->throw(Template::Constants::ERROR_FILE, $text);
456             }
457             }
458 3         17 $self->throw(Template::Constants::ERROR_FILE, "$file: not found");
459             }
460             continue {
461 12         45 $output .= $text;
462             }
463 10         98 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 915 my ($self, $error, $info, $output) = @_;
496 138         294 local $" = ', ';
497              
498             # die! die! die!
499 138 100 66     1318 if (blessed($error) && $error->isa(EXCEPTION)) {
    50 33        
    100          
500 30         186 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         770 die (EXCEPTION->new($error, $info, $output));
509             }
510             else {
511 5   50     16 $error ||= '';
512 5         35 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 2080 my ($self, $error, $output) = @_;
540              
541 156 100 33     1474 if ( blessed($error)
      66        
542             && ( $error->isa(EXCEPTION) || $error->isa(BADGER_EXCEPTION) ) ) {
543 141 100       756 $error->text($output) if $output;
544 141         384 return $error;
545             }
546             else {
547 15         147 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 1234     1234 1 2493 my $self = shift;
567 1234         8988 $self->{ STASH } = $self->{ STASH }->clone(@_);
568             }
569              
570             sub delocalise {
571 1234     1234 1 2208 my $self = shift;
572 1234         5224 $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 1357     1357 1 2649 my ($self, $document, $blocks) = @_;
589 1357         2340 unshift(@{ $self->{ BLKSTACK } }, $blocks)
  1357         5481  
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 1355     1355 1 2241 my $self = shift;
605 1355         17983 shift(@{ $self->{ BLKSTACK } });
  1355         4503  
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 161 my ($self, $name, $filter, $is_dynamic) = @_;
637 7         15 my ($result, $error);
638 7 100       28 $filter = [ $filter, 1 ] if $is_dynamic;
639              
640 7         16 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  7         26  
641 7         84 ($result, $error) = $provider->store($name, $filter);
642 7 50       42 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 40 my $self = shift;
659 8         30 $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         3 my $base;
672              
673 2 100       16 if (defined $params->{ base }) {
674 1         14 my $base = $self->{ STASH }->get($params->{ base });
675              
676 1 50       4 return $self->throw(
677             &Template::Constants::ERROR_VIEW,
678             "view base is not defined: $params->{ base }"
679             ) unless $base;
680              
681 1 50 33     21 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         3 $params->{ base } = $base;
687             }
688 2         6 my $view = $self->view($params);
689 2         8 $view->seal();
690 2         56 $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       5 $views = [ %$views ]
708             if ref $views eq 'HASH';
709            
710             # make of copy so we don't destroy the original list reference
711 1         4 my @items = @$views;
712 1         2 my ($name, $view);
713            
714 1         4 while (@items) {
715 2         6 $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 1188     1188 1 2592 my ($self, $blocks) = @_;
730 1188         3072 $self->{ BLKSTACK } = [ ];
731 1188         2128 $self->{ BLOCKS } = { %{ $self->{ INIT_BLOCKS } } };
  1188         5212  
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 1574     1574 1 31019 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 152 my $self = shift;
760 15 100       39 my $hash = ref $_[-1] eq 'HASH' ? pop : { };
761 15         27 my @args = @_;
762              
763 15 50       31 if (@args) {
764 15 100       77 if ($args[0] =~ /^on|1$/i) {
    100          
765 3         6 $self->{ DEBUG_DIRS } = 1;
766 3         7 shift(@args);
767             }
768             elsif ($args[0] =~ /^off|0$/i) {
769 3         8 $self->{ DEBUG_DIRS } = 0;
770 3         4 shift(@args);
771             }
772             }
773              
774 15 100       33 if (@args) {
775 9 50       27 if ($args[0] =~ /^msg$/i) {
    0          
776 9 50       25 return unless $self->{ DEBUG_DIRS };
777 9         16 my $format = $self->{ DEBUG_FORMAT };
778 9 50       19 $format = $DEBUG_FORMAT unless defined $format;
779 9         45 $format =~ s/\$(\w+)/$hash->{ $1 }/ge;
  27         97  
780 9         38 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         19 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   174 my $self = shift;
803 26         50 my $method = $AUTOLOAD;
804 26         39 my $result;
805              
806 26         134 $method =~ s/.*:://;
807 26 50       92 return if $method eq 'DESTROY';
808              
809 26 50       120 warn "no such context method/member: $method\n"
810             unless defined ($result = $self->{ uc $method });
811              
812 26         100 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   11238 my $self = shift;
825 132         1077 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   533 my ($self, $config) = @_;
842 148         249 my ($name, $item, $method, $block, $blocks);
843 148         584 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         767 while (($name, $method) = splice(@itemlut, 0, 2)) {
851 444   50     3304 $item = $config->{ $name }
852             || Template::Config->$method($config)
853             || return $self->error($Template::Config::ERROR);
854 444 100       4032 $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ];
855             }
856              
857 148         426 my $providers = $self->{ LOAD_TEMPLATES };
858 148   100     1020 my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { };
859 148         762 while (my ($key, $val) = each %$prefix_map) {
860 4         24 $prefix_map->{ $key } = [ ref $val ? $val :
861 3 50       27 map { $providers->[$_] } split(/\D+/, $val) ]
    50          
862             unless ref $val eq 'ARRAY';
863             }
864              
865             # STASH
866 148   66     652 $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     1157 $blocks = $config->{ BLOCKS } || { };
883             $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = {
884 52         112 map {
885 148         795 $block = $blocks->{ $_ };
886 52 100 50     224 $block = $self->template(\$block)
887             || return undef
888             unless ref $block;
889 52         212 ($_ => $block);
890             }
891             keys %$blocks
892             };
893              
894             # define any VIEWS
895             $self->define_views( $config->{ VIEWS } )
896 148 100       576 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     931 $self->{ RECURSION } = $config->{ RECURSION } || 0;
909 148   100     964 $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0;
910 148   100     865 $self->{ TRIM } = $config->{ TRIM } || 0;
911 148         390 $self->{ BLKSTACK } = [ ];
912 148         343 $self->{ CONFIG } = $config;
913             $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS }
914             ? $config->{ EXPOSE_BLOCKS }
915 148 100       665 : 0;
916              
917 148         542 $self->{ DEBUG_FORMAT } = $config->{ DEBUG_FORMAT };
918 148   100     983 $self->{ DEBUG_DIRS } = ($config->{ DEBUG } || 0)
919             & Template::Constants::DEBUG_DIRS;
920             $self->{ DEBUG } = defined $config->{ DEBUG }
921 148 100       631 ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT
922             | Template::Constants::DEBUG_FLAGS )
923             : $DEBUG;
924              
925 148         2743 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__