File Coverage

blib/lib/Template/Nest.pm
Criterion Covered Total %
statement 207 210 98.5
branch 81 102 79.4
condition 27 36 75.0
subroutine 27 27 100.0
pod 13 15 86.6
total 355 390 91.0


line stmt bran cond sub pod time code
1             package Template::Nest;
2              
3 7     7   521845 use strict;
  7         74  
  7         220  
4 7     7   39 use warnings;
  7         13  
  7         185  
5 7     7   37 use File::Spec;
  7         11  
  7         137  
6 7     7   33 use Carp;
  7         13  
  7         380  
7 7     7   4817 use Data::Dumper;
  7         50946  
  7         19361  
8              
9             our $VERSION = '0.11';
10              
11             sub new{
12 8     8 1 863 my ($class,%opts) = @_;
13              
14              
15             # defaults:
16 8         106 my $self = {
17             comment_delims => [ '' ],
18             token_delims => [ '<%','%>' ],
19             name_label => 'NAME',
20             template_dir => '',
21             template_ext => '.html',
22             show_labels => 0,
23             defaults => {},
24             defaults_namespace_char => '.',
25             fixed_indent => 0,
26             die_on_bad_params => 1,
27             escape_char => "\\"
28             };
29              
30 8         20 bless $self,$class;
31              
32 8 100       33 if ( %opts ){
33 7         31 for my $k (keys %opts){
34 39 50       156 confess "$k is not a valid option" unless defined $self->can($k);
35 39         136 $self->$k( $opts{$k} );
36             }
37             }
38              
39 8         38 return $self;
40             }
41              
42              
43             sub template_dir{
44 87     87 1 2359 my($self,$dir) = @_;
45 87 50 66     247 confess "Expected a scalar directory name but got a ".ref($dir) if $dir && ref($dir);
46 87 100       232 $self->{template_dir} = $dir if $dir;
47 87         205 return $self->{template_dir};
48             }
49              
50              
51             sub template_hash{
52 4     4 0 906 my ($self,$template_hash) = @_;
53              
54 4 100       16 $self->{template_hash} = $template_hash if $template_hash;
55 4         15 return $self->{template_hash};
56             }
57              
58              
59             sub defaults{
60 7     7 1 3501 my ($self,$defaults) = @_;
61              
62 7 100       24 if ( $defaults ){
63              
64 5 50       27 confess "defaults should be a hashref" unless ref $defaults eq ref {};
65 5         18 $self->{defaults} = $defaults;
66              
67             }
68              
69 7         23 return $self->{defaults};
70             }
71              
72              
73             sub defaults_namespace_char{
74 30     30 1 1301 my ($self,$char) = @_;
75              
76 30 100       75 if ( defined $char ){
77 10 100       51 if ( $char eq '' ){
78 7         24 $self->{defaults_namespace_char} = '';
79             } else {
80 3 50       21 confess "defaults_namespace_char should be a single character or ''" unless $char =~ /./;
81 3         7 $self->{defaults_namespace_char} = $char;
82             }
83             }
84              
85 30         70 return $self->{defaults_namespace_char};
86             }
87              
88              
89             sub comment_delims{
90 3     3 1 5352 my ($self,$delim1,$delim2) = @_;
91 3 100       13 if (defined $delim1 ){
92 2   50     7 $delim2 = $delim2 || '';
93 2         7 $self->{'comment_delims'} = [ $delim1, $delim2 ];
94             }
95 3         12 return $self->{'comment_delims'};
96             }
97              
98              
99             sub token_delims{
100 45     45 1 5978 my ($self,$delim1,$delim2) = @_;
101              
102 45 100       121 if (defined $delim1 ){
103              
104 8 100       52 if ( ref $delim1 eq ref [] ){
105 7         28 ($delim1,$delim2) = @$delim1;
106             }
107              
108 8   50     39 $delim2 ||= '';
109 8         32 $self->{'token_delims'} = [ $delim1, $delim2 ];
110             }
111 45         89 return $self->{'token_delims'};
112             }
113              
114              
115              
116             sub show_labels{
117 78     78 1 533 my ($self,$show) = @_;
118 78 100 66     308 confess "Expected a boolean but got $show" if $show && ! ( $show == 0 || $show == 1 );
      100        
119 77 100       157 $self->{show_labels} = $show if defined $show;
120 77         250 return $self->{show_labels};
121             }
122              
123              
124             sub template_ext{
125 87     87 1 2331 my ($self,$ext) = @_;
126 87 50 66     253 confess "Expected a scalar extension name but got a ".ref($ext) if defined $ext && ref($ext);
127 87 100       167 $self->{template_ext} = $ext if defined $ext;
128 87         823 return $self->{template_ext};
129             }
130              
131              
132             sub name_label{
133 245     245 1 1819 my ($self,$label) = @_;
134 245 50 66     487 confess "Expected a scalar name label but got a ".ref($label) if defined $label && ref($label);
135 245 100       443 $self->{name_label} = $label if $label;
136 245         567 return $self->{name_label};
137             }
138              
139              
140             sub fixed_indent{
141 9     9 1 5010 my ($self,$indent) = @_;
142              
143 9 100       23 if ( defined $indent ){
144 7 100 100     245 confess "Expected 0 or 1 but got $indent" unless $indent == 0 or $indent == 1;
145 6         12 $self->{fixed_indent} = $indent;
146             }
147              
148 8         24 return $self->{fixed_indent};
149             }
150              
151              
152             sub die_on_bad_params{
153 8     8 1 1871 my ($self,$should_die) = @_;
154              
155 8 100       27 if ( defined $should_die ){
156 6 100 100     138 confess "Expected 0 or 1 but got $should_die" unless $should_die == 0 or $should_die == 1;
157 5         14 $self->{die_on_bad_params} = $should_die;
158             }
159              
160 7         21 return $self->{die_on_bad_params};
161             }
162              
163              
164              
165             sub escape_char{
166 7     7 1 902 my ($self,$char) = @_;
167              
168 7 100       18 if (defined $char){
169 5 50 66     38 confess "escape_char should be a single character or ''" unless $char eq '' or $char =~ /./;
170 5         12 $self->{escape_char} = $char;
171             }
172              
173 7         20 return $self->{escape_char};
174             }
175              
176              
177              
178             sub render{
179 134     134 1 5404 my ($self,$comp) = @_;
180              
181 134         193 my $html;
182 134 100       467 if ( ref($comp) =~ /array/i ){
    100          
183 14         38 $html = $self->_render_array( $comp );
184             } elsif( ref( $comp ) =~ /hash/i ){
185 77         291 $html = $self->_render_hash( $comp );
186             } else {
187 43         69 $html = $comp;
188             }
189              
190 128         372 return $html;
191             }
192              
193              
194              
195             sub _render_hash{
196 77     77   133 my ($self,$h) = @_;
197              
198 77 50       214 confess "Expected a hashref. Instead got a ".ref($h) unless ref($h) =~ /hash/i;
199              
200 77         159 my $template_name = $h->{ $self->name_label };
201              
202 77 50       161 confess 'Encountered hash with no name_label ("'.$self->name_label.'"): '.Dumper( $h ) unless $template_name;
203              
204 77         130 my $param = {};
205              
206 77         220 foreach my $k ( keys %$h ){
207 159 100       271 next if $k eq $self->name_label;
208 83         195 $param->{$k} = $self->render( $h->{$k} );
209             }
210              
211 75         169 my $template = $self->_get_template( $template_name );
212 75         226 my $html = $self->_fill_in( $template_name, $template, $param );
213              
214 72 100       180 if ( $self->show_labels ){
215              
216 8         15 my $ca = $self->{comment_delims}->[0];
217 8         13 my $cb = $self->{comment_delims}->[1];
218              
219 8         29 $html = "$ca BEGIN $template_name $cb\n$html\n$ca END $template_name $cb\n";
220             }
221              
222 72         229 return $html;
223              
224             }
225              
226              
227              
228              
229             sub _render_array{
230              
231 14     14   34 my ($self, $arr, $delim) = @_;
232 14 50       51 confess "Expected an array. Instead got a ".ref($arr) unless ref($arr) =~ /array/i;
233 14         26 my $html = '';
234 14         32 foreach my $comp (@$arr){
235 27 50 33     66 $html.= $delim if ($delim && $html);
236 27         77 $html.= $self->render( $comp );
237             }
238 13         30 return $html;
239              
240             }
241              
242              
243              
244             sub _get_template{
245 81     81   134 my ($self,$template_name) = @_;
246              
247 81         137 my $template = '';
248 81 100       160 if ( $self->{template_hash} ){
249 3         4 $template = $self->{template_hash}{$template_name};
250             } else {
251              
252 78         171 my $filename = File::Spec->catdir(
253             $self->template_dir,
254             $template_name.$self->template_ext
255             );
256              
257 78         173 my $fh;
258 78 50       3177 open $fh,'<',$filename or confess "Could not open file $filename: $!";
259              
260 78         264 my $text = '';
261 78         1268 while( my $line = <$fh> ){
262 335         2137 $template.=$line;
263             }
264              
265             }
266              
267 81         569 $template =~ s/\n$//;
268 81         241 return $template;
269             }
270              
271              
272              
273              
274             sub params{
275 6     6 0 2978 my ($self,$template_name) = @_;
276              
277 6         13 my $esc = $self->{escape_char};
278 6         23 my $template = $self->_get_template( $template_name );
279 6         37 my @frags = split( /\Q$esc$esc\E/, $template );
280 6         17 my $tda = $self->{token_delims}[0];
281 6         8 my $tdb = $self->{token_delims}[1];
282              
283 6         12 my %rem;
284 6         18 for my $i (0..$#frags){
285 6         72 my @f = $frags[$i] =~ m/(?
286 6         14 for my $f ( @f ){
287 14         37 $f =~ s/^\s*//;
288 14         59 $f =~ s/\s*$//;
289 14         39 $rem{$f} = 1;
290             }
291             }
292              
293 6         28 my @params = sort(keys %rem);
294 6         27 return \@params;
295             }
296              
297              
298              
299             sub _token_regex{
300 177     177   324 my ($self,$param_name) = @_;
301              
302 177         262 my $esc = $self->{escape_char};
303 177         282 my $tda = $self->{token_delims}[0];
304 177         249 my $tdb = $self->{token_delims}[1];
305              
306 177 100       350 $param_name = '.*?' unless defined $param_name;
307              
308 177         2298 my $token_regex = qr/\Q$tda\E\s+$param_name\s+\Q$tdb\E/;
309 177 50       432 if ( $esc ){
310 177         2034 $token_regex = qr/(?
311             }
312 177         507 return $token_regex;
313             }
314              
315              
316             sub _fill_in{
317 75     75   186 my ($self,$template_name,$template,$params) = @_;
318              
319 75         151 my $esc = $self->{escape_char};
320 75         149 my @frags;
321              
322 75 50       162 if ( $esc ){
323 75         410 @frags = split( /\Q$esc$esc\E/, $template );
324             } else {
325 0         0 @frags = ( $template );
326             }
327              
328 75         248 foreach my $param_name (keys %$params){
329              
330 79         145 my $param_val = $params->{$param_name};
331              
332 79         103 my $replaced = 0;
333              
334 79 100       159 if ( $self->{fixed_indent} ){ #if fixed_indent we need to add spaces during the replacement
335 10         22 for my $i (0..$#frags){
336 10         21 my $rx = $self->_token_regex( $param_name );
337 10         335 my @spaces_repl = $frags[$i] =~ m/([^\S\r\n]*)$rx/g;
338              
339 10         36 while(@spaces_repl){
340 10         20 my $sp = shift @spaces_repl;
341 10         14 my $repl = shift @spaces_repl;
342 10         17 my $param_out = $param_val;
343 10         42 $param_out =~ s/\n/\n$sp/g;
344              
345 10 50       21 if ( $esc ){
346 10 50       167 $replaced = 1 if $frags[$i] =~ s/(?
347             } else {
348 0 0       0 $replaced = 1 if $frags[$i] =~ s/\Q$repl\E/$param_out/;
349             }
350             }
351             }
352             } else {
353 69         181 for my $i (0..$#frags){
354 77         157 my $rx = $self->_token_regex( $param_name );
355 77 100       801 $replaced = 1 if $frags[$i] =~ s/$rx/$param_val/g;
356             }
357             }
358              
359 79 100 100     398 if ( $self->{die_on_bad_params} && $replaced == 0 ){
360 3         554 confess "Could not replace template param '$param_name': token does not exist in template '$template_name'";
361             }
362             }
363              
364 72         195 for my $i (0..$#frags){
365              
366 76 100       110 if ( %{$self->{defaults}} ){
  76         185  
367 18         44 my @rem = $self->_params_in( $frags[$i] );
368 18         47 my $char = $self->defaults_namespace_char;
369 18         36 for my $name ( @rem ){
370 14         28 my @parts = ( $name );
371 14 100       58 @parts = split( /\Q$char\E/, $name ) if $char;
372              
373 14         41 my $val = $self->_get_default_val( $self->{defaults}, @parts );
374 14         30 my $rx = $self->_token_regex( $name );
375 14         133 $frags[$i] =~ s/$rx/$val/g;
376             }
377             }
378              
379 76         173 my $rx = $self->_token_regex;
380 76         385 $frags[$i] =~ s/$rx//g;
381             }
382              
383 72 50       230 if ( $esc ){
384 72         158 for my $i (0..$#frags){
385 76         268 $frags[$i] =~ s/\Q$esc\E//gs;
386             }
387             }
388              
389 72 50       255 my $text = $esc? join($esc,@frags): $frags[0];
390 72         181 return $text;
391             }
392              
393              
394             sub _params_in{
395 18     18   44 my ( $self, $text ) = @_;
396              
397 18         25 my $esc = $self->{escape_char};
398 18         47 my $tda = $self->token_delims->[0];
399 18         36 my $tdb = $self->token_delims->[1];
400              
401 18         31 my @rem;
402 18 50       36 if ( $esc ){
403 18         147 @rem = $text =~ m/(?
404             } else {
405 0         0 @rem = $text =~ m/\Q$tda\E\s+(.*?)\s+\Q$tdb\E/g;
406             }
407              
408 18         34 my %rem;
409 18         34 for my $name (@rem){
410 14         31 $rem{$name} = 1
411             }
412              
413 18         61 return keys %rem;
414             }
415              
416              
417              
418             sub _get_default_val{
419 25     25   53 my ($self,$ref,@parts) = @_;
420              
421 25 100       48 if ( @parts == 1 ){
422 12   100     39 my $val = $ref->{$parts[0]} || '';
423 12         34 return $val;
424             } else {
425 13         23 my $ref_name = shift @parts;
426 13         20 my $new_ref = $ref->{ $ref_name };
427 13 100       32 return '' unless $new_ref;
428 11         24 return $self->_get_default_val( $new_ref, @parts );
429             }
430             }
431              
432              
433              
434             1;
435             __END__