File Coverage

blib/lib/HTML/TableContent/Template/Base.pm
Criterion Covered Total %
statement 169 171 98.8
branch 66 72 91.6
condition 4 6 66.6
subroutine 22 22 100.0
pod 0 1 0.0
total 261 272 95.9


line stmt bran cond sub pod time code
1             package HTML::TableContent::Template::Base;
2            
3 2     2   14016 use strict;
  2         4  
  2         49  
4 2     2   6 use warnings;
  2         2  
  2         38  
5            
6 2     2   5 use Moo::Role;
  2         1  
  2         8  
7 2     2   492 use Carp qw/croak/;
  2         2  
  2         100  
8            
9 2     2   7 use HTML::TableContent::Table;
  2         5  
  2         3110  
10            
11             our $VERSION = '0.17';
12            
13             has table => (
14             is => 'rw',
15             builder => '_build_table',
16             clearer => 1,
17             );
18            
19             has data => (
20             is => 'rw',
21             builder => '_build_data',
22             lazy => 1,
23             trigger => 1,
24             );
25            
26             sub render {
27 46     46 0 17974 return $_[0]->table->render;
28             }
29            
30             sub _build_data {
31 42 50   42   577 return $_[0]->can('_data') ? $_[0]->_coerce_data($_[0]->_data) : [ ];
32             }
33            
34             sub _trigger_data {
35 4 100   4   4939 if ( ref $_[1]->[0] eq 'ARRAY' ) {
36 1         5 return $_[0]->data($_[0]->_coerce_data($_[1]));
37             }
38 3         45 return;
39             }
40            
41             sub _coerce_data {
42 43 100   43   497 if ( ref $_[1]->[0] eq "ARRAY" ) {
43 2         3 my $headers = shift @{ $_[1] };
  2         4  
44 2         3 my $new = [ ];
45 2         3 foreach my $row ( @{ $_[1] } ) {
  2         61  
46 6         9 my %hash = ( );
47 6         3 for (0 .. scalar @{ $row } - 1) {
  6         9  
48 18         21 $hash{$headers->[$_]} = $row->[$_];
49             }
50 6         7 push @{ $new }, \%hash;
  6         7  
51             }
52 2         22 return $new;
53             }
54 41         93 return $_[1];
55             }
56            
57             sub _build_table {
58 45     45   84991 my $self = shift;
59            
60 45         694 my $data = $self->data;
61            
62 45 50       63 return unless scalar @{ $data };
  45         100  
63            
64 45         55 my $table_spec = { };
65 45 100       260 if ($self->can('table_spec')) {
66 3         9 $table_spec = $self->table_spec;
67             }
68            
69 45         746 my $table = HTML::TableContent::Table->new($table_spec);
70 45         400 $table = $self->_set_inner_html('render_table', $table);
71            
72 45         811 my $caption_spec = $self->_caption_spec;
73            
74 45 50       729 if (defined $caption_spec) {
75 45         53 my $cap = (keys %{ $caption_spec->[0] })[0];
  45         134  
76 45         735 my $caption = $table->caption($self->$cap);
77 45         1038 $caption = $self->_set_inner_html('render_caption', $caption);
78             }
79            
80 45         820 my $header_spec = $self->_header_spec;
81 45         1264 my %row_spec = $self->_row_spec;
82 45         1166 my %cell_spec = $self->_cell_spec;
83            
84 45         350 for (0 .. scalar @{$header_spec} - 1){
  45         122  
85 135         275 my $attr = (keys %{ $header_spec->[$_] })[0];
  135         348  
86 135         2078 my $header = $self->$attr;
87            
88 135 100       1091 if (my $cells = delete $header->attributes->{cells}) {
89 10         21 $cell_spec{$_ + 1} = $cells;
90             }
91            
92 135         241 $header = $self->_set_inner_html('render_header', $header);
93            
94 135         115 push @{ $table->headers }, $header;
  135         1862  
95             }
96            
97 45         237 my $row_index = 1;
98 45         43 foreach my $hash ( @{ $data } ) {
  45         64  
99 1133         2677 my $row_base = $self->_element_spec($row_index, %row_spec);
100            
101 1133         2689 %cell_spec = $self->_refresh_cell_spec($row_base, $row_index, %cell_spec);
102 1133         2634 my $row = $table->add_row($row_base);
103 1133         2074 $row = $self->_set_inner_html('render_row', $row);
104            
105 1133         982 my $cell_index = 1;
106 1133         2060 foreach ( $table->all_headers ) {
107 3399         10598 my $cell_base = $self->_element_spec($cell_index++, %cell_spec);
108 3399         8151 $cell_base->{text} = $hash->{$_->template_attr};
109 3399         6299 my $cell = $row->add_cell($cell_base);
110 3399         5876 $cell = $self->_set_inner_html('render_cell', $cell);
111 3399         8179 $table->parse_to_column($cell);
112             }
113            
114 1133         1562 $row_index++;
115             }
116            
117 45 50       293 if ( $self->can('last_chance') ) {
118 0         0 $table = $self->last_chance($table);
119             }
120            
121 45         660 return $table;
122             }
123            
124             sub _element_spec {
125 4532     4532   7072 my ( $self, $index, %spec) = @_;
126            
127 4532         4286 my $base = { };
128 4532         4861 my $row_index = delete $spec{row_index};
129            
130 4532 100       8644 return $base unless keys %spec;
131            
132 1166         1655 my $num = $self->_num_to_en($index);
133            
134 1166 100       1746 if (defined $row_index) {
135 126         157 $num = sprintf('%s__%s', $self->_num_to_en($row_index), $num);
136             }
137            
138 1166         2126 my @pot = ($index, qw/current all odd even/, $num);
139            
140 1166         1274 for (@pot) {
141 6996 100       9101 if ( my $sp = delete $spec{$_} ) {
142 137 100       366 if ( $_ =~ m{odd|even} ) {
143 36         66 my $action = sprintf('_add_%s', $_);
144 36         72 $base = $self->$action($base, $index, $sp);
145             } else {
146 101 100       179 my $req_index = $_ =~ m{^\d$}xms ? $row_index : $index;
147 101         134 $base = $self->_add_base($base, $req_index, $sp);
148             }
149             }
150             }
151            
152 1166 100       1683 return $base unless keys %spec;
153            
154 1092         1763 for (keys %spec) {
155 4137 100       5740 next unless defined $spec{$_}->{index};
156 27 100       44 my $safe = defined $row_index ? sprintf('%s__%d', $row_index, $index) : $index;
157            
158 27 100       169 if ( $spec{$_}->{index} =~ m{$safe}ixms ) {
159 5         12 $base = $self->_add_to_base($base, $index, $spec{$_});
160             }
161             }
162            
163 1092         2171 return $base;
164             }
165            
166             sub _add_base {
167 101     101   176 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
168             }
169            
170             sub _add_odd {
171 24 100   24   60 return $_[1] unless $_[2] % 2 == 1;
172 16         31 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
173             }
174            
175             sub _add_even {
176 12 100   12   25 return $_[1] unless $_[2] % 2 == 0;
177 4         8 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
178             }
179            
180             sub _add_to_base {
181 126     126   128 my ( $self, $base, $index, $hash ) = @_;
182            
183 126         201 my @pot = (qw/increment_id cells alternate_classes/);
184 126         120 for (@pot) {
185 378 100       575 if ( my $p = $hash->{$_} ) {
186 75         135 my $action = sprintf('_base_%s', $_);
187 75         142 $self->$action($p, $base, $index, $hash);
188             }
189             }
190            
191 126         91 for ( keys %{ $hash } ) {
  126         279  
192 535 100       703 next if $_ =~ m{increment_id}ixms;
193            
194 520 100       619 if ( $_ eq 'class' ) {
195 53         135 $base->{$_} = $self->_join_class($hash->{$_}, $base->{$_});
196             }
197            
198 520         598 $base->{$_} = $hash->{$_};
199             }
200            
201 126         249 return $base;
202             }
203            
204             sub _base_increment_id {
205 15     15   35 return $_[4]->{id} = sprintf('%s%s', $_[1], $_[3]);
206             }
207            
208             sub _base_cells {
209 4     4   10 return $_[2]->{cells} = $_[1];
210             }
211            
212             sub _base_alternate_classes {
213 56     56   46 my $class = shift @{ $_[1] };
  56         88  
214 56         127 $_[2]->{class} = $_[0]->_join_class($class, $_[2]->{class});
215 56         73 push @{ $_[1] }, $class;
  56         107  
216             }
217            
218             sub _refresh_cell_spec {
219 1133     1133   1527 my ($self, $row_base, $row_index, %cell_spec) = @_;
220            
221 1133 100       1493 defined $row_base->{cells} ? $cell_spec{current} = delete $row_base->{cells} : delete $cell_spec{current};
222            
223 1133         880 $cell_spec{row_index} = $row_index;
224            
225 1133         1315 for (keys %cell_spec) {
226 1203 100 100     2652 next unless ref $cell_spec{$_} eq 'HASH' && defined $cell_spec{$_}->{oac};
227 9         9 my @classes = @{ $cell_spec{$_}->{oac} };
  9         20  
228 9         18 $cell_spec{$_}->{alternate_classes} = \@classes;
229             }
230            
231 1133         2323 return %cell_spec;
232             }
233            
234             sub _join_class {
235 109     109   192 my ( $self, $class, $current ) = @_;
236            
237 109 100       321 return defined $current ? sprintf('%s %s', $current, $class) : sprintf('%s', $class);
238             }
239            
240             sub _set_inner_html {
241 4757     4757   4791 my ($self, $action, $element, $attr) = @_;
242            
243 4757   33     14195 $attr ||= $element->attributes;
244            
245 4757 100       16008 if ( my $inner_html = delete $attr->{inner_html}) {
    100          
246 20 100       60 if ( ref $inner_html eq 'ARRAY' ) {
    50          
247 11         24 $element->inner_html($inner_html);
248             } elsif ( $self->can($inner_html) ) {
249 9         25 $element->inner_html($self->$inner_html);
250             } else {
251 0         0 croak "inner_html on $element->template_attr needs to be either an ArrayRef or A reference to a Sub";
252             }
253             } elsif ( $self->can($action) ) {
254 58         134 $element->inner_html($self->$action);
255             }
256            
257 4757         4862 return $element;
258             }
259            
260             has '_small_num_en' => (
261             is => 'ro',
262             lazy => 1,
263             default => sub {
264             my %NUM = ( );
265             @NUM{1 .. 20,30,40,50,60,70,80,90} = qw/
266             one two three four five six seven eight nine ten
267             eleven twelve thirteen fourteen fifteen
268             sixteen seventeen eighteen nineteen
269             twenty thirty forty fifty sixty seventy eighty ninety
270             /;
271             return \%NUM;
272             }
273             );
274            
275             has '_large_num_en' => (
276             is => 'ro',
277             lazy => 1,
278             default => sub {
279             my %NUM = ( );
280             @NUM{3 .. 6} = qw/hundred thousand billion trillion/;
281             return \%NUM;
282             }
283             );
284            
285             sub _num_to_en {
286 1292 50   1292   3748 return unless $_[1] =~ m/^\d+$/xms;
287            
288 1292         16909 my $small = $_[0]->_small_num_en;
289 1292         5138 my $num = '';
290 1292 100       2322 if ($num = $small->{$_[1]} ){
291 318         592 return $num;
292             }
293            
294 974         2089 my @numbers = split '', $_[1];
295            
296 974 100       1518 if ( scalar @numbers == 2 ) {
297 72         328 return sprintf('%s_%s', $small->{$numbers[0] . 0}, $small->{$numbers[1]});
298             } else {
299 902         680 my $count = 0;
300 902         756 @numbers = reverse(@numbers);
301 902         622 my $string;
302 902         926 for (@numbers) {
303 2708         1918 my $new = $_;
304            
305 2708 100       3889 if ( $new == 0 ) { $count++; next; }
  185         120  
  185         222  
306            
307 2523 100       3140 unless ( $count == 0 ) {
308 1712         2202 $new .= sprintf '%s' x $count, map { '0' } 1 .. $count;
  2616         3732  
309             }
310            
311 2523 100       4204 unless ($num = $small->{$new}) {
312 902         13341 $num = sprintf('%s_%s', $small->{$_}, $_[0]->_large_num_en->{$count + 1});
313             }
314            
315 2523 100       9694 $string = defined $string ? sprintf('%s_%s', $num, $string) : sprintf('%s', $num);
316 2523         2429 $count++;
317             }
318 902         1663 return $string;
319             }
320             }
321            
322             1;
323            
324             __END__