File Coverage

lib/Template/View.pm
Criterion Covered Total %
statement 140 144 97.2
branch 92 120 76.6
condition 40 57 70.1
subroutine 13 14 92.8
pod 3 9 33.3
total 288 344 83.7


line stmt bran cond sub pod time code
1             #============================================================= -*-Perl-*-
2             #
3             # Template::View
4             #
5             # DESCRIPTION
6             # A custom view of a template processing context. Can be used to
7             # implement custom "skins".
8             #
9             # AUTHOR
10             # Andy Wardley
11             #
12             # COPYRIGHT
13             # Copyright (C) 2000 Andy Wardley. All Rights Reserved.
14             #
15             # This module is free software; you can redistribute it and/or
16             # modify it under the same terms as Perl itself.
17             #
18             # TODO
19             # * allowing print to have a hash ref as final args will cause problems
20             # if you do this: [% view.print(hash1, hash2, hash3) %]. Current
21             # work-around is to do [% view.print(hash1); view.print(hash2);
22             # view.print(hash3) %] or [% view.print(hash1, hash2, hash3, { }) %]
23             #
24             #============================================================================
25              
26             package Template::View;
27              
28 2     2   600 use strict;
  2         3  
  2         77  
29 2     2   11 use warnings;
  2         3  
  2         66  
30 2     2   10 use base 'Template::Base';
  2         7  
  2         5002  
31              
32             our $VERSION = 2.91;
33             our $DEBUG = 0 unless defined $DEBUG;
34             our @BASEARGS = qw( context );
35             our $AUTOLOAD;
36             our $MAP = {
37             HASH => 'hash',
38             ARRAY => 'list',
39             TEXT => 'text',
40             default => '',
41             };
42              
43              
44             #------------------------------------------------------------------------
45             # _init(\%config)
46             #
47             # Initialisation method called by the Template::Base class new()
48             # constructor. $self->{ context } has already been set, by virtue of
49             # being named in @BASEARGS. Remaining config arguments are presented
50             # as a hash reference.
51             #------------------------------------------------------------------------
52              
53             sub _init {
54 65     65   134 my ($self, $config) = @_;
55              
56             # move 'context' somewhere more private
57 65         189 $self->{ _CONTEXT } = $self->{ context };
58 65         159 delete $self->{ context };
59            
60             # generate table mapping object types to templates
61 65   100     328 my $map = $config->{ map } || { };
62 65 100       305 $map->{ default } = $config->{ default } unless defined $map->{ default };
63             $self->{ map } = {
64 65         557 %$MAP,
65             %$map,
66             };
67              
68             # local BLOCKs definition table
69 65   100     350 $self->{ _BLOCKS } = $config->{ blocks } || { };
70            
71             # name of presentation method which printed objects might provide
72             $self->{ method } = defined $config->{ method }
73 65 50       251 ? $config->{ method } : 'present';
74            
75             # view is sealed by default preventing variable update after
76             # definition, however we don't actually seal a view until the
77             # END of the view definition
78 65         117 my $sealed = $config->{ sealed };
79 65 100       199 $sealed = 1 unless defined $sealed;
80 65 100       237 $self->{ sealed } = $sealed ? 1 : 0;
81              
82             # copy remaining config items from $config or set defaults
83 65         148 foreach my $arg (qw( base prefix suffix notfound silent )) {
84 325   100     1466 $self->{ $arg } = $config->{ $arg } || '';
85             }
86              
87             # check that any base specified is defined
88             return $self->error('Invalid base specified for view')
89 65 100 100     308 if exists $config->{ base } && ! $self->{ base };
90              
91             # name of data item used by view()
92 64   100     341 $self->{ item } = $config->{ item } || 'item';
93              
94             # map methods of form ${include_prefix}_foobar() to include('foobar')?
95 64   50     294 $self->{ include_prefix } = $config->{ include_prefix } || 'include_';
96             # what about mapping foobar() to include('foobar')?
97             $self->{ include_naked } = defined $config->{ include_naked }
98 64 100       252 ? $config->{ include_naked } : 1;
99              
100             # map methods of form ${view_prefix}_foobar() to include('foobar')?
101 64   50     358 $self->{ view_prefix } = $config->{ view_prefix } || 'view_';
102             # what about mapping foobar() to view('foobar')?
103 64   100     327 $self->{ view_naked } = $config->{ view_naked } || 0;
104              
105             # the view is initially unsealed, allowing directives in the initial
106             # view template to create data items via the AUTOLOAD; once sealed via
107             # call to seal(), the AUTOLOAD will not update any internal items.
108 64         278 delete @$config{ qw( base method map default prefix suffix notfound item
109             include_prefix include_naked silent sealed
110             view_prefix view_naked blocks ) };
111 6         20 $config = { %{ $self->{ base }->{ data } }, %$config }
112 64 100       222 if $self->{ base };
113 64         110 $self->{ data } = $config;
114 64         155 $self->{ SEALED } = 0;
115              
116 64         497 return $self;
117             }
118              
119              
120             #------------------------------------------------------------------------
121             # seal()
122             # unseal()
123             #
124             # Seal or unseal the view to allow/prevent new data items from being
125             # automatically created by the AUTOLOAD method.
126             #------------------------------------------------------------------------
127              
128             sub seal {
129 62     62 0 702 my $self = shift;
130 62         247 $self->{ SEALED } = $self->{ sealed };
131             }
132              
133             sub unseal {
134 0     0 0 0 my $self = shift;
135 0         0 $self->{ SEALED } = 0;
136             }
137              
138              
139             #------------------------------------------------------------------------
140             # clone(\%config)
141             #
142             # Cloning method which takes a copy of $self and then applies to it any
143             # modifications specified in the $config hash passed as an argument.
144             # Configuration items may also be specified as a list of "name => $value"
145             # arguments. Returns a reference to the cloned Template::View object.
146             #
147             # NOTE: may need to copy BLOCKS???
148             #------------------------------------------------------------------------
149              
150             sub clone {
151 13     13 0 85 my $self = shift;
152 13         180 my $clone = bless { %$self }, ref $self;
153 13 50       58 my $config = ref $_[0] eq 'HASH' ? shift : { @_ };
154              
155             # merge maps
156             $clone->{ map } = {
157 13         47 %{ $self->{ map } },
158 13 50       23 %{ $config->{ map } || { } },
  13         100  
159             };
160              
161             # "map => { default=>'xxx' }" can be specified as "default => 'xxx'"
162             $clone->{ map }->{ default } = $config->{ default }
163 13 100       57 if defined $config->{ default };
164              
165             # update any remaining config items
166 13         52 my @args = qw( base prefix suffix notfound item method include_prefix
167             include_naked view_prefix view_naked );
168 13         29 foreach my $arg (@args) {
169 130 100       279 $clone->{ $arg } = $config->{ $arg } if defined $config->{ $arg };
170             }
171 13         30 push(@args, qw( default map ));
172 13         47 delete @$config{ @args };
173              
174             # anything left is data
175 13         23 my $data = $clone->{ data } = { %{ $self->{ data } } };
  13         53  
176 13         39 @$data{ keys %$config } = values %$config;
177              
178 13         127 return $clone;
179             }
180              
181              
182             #------------------------------------------------------------------------
183             # print(@items, ..., \%config)
184             #
185             # Prints @items in turn by mapping each to an appropriate template using
186             # the internal 'map' hash. If an entry isn't found and the item is an
187             # object that implements the method named in the internal 'method' item,
188             # (default: 'present'), then the method will be called passing a reference
189             # to $self, against which the presenter method may make callbacks (e.g.
190             # to view_item()). If the presenter method isn't implemented, then the
191             # 'default' map entry is consulted and used if defined. The final argument
192             # may be a reference to a hash array providing local overrides to the internal
193             # defaults for various items (prefix, suffix, etc). In the presence
194             # of this parameter, a clone of the current object is first made, applying
195             # any configuration updates, and control is then delegated to it.
196             #------------------------------------------------------------------------
197              
198             sub print {
199 43     43 1 514 my $self = shift;
200              
201             # if final config hash is specified then create a clone and delegate to it
202             # NOTE: potential problem when called print(\%data_hash1, \%data_hash2);
203 43 100 66     174 if ((scalar @_ > 1) && (ref $_[-1] eq 'HASH')) {
204 5         12 my $cfg = pop @_;
205 5   50     17 my $clone = $self->clone($cfg)
206             || return;
207 5   33     17 return $clone->print(@_)
208             || $self->error($clone->error());
209             }
210 38         61 my ($item, $type, $template, $present);
211 38         70 my $method = $self->{ method };
212 38         67 my $map = $self->{ map };
213 38         54 my $output = '';
214            
215             # print each argument
216 38         68 foreach $item (@_) {
217 38         51 my $newtype;
218            
219 38 100       168 if (! ($type = ref $item)) {
    100          
220             # non-references are TEXT
221 9         18 $type = 'TEXT';
222 9         18 $template = $map->{ $type };
223             }
224             elsif (! defined ($template = $map->{ $type })) {
225             # no specific map entry for object, maybe it implements a
226             # 'present' (or other) method?
227 18 100 66     244 if ( $method && UNIVERSAL::can($item, $method) ) {
    50 33        
    50 33        
    100 33        
228 3         18 $present = $item->$method($self); ## call item method
229             # undef returned indicates error, note that we expect
230             # $item to have called error() on the view
231 3 50       92 return unless defined $present;
232 3         11 $output .= $present;
233 3         13 next; ## NEXT
234             }
235             elsif ( ref($item) eq 'HASH'
236             && defined($newtype = $item->{$method})
237             && defined($template = $map->{"$method=>$newtype"})) {
238             }
239             elsif ( defined($newtype)
240             && defined($template = $map->{"$method=>*"}) ) {
241 0         0 $template =~ s/\*/$newtype/;
242             }
243             elsif (! ($template = $map->{ default }) ) {
244             # default not defined, so construct template name from type
245 7         39 ($template = $type) =~ s/\W+/_/g;
246             }
247             }
248             # else {
249             # $self->DEBUG("defined map type for $type: $template\n");
250             # }
251 35 50 0     87 $self->DEBUG("printing view '", $template || '', "', $item\n") if $DEBUG;
252 35 50       137 $output .= $self->view($template, $item)
253             if $template;
254             }
255 37         218 return $output;
256             }
257              
258              
259             #------------------------------------------------------------------------
260             # view($template, $item, \%vars)
261             #
262             # Wrapper around include() which expects a template name, $template,
263             # followed by a data item, $item, and optionally, a further hash array
264             # of template variables. The $item is added as an entry to the $vars
265             # hash (which is created empty if not passed as an argument) under the
266             # name specified by the internal 'item' member, which is appropriately
267             # 'item' by default. Thus an external object present() method can
268             # callback against this object method, simply passing a data item to
269             # be displayed. The external object doesn't have to know what the
270             # view expects the item to be called in the $vars hash.
271             #------------------------------------------------------------------------
272              
273             sub view {
274 54     54 1 186 my ($self, $template, $item) = splice(@_, 0, 3);
275 54 50       190 my $vars = ref $_[0] eq 'HASH' ? shift : { @_ };
276 54 100       236 $vars->{ $self->{ item } } = $item if defined $item;
277 54         149 $self->include($template, $vars);
278             }
279              
280              
281             #------------------------------------------------------------------------
282             # include($template, \%vars)
283             #
284             # INCLUDE a template, $template, mapped according to the current prefix,
285             # suffix, default, etc., where $vars is an optional hash reference
286             # containing template variable definitions. If the template isn't found
287             # then the method will default to any 'notfound' template, if defined
288             # as an internal item.
289             #------------------------------------------------------------------------
290              
291             sub include {
292 85     85 0 178 my ($self, $template, $vars) = @_;
293 85         151 my $context = $self->{ _CONTEXT };
294              
295 85         210 $template = $self->template($template);
296              
297 84 100       225 $vars = { } unless ref $vars eq 'HASH';
298 84   33     368 $vars->{ view } ||= $self;
299              
300 84         300 $context->include( $template, $vars );
301              
302             # DEBUGGING
303             # my $out = $context->include( $template, $vars );
304             # print STDERR "VIEW return [$out]\n";
305             # return $out;
306             }
307              
308              
309             #------------------------------------------------------------------------
310             # template($template)
311             #
312             # Returns a compiled template for the specified template name, according
313             # to the current configuration parameters.
314             #------------------------------------------------------------------------
315              
316             sub template {
317 92     92 0 150 my ($self, $name) = @_;
318 92         147 my $context = $self->{ _CONTEXT };
319 92 50       192 return $context->throw(Template::Constants::ERROR_VIEW,
320             "no view template specified")
321             unless $name;
322              
323 92         158 my $notfound = $self->{ notfound };
324 92         136 my $base = $self->{ base };
325 92         115 my ($template, $block, $error);
326              
327             return $block
328 92 100       291 if ($block = $self->{ _BLOCKS }->{ $name });
329            
330             # try the named template
331 56         165 $template = $self->template_name($name);
332 56 50       136 $self->DEBUG("looking for $template\n") if $DEBUG;
333 56         63 eval { $template = $context->template($template) };
  56         183  
334              
335             # try asking the base view if not found
336 56 100 100     272 if (($error = $@) && $base) {
337 6 50       15 $self->DEBUG("asking base for $name\n") if $DEBUG;
338 6         10 eval { $template = $base->template($name) };
  6         23  
339             }
340              
341             # try the 'notfound' template (if defined) if that failed
342 56 100 100     230 if (($error = $@) && $notfound) {
    100          
343 5 100       22 unless ($template = $self->{ _BLOCKS }->{ $notfound }) {
344 4         11 $notfound = $self->template_name($notfound);
345 4 50       10 $self->DEBUG("not found, looking for $notfound\n") if $DEBUG;
346 4         7 eval { $template = $context->template($notfound) };
  4         11  
347              
348 4 50       11 return $context->throw(Template::Constants::ERROR_VIEW, $error)
349             if $@; # return first error
350             }
351             }
352             elsif ($error) {
353 1 50       4 $self->DEBUG("no 'notfound'\n")
354             if $DEBUG;
355 1         4 return $context->throw(Template::Constants::ERROR_VIEW, $error);
356             }
357 55         177 return $template;
358             }
359              
360            
361             #------------------------------------------------------------------------
362             # template_name($template)
363             #
364             # Returns the name of the specified template with any appropriate prefix
365             # and/or suffix added.
366             #------------------------------------------------------------------------
367              
368             sub template_name {
369 62     62 0 150 my ($self, $template) = @_;
370             $template = $self->{ prefix } . $template . $self->{ suffix }
371 62 50       224 if $template;
372              
373 62 50       168 $self->DEBUG("template name: $template\n") if $DEBUG;
374 62         145 return $template;
375             }
376              
377              
378             #------------------------------------------------------------------------
379             # default($val)
380             #
381             # Special case accessor to retrieve/update 'default' as an alias for
382             # '$map->{ default }'.
383             #------------------------------------------------------------------------
384              
385             sub default {
386 7     7 1 82 my $self = shift;
387             return @_ ? ($self->{ map }->{ default } = shift)
388 7 100       36 : $self->{ map }->{ default };
389             }
390              
391              
392             #------------------------------------------------------------------------
393             # AUTOLOAD
394             #
395              
396             # Returns/updates public internal data items (i.e. not prefixed '_' or
397             # '.') or presents a view if the method matches the view_prefix item,
398             # e.g. view_foo(...) => view('foo', ...). Similarly, the
399             # include_prefix is used, if defined, to map include_foo(...) to
400             # include('foo', ...). If that fails then the entire method name will
401             # be used as the name of a template to include iff the include_named
402             # parameter is set (default: 1). Last attempt is to match the entire
403             # method name to a view() call, iff view_naked is set. Otherwise, a
404             # 'view' exception is raised reporting the error "no such view member:
405             # $method".
406             #------------------------------------------------------------------------
407              
408             sub AUTOLOAD {
409 119     119   2266 my $self = shift;
410 119         244 my $item = $AUTOLOAD;
411 119         490 $item =~ s/.*:://;
412 119 50       307 return if $item eq 'DESTROY';
413              
414 119 50 100     1047 if ($item =~ /^[\._]/) {
    100          
    100          
    100          
    100          
    100          
    100          
    100          
415 0         0 return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW,
416             "attempt to view private member: $item");
417             }
418             elsif (exists $self->{ $item }) {
419             # update existing config item (e.g. 'prefix') if unsealed
420             return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW,
421             "cannot update config item in sealed view: $item")
422 19 100 100     76 if @_ && $self->{ SEALED };
423 18 50       49 $self->DEBUG("accessing item: $item\n") if $DEBUG;
424 18 100       155 return @_ ? ($self->{ $item } = shift) : $self->{ $item };
425             }
426             elsif (exists $self->{ data }->{ $item }) {
427             # get/update existing data item (must be unsealed to update)
428 48 100 100     140 if (@_ && $self->{ SEALED }) {
429             return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW,
430             "cannot update item in sealed view: $item")
431 3 100       14 unless $self->{ silent };
432             # ignore args if silent
433 2         5 @_ = ();
434             }
435 47 0       88 $self->DEBUG(@_ ? "updating data item: $item <= $_[0]\n"
    50          
436             : "returning data item: $item\n") if $DEBUG;
437             return @_ ? ($self->{ data }->{ $item } = shift)
438 47 100       306 : $self->{ data }->{ $item };
439             }
440             elsif (@_ && ! $self->{ SEALED }) {
441             # set data item if unsealed
442 6 50       19 $self->DEBUG("setting unsealed data: $item => @_\n") if $DEBUG;
443 6         30 $self->{ data }->{ $item } = shift;
444             }
445             elsif ($item =~ s/^$self->{ view_prefix }//) {
446 15 50       42 $self->DEBUG("returning view($item)\n") if $DEBUG;
447 15         53 return $self->view($item, @_);
448             }
449             elsif ($item =~ s/^$self->{ include_prefix }//) {
450 3 50       12 $self->DEBUG("returning include($item)\n") if $DEBUG;
451 3         15 return $self->include($item, @_);
452             }
453             elsif ($self->{ include_naked }) {
454 26 50       62 $self->DEBUG("returning naked include($item)\n") if $DEBUG;
455 26         75 return $self->include($item, @_);
456             }
457             elsif ($self->{ view_naked }) {
458 1 50       4 $self->DEBUG("returning naked view($item)\n") if $DEBUG;
459 1         4 return $self->view($item, @_);
460             }
461             else {
462 1         10 return $self->{ _CONTEXT }->throw(Template::Constants::ERROR_VIEW,
463             "no such view member: $item");
464             }
465             }
466              
467              
468             1;
469              
470              
471             __END__