| line | stmt | bran | cond | sub | pod | time | code | 
| 1 |  |  |  |  |  |  | package HTML::Template::Nest; | 
| 2 |  |  |  |  |  |  |  | 
| 3 | 2 |  |  | 2 |  | 111606 | use strict; | 
|  | 2 |  |  |  |  | 12 |  | 
|  | 2 |  |  |  |  | 47 |  | 
| 4 | 2 |  |  | 2 |  | 7 | use warnings; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 38 |  | 
| 5 | 2 |  |  | 2 |  | 7 | use File::Spec; | 
|  | 2 |  |  |  |  | 3 |  | 
|  | 2 |  |  |  |  | 29 |  | 
| 6 | 2 |  |  | 2 |  | 13 | use Carp; | 
|  | 2 |  |  |  |  | 4 |  | 
|  | 2 |  |  |  |  | 126 |  | 
| 7 | 2 |  |  | 2 |  | 975 | use Data::Dumper; | 
|  | 2 |  |  |  |  | 10797 |  | 
|  | 2 |  |  |  |  | 92 |  | 
| 8 | 2 |  |  | 2 |  | 1677 | use HTML::Template; | 
|  | 2 |  |  |  |  | 22023 |  | 
|  | 2 |  |  |  |  | 1400 |  | 
| 9 |  |  |  |  |  |  |  | 
| 10 |  |  |  |  |  |  |  | 
| 11 |  |  |  |  |  |  | our $VERSION = '0.04'; | 
| 12 |  |  |  |  |  |  |  | 
| 13 |  |  |  |  |  |  | sub new{ | 
| 14 | 2 |  |  | 2 | 1 | 197 | my ($class,%opts) = @_; | 
| 15 | 2 |  |  |  |  | 7 | my $self = {%opts}; | 
| 16 |  |  |  |  |  |  |  | 
| 17 |  |  |  |  |  |  | #defaults | 
| 18 | 2 | 50 |  |  |  | 11 | $self->{comment_tokens} = [ '' ] unless $self->{comment_tokens}; | 
| 19 | 2 | 100 |  |  |  | 9 | $self->{name_label} = 'NAME' unless $self->{name_label}; | 
| 20 | 2 | 100 |  |  |  | 7 | $self->{template_dir} = '' unless defined $self->{template_dir}; | 
| 21 | 2 | 100 |  |  |  | 7 | $self->{template_ext} = '.html' unless defined $self->{template_ext}; | 
| 22 | 2 | 50 |  |  |  | 7 | $self->{show_labels} = 0 unless defined $self->{show_labels}; | 
| 23 |  |  |  |  |  |  |  | 
| 24 | 2 |  |  |  |  | 4 | bless $self,$class; | 
| 25 | 2 |  |  |  |  | 6 | return $self; | 
| 26 |  |  |  |  |  |  | } | 
| 27 |  |  |  |  |  |  |  | 
| 28 |  |  |  |  |  |  |  | 
| 29 |  |  |  |  |  |  | sub template_dir{ | 
| 30 | 12 |  |  | 12 | 1 | 1701 | my($self,$dir) = @_; | 
| 31 | 12 | 50 | 66 |  |  | 30 | confess "Expected a scalar directory name but got a ".ref($dir) if $dir && ref($dir); | 
| 32 | 12 | 100 |  |  |  | 26 | $self->{template_dir} = $dir if $dir; | 
| 33 | 12 |  |  |  |  | 22 | return $self->{template_dir}; | 
| 34 |  |  |  |  |  |  | } | 
| 35 |  |  |  |  |  |  |  | 
| 36 |  |  |  |  |  |  |  | 
| 37 |  |  |  |  |  |  | sub comment_tokens{ | 
| 38 | 3 |  |  | 3 | 1 | 4022 | my ($self,$token1,$token2) = @_; | 
| 39 | 3 | 100 |  |  |  | 12 | if (defined $token1 ){ | 
| 40 | 2 |  | 50 |  |  | 6 | $token2 = $token2 || ''; | 
| 41 | 2 |  |  |  |  | 20 | $self->{'comment_tokens'} = [ $token1, $token2 ]; | 
| 42 |  |  |  |  |  |  | } | 
| 43 | 3 |  |  |  |  | 11 | return $self->{'comment_tokens'}; | 
| 44 |  |  |  |  |  |  |  | 
| 45 |  |  |  |  |  |  | } | 
| 46 |  |  |  |  |  |  |  | 
| 47 |  |  |  |  |  |  |  | 
| 48 |  |  |  |  |  |  |  | 
| 49 |  |  |  |  |  |  |  | 
| 50 |  |  |  |  |  |  | sub show_labels{ | 
| 51 | 13 |  |  | 13 | 1 | 2697 | my ($self,$show) = @_; | 
| 52 | 13 | 50 | 33 |  |  | 38 | confess "Expected a boolean but got $show" if $show && ! ( $show == 0 || $show == 1 ); | 
|  |  |  | 66 |  |  |  |  | 
| 53 | 13 | 100 |  |  |  | 28 | $self->{show_labels} = $show if $show; | 
| 54 | 13 |  |  |  |  | 40 | return $self->{show_labels}; | 
| 55 |  |  |  |  |  |  | } | 
| 56 |  |  |  |  |  |  |  | 
| 57 |  |  |  |  |  |  |  | 
| 58 |  |  |  |  |  |  | sub template_ext{ | 
| 59 | 12 |  |  | 12 | 1 | 1819 | my ($self,$ext) = @_; | 
| 60 | 12 | 50 | 66 |  |  | 25 | confess "Expected a scalar extension name but got a ".ref($ext) if defined $ext && ref($ext); | 
| 61 | 12 | 100 |  |  |  | 17 | $self->{template_ext} = $ext if defined $ext; | 
| 62 | 12 |  |  |  |  | 67 | return $self->{template_ext}; | 
| 63 |  |  |  |  |  |  | } | 
| 64 |  |  |  |  |  |  |  | 
| 65 |  |  |  |  |  |  |  | 
| 66 |  |  |  |  |  |  | sub name_label{ | 
| 67 | 32 |  |  | 32 | 1 | 713 | my ($self,$label) = @_; | 
| 68 | 32 | 50 | 66 |  |  | 53 | confess "Expected a scalar name label but got a ".ref($label) if defined $label && ref($label); | 
| 69 | 32 | 100 |  |  |  | 48 | $self->{name_label} = $label if $label; | 
| 70 | 32 |  |  |  |  | 62 | return $self->{name_label}; | 
| 71 |  |  |  |  |  |  | } | 
| 72 |  |  |  |  |  |  |  | 
| 73 |  |  |  |  |  |  |  | 
| 74 |  |  |  |  |  |  | sub to_html{ | 
| 75 | 16 |  |  | 16 | 1 | 34 | my ($self,$comp) = @_; | 
| 76 |  |  |  |  |  |  |  | 
| 77 | 16 |  |  |  |  | 30 | my $html; | 
| 78 | 16 | 100 |  |  |  | 44 | if ( ref($comp) =~ /array/i ){ | 
|  |  | 100 |  |  |  |  |  | 
| 79 | 2 |  |  |  |  | 7 | $html = $self->_array_to_html( $comp ); | 
| 80 |  |  |  |  |  |  | } elsif( ref( $comp ) =~ /hash/i ){ | 
| 81 | 10 |  |  |  |  | 23 | $html = $self->_hash_to_html( $comp ); | 
| 82 |  |  |  |  |  |  | } else { | 
| 83 | 4 |  |  |  |  | 5 | $html = $comp; | 
| 84 |  |  |  |  |  |  | } | 
| 85 |  |  |  |  |  |  |  | 
| 86 | 16 |  |  |  |  | 42 | return $html; | 
| 87 |  |  |  |  |  |  | } | 
| 88 |  |  |  |  |  |  |  | 
| 89 |  |  |  |  |  |  |  | 
| 90 |  |  |  |  |  |  |  | 
| 91 |  |  |  |  |  |  | sub _hash_to_html{ | 
| 92 | 10 |  |  | 10 |  | 12 | my ($self,$h) = @_; | 
| 93 |  |  |  |  |  |  |  | 
| 94 | 10 | 50 |  |  |  | 21 | confess "Expected a hashref. Instead got a ".ref($h) unless ref($h) =~ /hash/i; | 
| 95 |  |  |  |  |  |  |  | 
| 96 | 10 |  |  |  |  | 17 | my $template_name = $h->{ $self->name_label }; | 
| 97 |  |  |  |  |  |  |  | 
| 98 | 10 | 50 |  |  |  | 18 | confess 'Encountered hash with no name_label ("'.$self->name_label.'"): '.Dumper( $h ) unless $template_name; | 
| 99 |  |  |  |  |  |  |  | 
| 100 | 10 |  |  |  |  | 11 | my $param = {}; | 
| 101 |  |  |  |  |  |  |  | 
| 102 | 10 |  |  |  |  | 21 | foreach my $k ( keys %$h ){ | 
| 103 | 20 | 100 |  |  |  | 29 | next if $k eq $self->name_label; | 
| 104 | 10 |  |  |  |  | 21 | $param->{$k} = $self->to_html( $h->{$k} ); | 
| 105 |  |  |  |  |  |  | } | 
| 106 |  |  |  |  |  |  |  | 
| 107 | 10 |  |  |  |  | 15 | my $filename = File::Spec->catdir( | 
| 108 |  |  |  |  |  |  | $self->template_dir, | 
| 109 |  |  |  |  |  |  | $template_name.$self->template_ext | 
| 110 |  |  |  |  |  |  | ); | 
| 111 |  |  |  |  |  |  |  | 
| 112 | 10 |  |  |  |  | 35 | my $temp = HTML::Template->new( filename => $filename ); | 
| 113 | 10 |  |  |  |  | 3765 | $temp->param( $_ => $param->{$_} ) foreach keys %$param; | 
| 114 |  |  |  |  |  |  |  | 
| 115 | 10 |  |  |  |  | 274 | my $html = $temp->output; | 
| 116 | 10 | 100 |  |  |  | 419 | if ( $self->show_labels ){ | 
| 117 |  |  |  |  |  |  |  | 
| 118 | 5 |  |  |  |  | 8 | my $ca = $self->{comment_tokens}->[0]; | 
| 119 | 5 |  |  |  |  | 7 | my $cb = $self->{comment_tokens}->[1]; | 
| 120 |  |  |  |  |  |  |  | 
| 121 | 5 |  |  |  |  | 16 | $html = "$ca BEGIN $template_name $cb\n$html\n$ca END $template_name $cb\n"; | 
| 122 |  |  |  |  |  |  | } | 
| 123 |  |  |  |  |  |  |  | 
| 124 | 10 |  |  |  |  | 58 | return $html; | 
| 125 |  |  |  |  |  |  |  | 
| 126 |  |  |  |  |  |  | } | 
| 127 |  |  |  |  |  |  |  | 
| 128 |  |  |  |  |  |  |  | 
| 129 |  |  |  |  |  |  |  | 
| 130 |  |  |  |  |  |  |  | 
| 131 |  |  |  |  |  |  | sub _array_to_html{ | 
| 132 |  |  |  |  |  |  |  | 
| 133 | 2 |  |  | 2 |  | 12 | my ($self, $arr, $delim) = @_; | 
| 134 | 2 | 50 |  |  |  | 7 | die "Expected an array. Instead got a ".ref($arr) unless ref($arr) =~ /array/i; | 
| 135 | 2 |  |  |  |  | 10 | my $html = ''; | 
| 136 | 2 |  |  |  |  | 5 | foreach my $comp (@$arr){ | 
| 137 | 4 | 50 | 33 |  |  | 8 | $html.= $delim if ($delim && $html); | 
| 138 | 4 |  |  |  |  | 8 | $html.= $self->to_html( $comp ); | 
| 139 |  |  |  |  |  |  | } | 
| 140 | 2 |  |  |  |  | 5 | return $html; | 
| 141 |  |  |  |  |  |  |  | 
| 142 |  |  |  |  |  |  | } | 
| 143 |  |  |  |  |  |  |  | 
| 144 |  |  |  |  |  |  |  | 
| 145 |  |  |  |  |  |  |  | 
| 146 |  |  |  |  |  |  | 1; | 
| 147 |  |  |  |  |  |  | __END__ |