File Coverage

blib/lib/Template/Nest.pm
Criterion Covered Total %
statement 195 201 97.0
branch 83 108 76.8
condition 24 33 72.7
subroutine 25 25 100.0
pod 13 15 86.6
total 340 382 89.0


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