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   23238 use strict;
  2         5  
  2         72  
4 2     2   9 use warnings;
  2         3  
  2         87  
5            
6 2     2   9 use Moo::Role;
  2         3  
  2         11  
7 2     2   1235 use Carp qw/croak/;
  2         4  
  2         205  
8            
9 2     2   12 use HTML::TableContent::Table;
  2         11  
  2         5215  
10            
11             our $VERSION = '1.01';
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 50920 return $_[0]->table->render;
28             }
29            
30             sub _build_data {
31 42 50   42   1046 return $_[0]->can('_data') ? $_[0]->_coerce_data($_[0]->_data) : [ ];
32             }
33            
34             sub _trigger_data {
35 4 100   4   20482 if ( ref $_[1]->[0] eq 'ARRAY' ) {
36 1         10 return $_[0]->data($_[0]->_coerce_data($_[1]));
37             }
38 3         73 return;
39             }
40            
41             sub _coerce_data {
42 43 100   43   767 if ( ref $_[1]->[0] eq "ARRAY" ) {
43 2         5 my $headers = shift @{ $_[1] };
  2         8  
44 2         5 my $new = [ ];
45 2         5 foreach my $row ( @{ $_[1] } ) {
  2         6  
46 6         12 my %hash = ( );
47 6         12 for (0 .. scalar @{ $row } - 1) {
  6         15  
48 18         44 $hash{$headers->[$_]} = $row->[$_];
49             }
50 6         12 push @{ $new }, \%hash;
  6         17  
51             }
52 2         87 return $new;
53             }
54 41         187 return $_[1];
55             }
56            
57             sub _build_table {
58 45     45   868295 my $self = shift;
59            
60 45         1235 my $data = $self->data;
61            
62 45 50       112 return unless scalar @{ $data };
  45         206  
63            
64 45         83 my $table_spec = { };
65 45 100       367 if ($self->can('table_spec')) {
66 3         16 $table_spec = $self->table_spec;
67             }
68            
69 45         1237 my $table = HTML::TableContent::Table->new($table_spec);
70 45         782 $table = $self->_set_inner_html('render_table', $table);
71            
72 45         1289 my $caption_spec = $self->_caption_spec;
73            
74 45 50       1380 if (defined $caption_spec) {
75 45         100 my $cap = (keys %{ $caption_spec->[0] })[0];
  45         228  
76 45         1275 my $caption = $table->caption($self->$cap);
77 45         844 $caption = $self->_set_inner_html('render_caption', $caption);
78             }
79            
80 45         1280 my $header_spec = $self->_header_spec;
81 45         2206 my %row_spec = $self->_row_spec;
82 45         1958 my %cell_spec = $self->_cell_spec;
83            
84 45         638 for (0 .. scalar @{$header_spec} - 1){
  45         212  
85 135         575 my $attr = (keys %{ $header_spec->[$_] })[0];
  135         578  
86 135         3129 my $header = $self->$attr;
87            
88 135 100       1971 if (my $cells = delete $header->attributes->{cells}) {
89 10         48 $cell_spec{$_ + 1} = $cells;
90             }
91            
92 135         477 $header = $self->_set_inner_html('render_header', $header);
93            
94 135         273 push @{ $table->headers }, $header;
  135         3200  
95             }
96            
97 45         398 my $row_index = 1;
98 45         141 foreach my $hash ( @{ $data } ) {
  45         141  
99 1133         5466 my $row_base = $self->_element_spec($row_index, %row_spec);
100            
101 1133         5006 %cell_spec = $self->_refresh_cell_spec($row_base, $row_index, %cell_spec);
102 1133         4738 my $row = $table->add_row($row_base);
103 1133         4305 $row = $self->_set_inner_html('render_row', $row);
104            
105 1133         3113 my $cell_index = 1;
106 1133         3845 foreach ( $table->all_headers ) {
107 3399         21508 my $cell_base = $self->_element_spec($cell_index++, %cell_spec);
108 3399         21534 $cell_base->{text} = $hash->{$_->template_attr};
109 3399         11224 my $cell = $row->add_cell($cell_base);
110 3399         12904 $cell = $self->_set_inner_html('render_cell', $cell);
111 3399         13136 $table->parse_to_column($cell);
112             }
113            
114 1133         14798 $row_index++;
115             }
116            
117 45 50       638 if ( $self->can('last_chance') ) {
118 0         0 $table = $self->last_chance($table);
119             }
120            
121 45         1304 return $table;
122             }
123            
124             sub _element_spec {
125 4532     4532   15163 my ( $self, $index, %spec) = @_;
126            
127 4532         8395 my $base = { };
128 4532         9202 my $row_index = delete $spec{row_index};
129            
130 4532 100       15253 return $base unless keys %spec;
131            
132 1166         3790 my $num = $self->_num_to_en($index);
133            
134 1166 100       2955 if (defined $row_index) {
135 126         343 $num = sprintf('%s__%s', $self->_num_to_en($row_index), $num);
136             }
137            
138 1166         4875 my @pot = ($index, qw/current all odd even/, $num);
139            
140 1166         2482 for (@pot) {
141 6996 100       16909 if ( my $sp = delete $spec{$_} ) {
142 137 100       739 if ( $_ =~ m{odd|even} ) {
143 36         83 my $action = sprintf('_add_%s', $_);
144 36         135 $base = $self->$action($base, $index, $sp);
145             } else {
146 101 100       419 my $req_index = $_ =~ m{^\d$}xms ? $row_index : $index;
147 101         313 $base = $self->_add_base($base, $req_index, $sp);
148             }
149             }
150             }
151            
152 1166 100       3237 return $base unless keys %spec;
153            
154 1092         4007 for (keys %spec) {
155 4137 100       10254 next unless defined $spec{$_}->{index};
156 27 100       100 my $safe = defined $row_index ? sprintf('%s__%d', $row_index, $index) : $index;
157            
158 27 100       333 if ( $spec{$_}->{index} =~ m{$safe}ixms ) {
159 5         24 $base = $self->_add_to_base($base, $index, $spec{$_});
160             }
161             }
162            
163 1092         4746 return $base;
164             }
165            
166             sub _add_base {
167 101     101   339 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
168             }
169            
170             sub _add_odd {
171 24 100   24   113 return $_[1] unless $_[2] % 2 == 1;
172 16         54 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
173             }
174            
175             sub _add_even {
176 12 100   12   68 return $_[1] unless $_[2] % 2 == 0;
177 4         14 return $_[0]->_add_to_base($_[1], $_[2], $_[3]);
178             }
179            
180             sub _add_to_base {
181 126     126   350 my ( $self, $base, $index, $hash ) = @_;
182            
183 126         365 my @pot = (qw/increment_id cells alternate_classes/);
184 126         300 for (@pot) {
185 378 100       1183 if ( my $p = $hash->{$_} ) {
186 75         201 my $action = sprintf('_base_%s', $_);
187 75         289 $self->$action($p, $base, $index, $hash);
188             }
189             }
190            
191 126         225 for ( keys %{ $hash } ) {
  126         557  
192 535 100       1433 next if $_ =~ m{increment_id}ixms;
193            
194 520 100       1122 if ( $_ eq 'class' ) {
195 53         312 $base->{$_} = $self->_join_class($hash->{$_}, $base->{$_});
196             }
197            
198 520         1475 $base->{$_} = $hash->{$_};
199             }
200            
201 126         543 return $base;
202             }
203            
204             sub _base_increment_id {
205 15     15   62 return $_[4]->{id} = sprintf('%s%s', $_[1], $_[3]);
206             }
207            
208             sub _base_cells {
209 4     4   21 return $_[2]->{cells} = $_[1];
210             }
211            
212             sub _base_alternate_classes {
213 56     56   113 my $class = shift @{ $_[1] };
  56         177  
214 56         294 $_[2]->{class} = $_[0]->_join_class($class, $_[2]->{class});
215 56         146 push @{ $_[1] }, $class;
  56         212  
216             }
217            
218             sub _refresh_cell_spec {
219 1133     1133   3615 my ($self, $row_base, $row_index, %cell_spec) = @_;
220            
221 1133 100       3235 defined $row_base->{cells} ? $cell_spec{current} = delete $row_base->{cells} : delete $cell_spec{current};
222            
223 1133         2157 $cell_spec{row_index} = $row_index;
224            
225 1133         2477 for (keys %cell_spec) {
226 1203 100 100     4425 next unless ref $cell_spec{$_} eq 'HASH' && defined $cell_spec{$_}->{oac};
227 9         24 my @classes = @{ $cell_spec{$_}->{oac} };
  9         44  
228 9         37 $cell_spec{$_}->{alternate_classes} = \@classes;
229             }
230            
231 1133         3896 return %cell_spec;
232             }
233            
234             sub _join_class {
235 109     109   498 my ( $self, $class, $current ) = @_;
236            
237 109 100       516 return defined $current ? sprintf('%s %s', $current, $class) : sprintf('%s', $class);
238             }
239            
240             sub _set_inner_html {
241 4757     4757   13382 my ($self, $action, $element, $attr) = @_;
242            
243 4757   33     26810 $attr ||= $element->attributes;
244            
245 4757 100       28681 if ( my $inner_html = delete $attr->{inner_html}) {
    100          
246 20 100       92 if ( ref $inner_html eq 'ARRAY' ) {
    50          
247 11         48 $element->inner_html($inner_html);
248             } elsif ( $self->can($inner_html) ) {
249 9         35 $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         207 $element->inner_html($self->$action);
255             }
256            
257 4757         10940 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   5822 return unless $_[1] =~ m/^\d+$/xms;
287            
288 1292         29837 my $small = $_[0]->_small_num_en;
289 1292         10915 my $num = '';
290 1292 100       4427 if ($num = $small->{$_[1]} ){
291 318         1033 return $num;
292             }
293            
294 974         3783 my @numbers = split '', $_[1];
295            
296 974 100       2343 if ( scalar @numbers == 2 ) {
297 72         316 return sprintf('%s_%s', $small->{$numbers[0] . 0}, $small->{$numbers[1]});
298             } else {
299 902         1514 my $count = 0;
300 902         1538 @numbers = reverse(@numbers);
301 902         1464 my $string;
302 902         1885 for (@numbers) {
303 2708         4454 my $new = $_;
304            
305 2708 100       5948 if ( $new == 0 ) { $count++; next; }
  185         354  
  185         437  
306            
307 2523 100       5142 unless ( $count == 0 ) {
308 1712         4754 $new .= sprintf '%s' x $count, map { '0' } 1 .. $count;
  2616         8274  
309             }
310            
311 2523 100       7386 unless ($num = $small->{$new}) {
312 902         25248 $num = sprintf('%s_%s', $small->{$_}, $_[0]->_large_num_en->{$count + 1});
313             }
314            
315 2523 100       13755 $string = defined $string ? sprintf('%s_%s', $num, $string) : sprintf('%s', $num);
316 2523         4689 $count++;
317             }
318 902         3233 return $string;
319             }
320             }
321            
322             1;
323            
324             __END__