File Coverage

blib/lib/Term/Table.pm
Criterion Covered Total %
statement 149 162 91.9
branch 66 82 80.4
condition 46 64 71.8
subroutine 12 13 92.3
pod 0 5 0.0
total 273 326 83.7


line stmt bran cond sub pod time code
1             package Term::Table;
2 4     4   155298 use strict;
  4         28  
  4         121  
3 4     4   20 use warnings;
  4         10  
  4         162  
4              
5             our $VERSION = '0.016';
6              
7 4     4   1668 use Term::Table::Cell();
  4         14  
  4         134  
8              
9 4     4   30 use Term::Table::Util qw/term_size uni_length USE_GCS/;
  4         9  
  4         34  
10 4     4   155 use Scalar::Util qw/blessed/;
  4         7  
  4         232  
11 4     4   24 use List::Util qw/max sum/;
  4         10  
  4         231  
12 4     4   23 use Carp qw/croak carp/;
  4         8  
  4         260  
13              
14 4     4   27 use Term::Table::HashBase qw/rows _columns collapse max_width mark_tail sanitize show_header auto_columns no_collapse header allow_overflow pad/;
  4         7  
  4         31  
15              
16             sub BORDER_SIZE() { 4 } # '| ' and ' |' borders
17             sub DIV_SIZE() { 3 } # ' | ' column delimiter
18             sub CELL_PAD_SIZE() { 2 } # space on either side of the |
19              
20             sub init {
21 16     16 0 32 my $self = shift;
22              
23             croak "You cannot have a table with no rows"
24 16 50 33     69 unless $self->{+ROWS} && @{$self->{+ROWS}};
  16         66  
25              
26 16   66     55 $self->{+MAX_WIDTH} ||= term_size();
27 16   100     94 $self->{+NO_COLLAPSE} ||= {};
28 16 100       63 if (ref($self->{+NO_COLLAPSE}) eq 'ARRAY') {
29 1         3 $self->{+NO_COLLAPSE} = {map { ($_ => 1) } @{$self->{+NO_COLLAPSE}}};
  2         9  
  1         3  
30             }
31              
32 16 100 66     83 if ($self->{+NO_COLLAPSE} && $self->{+HEADER}) {
33 12         27 my $header = $self->{+HEADER};
34 12         39 for(my $idx = 0; $idx < @$header; $idx++) {
35 45   66     197 $self->{+NO_COLLAPSE}->{$idx} ||= $self->{+NO_COLLAPSE}->{$header->[$idx]};
36             }
37             }
38              
39 16 100       61 $self->{+PAD} = 4 unless defined $self->{+PAD};
40              
41 16 100       50 $self->{+COLLAPSE} = 1 unless defined $self->{+COLLAPSE};
42 16 100       61 $self->{+SANITIZE} = 1 unless defined $self->{+SANITIZE};
43 16 100       58 $self->{+MARK_TAIL} = 1 unless defined $self->{+MARK_TAIL};
44              
45 16 100       42 if($self->{+HEADER}) {
46 12 100       52 $self->{+SHOW_HEADER} = 1 unless defined $self->{+SHOW_HEADER};
47             }
48             else {
49 4         13 $self->{+HEADER} = [];
50 4         10 $self->{+AUTO_COLUMNS} = 1;
51 4         12 $self->{+SHOW_HEADER} = 0;
52             }
53             }
54              
55             sub columns {
56 17     17 0 35 my $self = shift;
57              
58 17 100       82 $self->regen_columns unless $self->{+_COLUMNS};
59              
60 15         33 return $self->{+_COLUMNS};
61             }
62              
63             sub regen_columns {
64 16     16 0 28 my $self = shift;
65              
66 16   66     54 my $has_header = $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
67 16 100       81 my %new_col = (width => 0, count => $has_header ? -1 : 0);
68              
69 16         35 my $cols = [map { {%new_col} } @{$self->{+HEADER}}];
  45         128  
  16         46  
70 16         30 my @rows = @{$self->{+ROWS}};
  16         42  
71              
72 16 100       69 for my $row ($has_header ? ($self->{+HEADER}, @rows) : (@rows)) {
73 38         172 for my $ci (0 .. max(@$cols - 1, @$row - 1)) {
74 137 100 100     337 $cols->[$ci] ||= {%new_col} if $self->{+AUTO_COLUMNS};
75 137 50       282 my $c = $cols->[$ci] or next;
76 137   100     393 $c->{idx} ||= $ci;
77 137   100     338 $c->{rows} ||= [];
78              
79 137         204 my $r = $row->[$ci];
80 137 100 33     564 $r = Term::Table::Cell->new(value => $r)
      66        
81             unless blessed($r)
82             && ($r->isa('Term::Table::Cell')
83             || $r->isa('Term::Table::CellStack')
84             || $r->isa('Term::Table::Spacer'));
85              
86 137 50       441 $r->sanitize if $self->{+SANITIZE};
87 137 50       431 $r->mark_tail if $self->{+MARK_TAIL};
88              
89 137         268 my $rs = $r->width;
90 137 100       2072 $c->{width} = $rs if $rs > $c->{width};
91 137 100       296 $c->{count}++ if $rs;
92              
93 137         166 push @{$c->{rows}} => $r;
  137         368  
94             }
95             }
96              
97             # Remove any empty columns we can
98 45 100       167 @$cols = grep {$_->{count} > 0 || $self->{+NO_COLLAPSE}->{$_->{idx}}} @$cols
99 16 100       63 if $self->{+COLLAPSE};
100              
101 16         35 my $current = sum(map {$_->{width}} @$cols);
  47         91  
102 16         58 my $border = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * (@$cols - 1));
103 16         35 my $total = $current + $border;
104              
105 16 100       53 if ($total > $self->{+MAX_WIDTH}) {
106 7         24 my $fair = ($self->{+MAX_WIDTH} - $border) / @$cols;
107 7 100       30 if ($fair < 1) {
108 3 100       11 return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
109 2         312 croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
110             }
111              
112 4         8 my $under = 0;
113 4         7 my @fix;
114 4         13 for my $c (@$cols) {
115 13 50       30 if ($c->{width} > $fair) {
116 13         24 push @fix => $c;
117             }
118             else {
119 0         0 $under += $c->{width};
120             }
121             }
122              
123             # Recalculate fairness
124 4         26 $fair = int(($self->{+MAX_WIDTH} - $border - $under) / @fix);
125 4 50       15 if ($fair < 1) {
126 0 0       0 return $self->{+_COLUMNS} = $cols if $self->{+ALLOW_OVERFLOW};
127 0         0 croak "Table is too large ($total including $self->{+PAD} padding) to fit into max-width ($self->{+MAX_WIDTH})";
128             }
129              
130             # Adjust over-long columns
131 4         18 $_->{width} = $fair for @fix;
132             }
133              
134 13         41 $self->{+_COLUMNS} = $cols;
135             }
136              
137             sub render {
138 17     17 0 166 my $self = shift;
139              
140 17         53 my $cols = $self->columns;
141 15         39 for my $col (@$cols) {
142 49         65 for my $cell (@{$col->{rows}}) {
  49         82  
143 132         250 $cell->reset;
144             }
145             }
146 15         44 my $width = sum(BORDER_SIZE, $self->{+PAD}, DIV_SIZE * @$cols, map { $_->{width} } @$cols);
  49         114  
147              
148             #<<< NO-TIDY
149 15         41 my $border = '+' . join('+', map { '-' x ($_->{width} + CELL_PAD_SIZE) } @$cols) . '+';
  49         151  
150 15         43 my $template = '|' . join('|', map { my $w = $_->{width} + CELL_PAD_SIZE; '%s' } @$cols) . '|';
  49         69  
  49         101  
151 15         43 my $spacer = '|' . join('|', map { ' ' x ($_->{width} + CELL_PAD_SIZE) } @$cols) . '|';
  49         120  
152             #>>>
153              
154 15         38 my @out = ($border);
155 15         37 my ($row, $split, $found) = (0, 0, 0);
156 15         24 while(1) {
157 149         207 my @row;
158              
159 149         189 my $is_spacer = 0;
160              
161 149         272 for my $col (@$cols) {
162 536         881 my $r = $col->{rows}->[$row];
163 536 100       941 unless($r) {
164 49         112 push @row => '';
165 49         76 next;
166             }
167              
168 487         673 my ($v, $vw);
169              
170 487 100       1222 if ($r->isa('Term::Table::Cell')) {
    50          
    0          
171 449         933 my $lw = $r->border_left_width;
172 449         6218 my $rw = $r->border_right_width;
173 449         5538 $vw = $col->{width} - $lw - $rw;
174 449         888 $v = $r->break->next($vw);
175             }
176             elsif ($r->isa('Term::Table::CellStack')) {
177 38         81 ($v, $vw) = $r->break->next($col->{width});
178             }
179             elsif ($r->isa('Term::Table::Spacer')) {
180 0         0 $is_spacer = 1;
181             }
182              
183 487 50       1094 if ($is_spacer) {
    100          
184 0         0 last;
185             }
186             elsif (defined $v) {
187 249         364 $found++;
188 249   50     546 my $bcolor = $r->border_color || '';
189 249   50     530 my $vcolor = $r->value_color || '';
190 249   50     558 my $reset = $r->reset_color || '';
191              
192 249 50       533 if (my $need = $vw - uni_length($v)) {
193 0         0 $v .= ' ' x $need;
194             }
195              
196 249         3926 my $rt = "${reset}${bcolor}\%s${reset} ${vcolor}\%s${reset} ${bcolor}\%s${reset}";
197 249   100     545 push @row => sprintf($rt, $r->border_left || '', $v, $r->border_right || '');
      100        
198             }
199             else {
200 238         666 push @row => ' ' x ($col->{width} + 2);
201             }
202             }
203              
204 149 100       272 if (!grep {$_ && m/\S/} @row) {
  536 100       1929  
205 53 100 66     153 last unless $found || $is_spacer;
206              
207 38 100 100     150 push @out => $border if $row == 0 && $self->{+SHOW_HEADER} && @{$self->{+HEADER}};
  13   66     64  
208 38 100 66     132 push @out => $spacer if $split > 1 || $is_spacer;
209              
210 38         58 $row++;
211 38         50 $split = 0;
212 38         52 $found = 0;
213              
214 38         80 next;
215             }
216              
217 96 50 66     272 if ($split == 1 && @out > 1 && $out[-2] ne $border && $out[-2] ne $spacer) {
      100        
      66        
218 0         0 my $last = pop @out;
219 0         0 push @out => ($spacer, $last);
220             }
221              
222 96         365 push @out => sprintf($template, @row);
223 96         195 $split++;
224             }
225              
226 15   66     82 pop @out while @out && $out[-1] eq $spacer;
227              
228 15         32 unless (USE_GCS) {
229             for my $row (@out) {
230             next unless $row =~ m/[^\x00-\x7F]/;
231             unshift @out => "Unicode::GCString is not installed, table may not display all unicode characters properly";
232             last;
233             }
234             }
235              
236 15         103 return (@out, $border);
237             }
238              
239             sub display {
240 0     0 0   my $self = shift;
241 0           my ($fh) = @_;
242              
243 0           my @parts = map "$_\n", $self->render;
244              
245 0 0         print $fh @parts if $fh;
246 0           print @parts;
247             }
248              
249             1;
250              
251             __END__