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 84     84   707 use strict;
  84         100  
  84         2099  
24 84     84   260 use warnings;
  84         82  
  84         2936  
25 84     84   266 use base 'Template::Base';
  84         92  
  84         6913  
26              
27 84     84   334 use Template::Base;
  84         95  
  84         1424  
28 84     84   251 use Template::Config;
  84         91  
  84         1490  
29 84     84   251 use Template::Constants;
  84         84  
  84         2831  
30 84     84   338 use Template::Exception;
  84         82  
  84         1751  
31 84     84   244 use Scalar::Util 'blessed';
  84         98  
  84         3618  
32              
33 84     84   294 use constant DOCUMENT => 'Template::Document';
  84         94  
  84         4420  
34 84     84   280 use constant EXCEPTION => 'Template::Exception';
  84         94  
  84         3320  
35 84     84   376 use constant BADGER_EXCEPTION => 'Badger::Exception';
  84         328  
  84         257512  
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 2962     2962 1 2761 my ($self, $name) = @_;
79 2962         2176 my ($prefix, $blocks, $defblocks, $provider, $template, $error);
80 0         0 my ($shortname, $blockname, $providers);
81              
82 2962 50       4288 $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 2962 100 66     20315 return $name
      100        
88             if (blessed($name) && $name->isa(DOCUMENT))
89             || ref($name) eq 'CODE';
90              
91 1645         1444 $shortname = $name;
92              
93 1645 100       2500 unless (ref $name) {
94            
95 430 50       660 $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 430 100       1035 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 239         212 foreach $blocks (@{ $self->{ BLKSTACK } }) {
  239         346  
105             return $template
106 144 100 66     631 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 220 50       560 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 220 100       525 $prefix = $1 if $shortname =~ s/^(\w+)://;
117             }
118            
119 220 100       387 if (defined $prefix) {
120 3   50     8 $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 1435 100 33     4736 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 1435         1306 $blockname = '';
135 1435         2367 while ($shortname) {
136             $self->debug("asking providers for [$shortname] [$blockname]")
137 1439 50       2246 if $self->{ DEBUG };
138              
139 1439         1755 foreach my $provider (@$providers) {
140 1439         3289 ($template, $error) = $provider->fetch($shortname, $prefix);
141 1439 100       3304 if ($error) {
    100          
142 47 100       117 if ($error == Template::Constants::STATUS_ERROR) {
143             # $template contains exception object
144 7 50 66     64 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 7         23 $self->throw( Template::Constants::ERROR_FILE, $template );
150             }
151             }
152             # DECLINE is ok, carry on
153             }
154             elsif (length $blockname) {
155             return $template
156 4 100       8 if $template = $template->blocks->{ $blockname };
157             }
158             else {
159 1388         3503 return $template;
160             }
161             }
162            
163 41 100 66     209 last if ref $shortname || ! $self->{ EXPOSE_BLOCKS };
164 5 100       26 $shortname =~ s{/([^/]+)$}{} || last;
165 4 50       12 $blockname = length $blockname ? "$1/$blockname" : $1;
166             }
167            
168 37         130 $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 1104 my ($self, $name, $args) = @_;
185 210         169 my ($provider, $plugin, $error);
186            
187             $self->debug("plugin($name, ", defined $args ? @$args : '[ ]', ')')
188 210 0       391 if $self->{ DEBUG };
    50          
189            
190             # request the named plugin from each of the LOAD_PLUGINS providers in turn
191 210         204 foreach my $provider (@{ $self->{ LOAD_PLUGINS } }) {
  210         345  
192 210         533 ($plugin, $error) = $provider->fetch($name, $args, $self);
193 210 100       1751 return $plugin unless $error;
194 6 100       17 if ($error == Template::Constants::STATUS_ERROR) {
195 3 50       13 $self->throw($plugin) if ref $plugin;
196 0         0 $self->throw(Template::Constants::ERROR_PLUGIN, $plugin);
197             }
198             }
199            
200 3         15 $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 1896 my ($self, $name, $args, $alias) = @_;
214 167         134 my ($provider, $filter, $error);
215            
216             $self->debug("filter($name, ",
217             defined $args ? @$args : '[ ]',
218             defined $alias ? $alias : '', ')')
219 167 0       340 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     936 && ($filter = $self->{ FILTER_CACHE }->{ $name });
      100        
225            
226             # request the named filter from each of the FILTERS providers in turn
227 156         152 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  156         243  
228 156         399 ($filter, $error) = $provider->fetch($name, $args, $self);
229 156 100       288 last unless $error;
230 9 50       20 if ($error == Template::Constants::STATUS_ERROR) {
231 9 100       43 $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 147 50       235 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       222 $self->{ FILTER_CACHE }->{ $alias } = $filter
255             if $alias;
256              
257 147         208 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 244 my $self = shift;
269 34         574 require Template::View;
270 34   66     111 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 1610     1610 1 2009 my ($self, $template, $params, $localize) = @_;
295 1610         2386 my ($trim, $blocks) = @$self{ qw( TRIM BLOCKS ) };
296 1610         1176 my (@compiled, $name, $compiled);
297 0         0 my ($stash, $component, $tblocks, $error, $tmpout);
298 1610         1456 my $output = '';
299            
300 1610 100       3532 $template = [ $template ] unless ref $template eq 'ARRAY';
301            
302             $self->debug("process([ ", join(', '), @$template, ' ], ',
303             defined $params ? $params : '', ', ',
304             $localize ? '' : '', ')')
305 1610 0       2583 if $self->{ DEBUG };
    0          
    50          
306            
307             # fetch compiled template for each name specified
308 1610         1583 foreach $name (@$template) {
309 1612         2478 push(@compiled, $self->template($name));
310             }
311              
312 1588 100       2028 if ($localize) {
313             # localise the variable stash with any parameters passed
314 265         665 $stash = $self->{ STASH } = $self->{ STASH }->clone($params);
315             } else {
316             # update stash with any new parameters passed
317 1323         3138 $self->{ STASH }->update($params);
318 1323         1409 $stash = $self->{ STASH };
319             }
320              
321 1588         1308 eval {
322             # save current component
323 1588         1133 eval { $component = $stash->get('component') };
  1588         13116  
324              
325 1588         1906 foreach $name (@$template) {
326 1590         1493 $compiled = shift @compiled;
327 1590 100       3106 my $element = ref $compiled eq 'CODE'
    100          
328             ? { (name => (ref $name ? '' : $name), modtime => time()) }
329             : $compiled;
330              
331 1590 100 66     4874 if (blessed($component) && $component->isa(DOCUMENT)) {
332 290         448 $element->{ caller } = $component->{ name };
333 290   100     941 $element->{ callers } = $component->{ callers } || [];
334 290         247 push(@{$element->{ callers }}, $element->{ caller });
  290         558  
335             }
336              
337 1590         7729 $stash->set('component', $element);
338            
339 1590 100       2429 unless ($localize) {
340             # merge any local blocks defined in the Template::Document
341             # into our local BLOCKS cache
342 1324 50 66     8060 @$blocks{ keys %$tblocks } = values %$tblocks
      66        
343             if (blessed($compiled) && $compiled->isa(DOCUMENT))
344             && ($tblocks = $compiled->blocks);
345             }
346            
347 1590 100       3342 if (ref $compiled eq 'CODE') {
    50          
348 218         2631 $tmpout = &$compiled($self);
349             }
350             elsif (ref $compiled) {
351 1372         2460 $tmpout = $compiled->process($self);
352             }
353             else {
354 0         0 $self->throw('file',
355             "invalid template reference: $compiled");
356             }
357            
358 1566 100       3790 if ($trim) {
359 116         122 for ($tmpout) {
360 116         204 s/^\s+//;
361 116         421 s/\s+$//;
362             }
363             }
364 1566         1783 $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 1566 100 66     5164 pop(@{$element->{ callers }})
  283         560  
374             if (blessed($component) && $component->isa(DOCUMENT));
375             }
376 1564         6785 $stash->set('component', $component);
377             };
378 1588         1433 $error = $@;
379            
380 1588 100       2277 if ($localize) {
381             # ensure stash is delocalised before dying
382 265         599 $self->{ STASH } = $self->{ STASH }->declone();
383             }
384            
385 1588 50       2160 $self->throw(ref $error
    100          
386             ? $error : (Template::Constants::ERROR_FILE, $error))
387             if $error;
388            
389 1564         4627 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 283     283 1 4002173 my ($self, $template, $params) = @_;
409 283         608 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 106 my ($self, $file) = @_;
420 15         13 my ($prefix, $providers, $text, $error);
421 15         16 my $output = '';
422              
423 15 100       37 my $files = ref $file eq 'ARRAY' ? $file : [ $file ];
424              
425             $self->debug("insert([ ", join(', '), @$files, " ])")
426 15 50       32 if $self->{ DEBUG };
427              
428              
429 15         23 FILE: foreach $file (@$files) {
430 17         15 my $name = $file;
431              
432 17 50       36 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       42 $prefix = $1 if $name =~ s/^(\w+)://;
438             }
439              
440 17 100       23 if (defined $prefix) {
441 1   50     3 $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     42 || $self->{ LOAD_TEMPLATES };
448             }
449              
450 17         19 foreach my $provider (@$providers) {
451 17         40 ($text, $error) = $provider->load($name, $prefix);
452 17 100       42 next FILE unless $error;
453 5 100       10 if ($error == Template::Constants::STATUS_ERROR) {
454 2 50       4 $self->throw($text) if ref $text;
455 2         4 $self->throw(Template::Constants::ERROR_FILE, $text);
456             }
457             }
458 3         10 $self->throw(Template::Constants::ERROR_FILE, "$file: not found");
459             }
460             continue {
461 12         30 $output .= $text;
462             }
463 10         22 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 142     142 1 591 my ($self, $error, $info, $output) = @_;
496 142         180 local $" = ', ';
497              
498             # die! die! die!
499 142 100 66     848 if (blessed($error) && $error->isa(EXCEPTION)) {
    50 33        
    100          
500 32         115 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 105         410 die (EXCEPTION->new($error, $info, $output));
509             }
510             else {
511 5   50     11 $error ||= '';
512 5         26 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 162     162 1 998 my ($self, $error, $output) = @_;
540              
541 162 100 33     998 if ( blessed($error)
      66        
542             && ( $error->isa(EXCEPTION) || $error->isa(BADGER_EXCEPTION) ) ) {
543 147 100       418 $error->text($output) if $output;
544 147         261 return $error;
545             }
546             else {
547 15         86 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 1251     1251 1 1438 my $self = shift;
567 1251         4120 $self->{ STASH } = $self->{ STASH }->clone(@_);
568             }
569              
570             sub delocalise {
571 1251     1251 1 1127 my $self = shift;
572 1251         2604 $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 1375     1375 1 1323 my ($self, $document, $blocks) = @_;
589 1375         1052 unshift(@{ $self->{ BLKSTACK } }, $blocks)
  1375         2667  
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 1373     1373 1 1249 my $self = shift;
605 1373         1033 shift(@{ $self->{ BLKSTACK } });
  1373         2021  
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 98 my ($self, $name, $filter, $is_dynamic) = @_;
637 7         9 my ($result, $error);
638 7 100       30 $filter = [ $filter, 1 ] if $is_dynamic;
639              
640 7         11 foreach my $provider (@{ $self->{ LOAD_FILTERS } }) {
  7         16  
641 7         27 ($result, $error) = $provider->store($name, $filter);
642 7 50       34 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 20 my $self = shift;
659 8         16 $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 2 my ($self, $name, $params) = @_;
671 2         3 my $base;
672              
673 2 100       5 if (defined $params->{ base }) {
674 1         9 my $base = $self->{ STASH }->get($params->{ base });
675              
676 1 50       2 return $self->throw(
677             &Template::Constants::ERROR_VIEW,
678             "view base is not defined: $params->{ base }"
679             ) unless $base;
680              
681 1 50 33     14 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         2 $params->{ base } = $base;
687             }
688 2         6 my $view = $self->view($params);
689 2         4 $view->seal();
690 2         32 $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         3 my @items = @$views;
712 1         1 my ($name, $view);
713            
714 1         3 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 1205     1205 1 1152 my ($self, $blocks) = @_;
730 1205         1562 $self->{ BLKSTACK } = [ ];
731 1205         1234 $self->{ BLOCKS } = { %{ $self->{ INIT_BLOCKS } } };
  1205         2797  
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 1595     1595 1 15681 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 93 my $self = shift;
760 15 100       21 my $hash = ref $_[-1] eq 'HASH' ? pop : { };
761 15         18 my @args = @_;
762              
763 15 50       21 if (@args) {
764 15 100       49 if ($args[0] =~ /^on|1$/i) {
    100          
765 3         4 $self->{ DEBUG_DIRS } = 1;
766 3         3 shift(@args);
767             }
768             elsif ($args[0] =~ /^off|0$/i) {
769 3         3 $self->{ DEBUG_DIRS } = 0;
770 3         3 shift(@args);
771             }
772             }
773              
774 15 100       23 if (@args) {
775 9 50       22 if ($args[0] =~ /^msg$/i) {
    0          
776 9 50       13 return unless $self->{ DEBUG_DIRS };
777 9         10 my $format = $self->{ DEBUG_FORMAT };
778 9 50       13 $format = $DEBUG_FORMAT unless defined $format;
779 9         27 $format =~ s/\$(\w+)/$hash->{ $1 }/ge;
  27         56  
780 9         25 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         9 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   131 my $self = shift;
803 26         33 my $method = $AUTOLOAD;
804 26         22 my $result;
805              
806 26         94 $method =~ s/.*:://;
807 26 50       58 return if $method eq 'DESTROY';
808              
809             warn "no such context method/member: $method\n"
810 26 50       77 unless defined ($result = $self->{ uc $method });
811              
812 26         82 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 142     142   3550 my $self = shift;
825 142         577 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 158     158   218 my ($self, $config) = @_;
842 158         158 my ($name, $item, $method, $block, $blocks);
843 158         381 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 158         515 while (($name, $method) = splice(@itemlut, 0, 2)) {
851 474   50     2082 $item = $config->{ $name }
852             || Template::Config->$method($config)
853             || return $self->error($Template::Config::ERROR);
854 474 100       2292 $self->{ $name } = ref $item eq 'ARRAY' ? $item : [ $item ];
855             }
856              
857 158         204 my $providers = $self->{ LOAD_TEMPLATES };
858 158   100     606 my $prefix_map = $self->{ PREFIX_MAP } = $config->{ PREFIX_MAP } || { };
859 158         516 while (my ($key, $val) = each %$prefix_map) {
860             $prefix_map->{ $key } = [ ref $val ? $val :
861 3 50       13 map { $providers->[$_] } split(/\D+/, $val) ]
  4 50       14  
862             unless ref $val eq 'ARRAY';
863             }
864              
865             # STASH
866 158   66     379 $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 158   100     680 $blocks = $config->{ BLOCKS } || { };
883             $self->{ INIT_BLOCKS } = $self->{ BLOCKS } = {
884             map {
885 158         506 $block = $blocks->{ $_ };
  52         78  
886 52 100 50     144 $block = $self->template(\$block)
887             || return undef
888             unless ref $block;
889 52         133 ($_ => $block);
890             }
891             keys %$blocks
892             };
893              
894             # define any VIEWS
895             $self->define_views( $config->{ VIEWS } )
896 158 100       340 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 158   100     578 $self->{ RECURSION } = $config->{ RECURSION } || 0;
909 158   100     498 $self->{ EVAL_PERL } = $config->{ EVAL_PERL } || 0;
910 158   100     499 $self->{ TRIM } = $config->{ TRIM } || 0;
911 158         238 $self->{ BLKSTACK } = [ ];
912 158         185 $self->{ CONFIG } = $config;
913             $self->{ EXPOSE_BLOCKS } = defined $config->{ EXPOSE_BLOCKS }
914             ? $config->{ EXPOSE_BLOCKS }
915 158 100       383 : 0;
916              
917 158         326 $self->{ DEBUG_FORMAT } = $config->{ DEBUG_FORMAT };
918 158   100     596 $self->{ DEBUG_DIRS } = ($config->{ DEBUG } || 0)
919             & Template::Constants::DEBUG_DIRS;
920             $self->{ DEBUG } = defined $config->{ DEBUG }
921 158 100       368 ? $config->{ DEBUG } & ( Template::Constants::DEBUG_CONTEXT
922             | Template::Constants::DEBUG_FLAGS )
923             : $DEBUG;
924              
925 158         1609 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__