File Coverage

blib/lib/HTML/Template/Pluggable.pm
Criterion Covered Total %
statement 53 54 98.1
branch 20 32 62.5
condition 13 27 48.1
subroutine 8 8 100.0
pod 2 2 100.0
total 96 123 78.0


line stmt bran cond sub pod time code
1             package HTML::Template::Pluggable;
2 13     13   305925 use base 'HTML::Template';
  13         59  
  13         12340  
3 13     13   164666 use Class::Trigger;
  13         15275  
  13         73  
4 13     13   653 use vars (qw/$VERSION/);
  13         26  
  13         530  
5             $VERSION = '0.22';
6 13     13   68 use warnings;
  13         22  
  13         415  
7 13     13   66 use strict;
  13         22  
  13         256  
8 13     13   72 use Carp;
  13         29  
  13         6754  
9              
10             =head1 NAME
11              
12             HTML::Template::Pluggable - Extends HTML::Template with plugin support
13              
14             =cut
15              
16             =head1 SYNOPSIS
17              
18             Just use this module instead of HTML::Template, then use any plugins,
19             and go on with life.
20              
21             use HTML::Template::Pluggable;
22             use HTML::Template::Plugin::Dot;
23              
24             # Everything works the same, except for functionality that plugins add.
25             my $t = HTML::Template::Pluggable->new();
26              
27             =head1 THE GOAL
28              
29             Ideally we'd like to see this functionality merged into HTML::Template,
30             and turn this into a null sub-class.
31              
32             =head1 STATUS
33              
34             The design of the plugin system is still in progress. Right now we have just
35             two triggers, in param and output. The name and function of this may change,
36             and we would like to add triggers in new() and other methods when the need
37             arises.
38              
39             All we promise for now is to keep L compatible.
40             Please get in touch if you have suggestions with feedback on designing the
41             plugin system if you would like to contribute.
42              
43             =cut
44              
45             sub param {
46 138     138 1 103944 my $self = shift;
47 138         190 my $options = $self->{options};
48 138         170 my $param_map = $self->{param_map};
49              
50             # the no-parameter case - return list of parameters in the template.
51 138 50       272 return keys(%$param_map) unless scalar(@_);
52            
53 138         171 my $first = shift;
54 138         187 my $type = ref $first;
55              
56             # the one-parameter case - could be a parameter value request or a
57             # hash-ref.
58 138 100 100     302 if (!scalar(@_) and !length($type)) {
59 4 50       27 my $param = $options->{case_sensitive} ? $first : lc $first;
60            
61             # check for parameter existence
62 4 50 33     19 $options->{die_on_bad_params} and !exists($param_map->{$param}) and
63             croak("HTML::Template : Attempt to get nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params set => 1)");
64            
65             return undef unless (exists($param_map->{$param}) and
66 4 50 33     16 defined($param_map->{$param}));
67              
68 4         16 return ${$param_map->{$param}} if
69 4 50       27 (ref($param_map->{$param}) eq 'HTML::Template::VAR');
70 0         0 return $param_map->{$param}[HTML::Template::LOOP::PARAM_SET];
71             }
72              
73 134 100       233 if (!scalar(@_)) {
74 58 0 0     86 croak("HTML::Template->param() : Single reference arg to param() must be a hash-ref! You gave me a $type.")
      33        
75             unless $type eq 'HASH' or
76             (ref($first) and UNIVERSAL::isa($first, 'HASH'));
77 58         128 push(@_, %$first);
78             } else {
79 76         148 unshift(@_, $first);
80             }
81            
82 134 50       285 croak("HTML::Template->param() : You gave me an odd number of parameters to param()!")
83             unless ((@_ % 2) == 0);
84              
85 134         377 $self->call_trigger('middle_param', @_);
86              
87             # strangely, changing this to a "while(@_) { shift, shift }" type
88             # loop causes perl 5.004_04 to die with some nonsense about a
89             # read-only value.
90 128         1259 for (my $x = 0; $x <= $#_; $x += 2) {
91 134 50       288 my $param = $options->{case_sensitive} ? $_[$x] : lc $_[$x];
92 134         198 my $value = $_[($x + 1)];
93              
94             # necessary to cooperate with plugin system
95 134 100       561 next if $self->{param_map_done}{$param};
96            
97             # check that this param exists in the template
98 19 100 66     264 $options->{die_on_bad_params} and !exists($param_map->{$param}) and
99             croak("HTML::Template : Attempt to set nonexistent parameter '$param' - this parameter name doesn't match any declarations in the template file : (die_on_bad_params => 1)");
100            
101             # if we're not going to die from bad param names, we need to ignore
102             # them...
103 17 50       35 next unless (exists($param_map->{$param}));
104            
105             # figure out what we've got, taking special care to allow for
106             # objects that are compatible underneath.
107 17         52 my $value_type = ref($value);
108 17 100 66     87 if (defined($value_type) and length($value_type) and ($value_type eq 'ARRAY' or ((ref($value) !~ /^(CODE)|(HASH)|(SCALAR)$/) and $value->isa('ARRAY')))) {
      33        
      66        
109 2 50       9 (ref($param_map->{$param}) eq 'HTML::Template::LOOP') or
110             croak("HTML::Template::param() : attempt to set parameter '$param' with an array ref - parameter is not a TMPL_LOOP!");
111 2         2 $param_map->{$param}[HTML::Template::LOOP::PARAM_SET] = [@{$value}];
  2         27  
112             } else {
113 15 50       37 (ref($param_map->{$param}) eq 'HTML::Template::VAR') or
114             croak("HTML::Template::param() : attempt to set parameter '$param' with a scalar - parameter is not a TMPL_VAR!");
115 15         23 ${$param_map->{$param}} = $value;
  15         82  
116             }
117             }
118             }
119              
120              
121             sub output
122             {
123 115     115 1 1901 my $self = shift;
124 115         252 $self->call_trigger('before_output', @_);
125              
126 115         4055 $self->SUPER::output(@_);
127             }
128              
129              
130             =head1 WRITING PLUGINS
131              
132             HTML::Template offers a plugin system which allows developers to extend the
133             functionality in significant ways without creating a creating a sub-class,
134             which might be impossible to use in combination with another sub-class
135             extension.
136              
137             Currently, two triggers have been made available to alter how the values of
138             TMPL_VARs are set. If more hooks are needed to implement your own plugin idea,
139             it may be feasible to add them-- check the FAQ then ask about it on the list.
140              
141             L is used to provide plugins. Basically, you can just:
142              
143             HTML::Template->add_trigger('middle_param', \&trigger);
144              
145             A good place to add one is in your plugin's C subroutine:
146              
147             package HTML::Template::Plugin::MyPlugin;
148             use base 'Exporter';
149             sub import {
150             HTML::Template->add_trigger('middle_param', \&dot_notation);
151             goto &Exporter::import;
152             }
153              
154             =head2 TRIGGER LOCATIONS
155              
156             =over 4
157              
158             =item param
159              
160             We have added one trigger location to this method, named C.
161              
162             # in a Plugin's import() routine.
163             HTML::Template->add_trigger('middle_param', \&_set_tmpl_var_with_dot );
164              
165             This sets a callback which is executed in param() with all of the same
166             arguments. It is only useful for altering how /setting/ params works.
167             The logic to read a param is unaffected.
168              
169             It can set any TMPL_VAR values before the normal param logic kicks in. To do
170             this, C<$self-E{param_map}> is modified as can be seen from source in
171             HTML::Template::param(). However, it must obey the following convention of
172             setting $self->{param_map_done}{$param_name} for each param that is set.
173             C<$param_name> would be a key from C<$self-E{param_map}>. This notifies the
174             other plugins and the core param() routine to skip trying to set this value.
175             $self->{param_map_done} is reset with each call to param(), so that like with a
176             hash, you have the option to reset a param later with the same name.
177              
178             =item output
179              
180             One trigger location here: C.
181              
182             HTML::Template->add_trigger('before_output', \&_last_chance_params );
183              
184             This sets a callback which is executed right before output is generated.
185              
186             =back
187              
188             =head1 SEE ALSO
189              
190             =over 4
191              
192             =item o
193              
194             L - Add Template Toolkit's magic dot notation to
195             HTML::Template.
196              
197             =back
198              
199             =head1 AUTHOR
200              
201             Mark Stosberg, C<< >>
202              
203             =head1 BUGS
204              
205             Please report any bugs or feature requests to
206             C, or through the web interface at
207             L. I will be notified, and then you'll automatically
208             be notified of progress on your bug as I make changes.
209              
210             =head1 Copyright & License
211              
212             Copyright 2006 Mark Stosberg, All Rights Reserved.
213              
214             This program is free software; you can redistribute it and/or modify it
215             under the same terms as Perl itself.
216              
217             =cut
218              
219             1; # End of HTML::Template::Pluggable