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