File Coverage

blib/lib/Text/Table/More.pm
Criterion Covered Total %
statement 351 361 97.2
branch 168 196 85.7
condition 69 101 68.3
subroutine 21 22 95.4
pod 1 1 100.0
total 610 681 89.5


line stmt bran cond sub pod time code
1             package Text::Table::More;
2              
3 1     1   344706 use 5.010001;
  1         12  
4 1     1   6 use strict;
  1         1  
  1         18  
5 1     1   4 use warnings;
  1         1  
  1         180  
6             #use utf8;
7              
8             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
9             our $DATE = '2022-02-14'; # DATE
10             our $DIST = 'Text-Table-More'; # DIST
11             our $VERSION = '0.023'; # VERSION
12              
13             # see Module::Features for more details on this
14             our %FEATURES = (
15             set_v => {
16             TextTable => 1,
17             },
18              
19             features => {
20             PerlTrove => {
21             "Development Status" => "4 - Beta",
22             "Environment" => "Console",
23             # Framework
24             "Intended Audience" => ["Developers"],
25             "License" => "OSI Approved :: Artistic License",
26             # Natural Language
27             # Operating System
28             "Programming Language" => "Perl",
29             "Topic" => ["Software Development :: Libraries :: Perl Modules", "Utilities"],
30             # Typing
31             },
32              
33             TextTable => {
34             can_align_cell_containing_wide_character => 1,
35             can_align_cell_containing_color_code => 1,
36             can_align_cell_containing_newline => 1,
37             can_use_box_character => 1,
38             can_customize_border => 1,
39             can_halign => 1,
40             can_halign_individual_row => 1,
41             can_halign_individual_column => 1,
42             can_halign_individual_cell => 1,
43             can_valign => 1,
44             can_valign_individual_row => 1,
45             can_valign_individual_column => 1,
46             can_valign_individual_cell => 1,
47             can_rowspan => 1,
48             can_colspan => 1,
49             can_color => 0,
50             can_color_theme => 0,
51             can_set_cell_height => 0,
52             can_set_cell_height_of_individual_row => 0,
53             can_set_cell_width => 0,
54             can_set_cell_width_of_individual_column => 0,
55             speed => 'slow',
56             can_hpad => 1,
57             can_hpad_individual_row => 1,
58             can_hpad_individual_column => 1,
59             can_hpad_individual_cell => 1,
60             can_vpad => 1,
61             can_vpad_individual_row => 1,
62             can_vpad_individual_column => 1,
63             can_vpad_individual_cell => 1,
64             },
65             },
66             );
67              
68 1     1   150168 use List::AllUtils qw(first firstidx max);
  1         62382  
  1         85  
69              
70 1     1   8 use Exporter qw(import);
  1         2  
  1         3718  
71             our @EXPORT_OK = qw/ generate_table /;
72              
73             our $_split_lines_func;
74             our $_pad_func;
75             our $_length_height_func;
76              
77             # consts
78             sub IDX_EXPTABLE_CELL_ROWSPAN() {0} # number of rowspan, only defined for the rowspan head
79             sub IDX_EXPTABLE_CELL_COLSPAN() {1} # number of colspan, only defined for the colspan head
80             sub IDX_EXPTABLE_CELL_WIDTH() {2} # visual width. this does not include the cell padding.
81             sub IDX_EXPTABLE_CELL_HEIGHT() {3} # visual height. this does not include row separator.
82             sub IDX_EXPTABLE_CELL_ORIG() {4} # str/hash
83             sub IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL() {5} # whether this cell is tail of a rowspan
84             sub IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL() {6} # whether this cell is tail of a colspan
85             sub IDX_EXPTABLE_CELL_ORIG_ROWNUM() {7} #
86             sub IDX_EXPTABLE_CELL_ORIG_COLNUM() {8} #
87             sub IDX_EXPTABLE_CELL_TEXT() {9} # cell text (modified: padded)
88              
89             # whether an exptable cell is the head (1st cell) or tail (the rest) of a
90             # rowspan/colspan. these should be macros if possible, for speed.
91 135 50   135   343 sub _exptable_cell_is_rowspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] }
92 129 50   129   373 sub _exptable_cell_is_colspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] }
93 149 50 66 149   477 sub _exptable_cell_is_tail { defined($_[0]) && ($_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] || $_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL]) }
94 82 50   82   268 sub _exptable_cell_is_rowspan_head { defined($_[0]) && !$_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] }
95 0 0   0   0 sub _exptable_cell_is_colspan_head { defined($_[0]) && !$_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] }
96 176 50   176   1203 sub _exptable_cell_is_head { defined($_[0]) && defined $_[0][IDX_EXPTABLE_CELL_ORIG] }
97              
98             sub _divide_int_to_n_ints {
99 250     250   409 my ($int, $n) = @_;
100 250         267 my $subtot = 0;
101 250         255 my $int_subtot = 0;
102 250         247 my $prev_int_subtot = 0;
103 250         267 my @ints;
104 250         321 for (1..$n) {
105 269         348 $subtot += $int/$n;
106 269         413 $int_subtot = sprintf "%.0f", $subtot;
107 269         345 push @ints, $int_subtot - $prev_int_subtot;
108 269         360 $prev_int_subtot = $int_subtot;
109             }
110 250         406 @ints;
111             }
112              
113             sub _vpad {
114 125     125   227 my ($lines, $num_lines, $width, $which, $pad_char) = @_;
115 125 100       355 return $lines if @$lines >= $num_lines; # we don't do truncate
116 15         18 my @vpadded_lines;
117 15         26 my $pad_line = $pad_char x $width;
118 15 100       53 if ($which =~ /^b/) { # bottom padding
    100          
119 12         35 push @vpadded_lines, @$lines;
120 12         57 push @vpadded_lines, $pad_line for @$lines+1 .. $num_lines;
121             } elsif ($which =~ /^t/) { # top padding
122 1         7 push @vpadded_lines, $pad_line for @$lines+1 .. $num_lines;
123 1         2 push @vpadded_lines, @$lines;
124             } else { # center padding
125 2         4 my $p = $num_lines - @$lines;
126 2         6 my $p1 = int($p/2);
127 2         3 my $p2 = $p - $p1;
128 2         7 push @vpadded_lines, $pad_line for 1..$p1;
129 2         3 push @vpadded_lines, @$lines;
130 2         5 push @vpadded_lines, $pad_line for 1..$p2;
131             }
132 15         45 \@vpadded_lines;
133             }
134              
135             sub _get_attr {
136 1412     1412   2129 my ($attr_name, $y, $x, $cell_value, $table_args) = @_;
137              
138             CELL_ATTRS_FROM_CELL_VALUE: {
139 1412 100       1546 last unless ref $cell_value eq 'HASH';
  1412         2220  
140 216         252 my $attr_val = $cell_value->{$attr_name};
141 216 100       334 return $attr_val if defined $attr_val;
142             }
143              
144             CELL_ATTRS_FROM_CELL_ATTRS_ARG:
145             {
146 1405 100 66     1475 last unless defined $x && defined $y;
  1405         2916  
147 1199         1445 my $cell_attrs = $table_args->{cell_attrs};
148 1199 100       1673 last unless $cell_attrs;
149 255         324 for my $entry (@$cell_attrs) {
150 255 100 100     580 next unless $entry->[0] == $y && $entry->[1] == $x;
151 32         38 my $attr_val = $entry->[2]{$attr_name};
152 32 100       59 return $attr_val if defined $attr_val;
153             }
154             }
155              
156             COL_ATTRS:
157             {
158 1402 100       1388 last unless defined $x;
  1402         1852  
159 1196         1283 my $col_attrs = $table_args->{col_attrs};
160 1196 100       1659 last unless $col_attrs;
161 252         300 for my $entry (@$col_attrs) {
162 252 100       521 next unless $entry->[0] == $x;
163 72         85 my $attr_val = $entry->[1]{$attr_name};
164 72 100       129 return $attr_val if defined $attr_val;
165             }
166             }
167              
168             ROW_ATTRS:
169             {
170 1393 50       1364 last unless defined $y;
  1393         1847  
171 1393         1454 my $row_attrs = $table_args->{row_attrs};
172 1393 100       1822 last unless $row_attrs;
173 373         435 for my $entry (@$row_attrs) {
174 373 100       576 next unless $entry->[0] == $y;
175 128         157 my $attr_val = $entry->[1]{$attr_name};
176 128 100       205 return $attr_val if defined $attr_val;
177             }
178             }
179              
180             TABLE_ARGS:
181             {
182 1384         1435 my $attr_val = $table_args->{$attr_name};
  1384         1550  
183 1384 100       1983 return $attr_val if defined $attr_val;
184             }
185              
186 1103         2123 undef;
187             }
188              
189             sub _get_exptable_cell_lines {
190 125     125   236 my ($table_args, $exptable, $row_heights, $column_widths,
191             $bottom_borders, $intercol_width, $y, $x) = @_;
192              
193 125         173 my $exptable_cell = $exptable->[$y][$x];
194 125         148 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
195 125         166 my $text = $exptable_cell->[IDX_EXPTABLE_CELL_TEXT];
196 125   100     185 my $align = _get_attr('align', $y, $x, $cell, $table_args) // 'left';
197 125   100     200 my $valign = _get_attr('valign', $y, $x, $cell, $table_args) // 'top';
198 125 100       253 my $pad = $align eq 'left' ? 'r' : $align eq 'right' ? 'l' : 'c';
    100          
199 125 100       181 my $vpad = $valign eq 'top' ? 'b' : $valign eq 'bottom' ? 't' : 'c';
    100          
200 125         156 my $pad_char = $table_args->{pad_char};
201 125         150 my $height = 0;
202 125         135 my $width = 0;
203 125         205 for my $ic (1..$exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN]) {
204 134         213 $width += $column_widths->[$x+$ic-1];
205 134 100       246 $width += $intercol_width if $ic > 1;
206             }
207 125         193 for my $ir (1..$exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN]) {
208 135         169 $height += $row_heights->[$y+$ir-1];
209 135 100 100     360 $height++ if $bottom_borders->[$y+$ir-2] && $ir > 1;
210             }
211              
212 125         221 my @datalines = map { $_pad_func->($_, $width, $pad, $pad_char, 'truncate') }
  170         1412  
213             ($_split_lines_func->($text));
214 125         2885 _vpad(\@datalines, $height, $width, $vpad, $pad_char);
215             }
216              
217             sub generate_table {
218 22     22 1 469773 require Module::Load::Util;
219 22         1782 require Text::NonWideChar::Util;
220              
221 22         302 my %args = @_;
222 22   100     122 $args{header_row} //= 0; my $header_row = $args{header_row};
  22         39  
223 22   50     94 $args{pad_char} //= ' ';
224 22   100     120 $args{hpad} //= 1;
225 22   100     93 $args{vpad} //= 0;
226              
227 22 50       50 my $rows = $args{rows} or die "Please specify rows";
228             my $bs_name = $args{border_style} //
229             $ENV{PERL_TEXT_TABLE_MORE_BORDER_STYLE} //
230             $ENV{BORDER_STYLE} //
231 22   33     136 'ASCII::SingleLineDoubleAfterHeader';
      33        
      50        
232 22   100     68 my $cell_attrs = $args{cell_attrs} // [];
233              
234 22         83 my $bs_obj = Module::Load::Util::instantiate_class_with_optional_args({ns_prefix=>"BorderStyle"}, $bs_name);
235              
236             DETERMINE_CODES: {
237 22         468485 my $color = $args{color};
  22         42  
238 22         28 my $wide_char = $args{wide_char};
239              
240             # split_lines
241 22 100       46 if ($color) {
242 1         5 require Text::ANSI::Util;
243 1     9   8 $_split_lines_func = sub { Text::ANSI::Util::ta_add_color_resets(split /\R/, $_[0]) };
  9         42  
244             } else {
245 21     116   132 $_split_lines_func = sub { split /\R/, $_[0] };
  116         365  
246             }
247              
248             # pad & length_height
249 22 100       42 if ($color) {
250 1 50       3 if ($wide_char) {
251 1         458 require Text::ANSI::WideUtil;
252 1         378 $_pad_func = \&Text::ANSI::WideUtil::ta_mbpad;
253 1         9 $_length_height_func = \&Text::ANSI::WideUtil::ta_mbswidth_height;
254             } else {
255 0         0 require Text::ANSI::Util;
256 0         0 $_pad_func = \&Text::ANSI::Util::ta_pad;
257 0         0 $_length_height_func = \&Text::ANSI::Util::ta_length_height;
258             }
259             } else {
260 21 50       37 if ($wide_char) {
261 0         0 require Text::WideChar::Util;
262 0         0 $_pad_func = \&Text::WideChar::Util::mbpad;
263 0         0 $_length_height_func = \&Text::WideChar::Util::mbswidth_height;
264             } else {
265 21         557 require String::Pad;
266 21         561 require Text::NonWideChar::Util;
267 21         43 $_pad_func = \&String::Pad::pad;
268 21         40 $_length_height_func = \&Text::NonWideChar::Util::length_height;
269             }
270             }
271             }
272              
273             # XXX when we allow cell attrs right_border and left_border, this will
274             # become array too like $exptable_bottom_borders.
275 22         497 my $intercol_width = length($bs_obj->get_border_char(char=>'v_i'));
276              
277 22         1882 my $exptable = []; # [ [[$orig_rowidx,$orig_colidx,$rowspan,$colspan,...], ...], [[...], ...], ... ]
278 22         36 my $exptable_bottom_borders = []; # idx=exptable rownum, val=bool
279 22         25 my $M = 0; # number of rows in the exptable
280 22         34 my $N = 0; # number of columns in the exptable
281             CONSTRUCT_EXPTABLE: {
282             # 1. the first step is to construct a 2D array we call "exptable" (short
283             # for expanded table), which is like the original table but with all the
284             # spanning rows/columns split into the smaller boxes so it's easier to
285             # draw later. for example, a table cell with colspan=2 will become 2
286             # exptable cells. an m-row x n-column table will become M-row x N-column
287             # exptable, where M>=m, N>=n.
288              
289 22         29 my $rownum;
  22         24  
290              
291             # 1a. first substep: construct exptable and calculate everything except
292             # each exptable cell's width and height, because this will require
293             # information from the previous substeps.
294              
295 22         39 $rownum = -1;
296 22         44 for my $row (@$rows) {
297 61         80 $rownum++;
298 61         71 my $colnum = -1;
299 61         87 my $separator_type = do {
300 61         71 my $cmp = $header_row-1 <=> $rownum;
301             # 0=none, 2=separator between header/data, 4=separator between
302             # data rows, 8=separator between header rows. this is from
303             # BorderStyle standard.
304 61 100       133 $cmp==0 ? 2 : $cmp==1 ? 8 : 4;
    100          
305             };
306 61   100     208 $exptable->[$rownum] //= [];
307 61         558 push @{ $exptable->[$rownum] }, undef
308 61 50 66     77 if (@{ $exptable->[$rownum] } == 0 ||
  61         158  
309             defined($exptable->[$rownum][-1]));
310             #use DDC; say "D:exptable->[$rownum] = ", DDC::dump($exptable->[$rownum]);
311 61     66   171 my $exptable_colnum = firstidx {!defined} @{ $exptable->[$rownum] };
  66         113  
  61         160  
312             #say "D:rownum=$rownum, exptable_colnum=$exptable_colnum";
313 61 50       154 if ($exptable_colnum == -1) { $exptable_colnum = 0 }
  0         0  
314 61 100 66     239 $exptable_bottom_borders->[$rownum] //= $args{separate_rows} ? $separator_type : 0;
315              
316 61         91 for my $cell (@$row) {
317 125         131 $colnum++;
318 125         132 my $text;
319              
320 125         148 my $rowspan = 1;
321 125         133 my $colspan = 1;
322 125 100       201 if (ref $cell eq 'HASH') {
323 21         43 $text = $cell->{text};
324 21 100       46 $rowspan = $cell->{rowspan} if $cell->{rowspan};
325 21 100       43 $colspan = $cell->{colspan} if $cell->{colspan};
326             } else {
327 104         130 $text = $cell;
328 104         107 my $el;
329 104 100 100 21   345 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{rowspan}} @$cell_attrs;
  21         65  
330 104 50       281 $rowspan = $el->[2]{rowspan} if $el;
331 104 100 100 21   261 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{colspan}} @$cell_attrs;
  21         54  
332 104 50       225 $colspan = $el->[2]{colspan} if $el;
333             }
334              
335 125         150 my @widths;
336             my @heights;
337             ROW:
338 125         193 for my $ir (1..$rowspan) {
339 135         171 for my $ic (1..$colspan) {
340 149         148 my $exptable_cell;
341 149         236 $exptable->[$rownum+$ir-1][$exptable_colnum+$ic-1] = $exptable_cell = [];
342              
343 149         198 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG_ROWNUM] = $rownum;
344 149         199 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG_COLNUM] = $colnum;
345              
346 149 100 100     327 if ($ir == 1 && $ic == 1) {
347 125         159 $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN] = $rowspan;
348 125         136 $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN] = $colspan;
349 125         198 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG] = $cell;
350             } else {
351 24 100       46 $exptable_cell->[IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] = 1 if $ir > 1;
352 24 100       49 $exptable_cell->[IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] = 1 if $ic > 1;
353             }
354             #use DDC; dd $exptable; say ''; # debug
355             }
356              
357             # determine whether we should draw bottom border of each row
358 135 100 100     278 if ($rownum+$ir-1 == 0 && $header_row > 0) {
359 32         45 $exptable_bottom_borders->[0] = $separator_type;
360             } else {
361 103         113 my $val;
362 103 100       206 $val = _get_attr('bottom_border', $rownum+$ir-1, 0, $cell, \%args); $exptable_bottom_borders->[$rownum+$ir-1] = $separator_type if $val;
  103         156  
363 103 50       159 $val = _get_attr('top_border' , $rownum+$ir-1, 0, $cell, \%args); $exptable_bottom_borders->[$rownum+$ir-2] = $separator_type if $val;
  103         189  
364 103 100       160 $val = _get_attr('bottom_border', $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-1] = $separator_type if $val;
  103         152  
365 103 50       169 $val = _get_attr('top_border' , $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-2] = $separator_type if $val;
  103         164  
366             }
367              
368 135 100       269 $M = $rownum+$ir if $M < $rownum+$ir;
369             }
370              
371 125         129 $exptable_colnum += $colspan;
372 125         255 $exptable_colnum++ while defined $exptable->[$rownum][$exptable_colnum];
373              
374             } # for a row
375 61 100       118 $N = $exptable_colnum if $N < $exptable_colnum;
376             } # for rows
377              
378             # 1b. calculate the heigth and width of each exptable cell (as required
379             # by the text, or specified width/height when we allow cell attrs width,
380             # height)
381              
382 22         36 for my $exptable_rownum (0..$M-1) {
383 61         92 for my $exptable_colnum (0..$N-1) {
384 149         189 my $exptable_cell = $exptable->[$exptable_rownum][$exptable_colnum];
385 149 100       234 next if _exptable_cell_is_tail($exptable_cell);
386 125         171 my $rowspan = $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN];
387 125         135 my $colspan = $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN];
388 125         142 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
389 125 100       257 my $text = ref $cell eq 'HASH' ? $cell->{text} : $cell;
390              
391             # pad the text, put in exptable text
392 125         203 my $hpad = _get_attr('hpad', $exptable_rownum, $exptable_colnum, $cell, \%args);
393 125   100     356 my $lpad = _get_attr('lpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $hpad;
394 125   100     218 my $rpad = _get_attr('rpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $hpad;
395 125         181 my $vpad = _get_attr('vpad', $exptable_rownum, $exptable_colnum, $cell, \%args);
396 125   100     198 my $tpad = _get_attr('tpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $vpad;
397 125   100     194 my $bpad = _get_attr('bpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $vpad;
398 125         169 my $pad_char = $args{pad_char};
399 125 100       192 if ($lpad > 0) { my $p = $pad_char x $lpad; $text =~ s/^/$p/gm }
  117         148  
  117         401  
400 125 100       241 if ($rpad > 0) { my $p = $pad_char x $rpad; $text =~ s/$/$p/gm }
  116         157  
  116         325  
401 125 100       211 if ($tpad > 0) { $text = ("\n" x $tpad) . $text }
  9         20  
402 125 100       214 if ($bpad > 0) { $text = $text . ("\n$pad_char" x $bpad) }
  9         17  
403 125         176 $exptable_cell->[IDX_EXPTABLE_CELL_TEXT] = $text;
404              
405 125         251 my $lh = $_length_height_func->($text);
406             #use DDC; dd $text;
407             #use DDC; say "D:length_height[$exptable_rownum,$exptable_colnum] = (".DDC::dump($text)."): ".DDC::dump($lh);
408 125         2271 my $tot_intercol_widths = ($colspan-1) * $intercol_width;
409 125 50       151 my $tot_interrow_heights = 0; for (1..$rowspan-1) { $tot_interrow_heights++ if $exptable_bottom_borders->[$exptable_rownum+$_-1] }
  125         208  
  10         28  
410             #say "D:tot_intercol_widths=$tot_intercol_widths";
411             #say "D:to_interrow_heights=$tot_interrow_heights";
412 125         274 my @heights = _divide_int_to_n_ints(max(0, $lh->[1] - $tot_interrow_heights), $rowspan);
413 125         266 my @widths = _divide_int_to_n_ints(max(0, $lh->[0] - $tot_intercol_widths ), $colspan);
414             #use DDC; say "D:split widths:", DDC::dump(\@widths), ", split heights:", DDC::dump(\@heights);
415 125         435 for my $ir (1..$rowspan) {
416 135         187 for my $ic (1..$colspan) {
417 149         252 $exptable->[$exptable_rownum+$ir-1][$exptable_colnum+$ic-1][IDX_EXPTABLE_CELL_HEIGHT] = $heights[$ir-1];
418 149         374 $exptable->[$exptable_rownum+$ir-1][$exptable_colnum+$ic-1][IDX_EXPTABLE_CELL_WIDTH] = $widths [$ic-1];
419             }
420             }
421             }
422             } # for rows
423              
424             } # CONSTRUCT_EXPTABLE
425             #use DDC; dd $exptable; # debug
426             #print "D: exptable size: $M x $N (HxW)\n"; # debug
427             #use DDC; print "bottom borders: "; dd $exptable_bottom_borders; # debug
428              
429             OPTIMIZE_EXPTABLE: {
430             # TODO
431              
432             # 2. we reduce extraneous columns and rows if there are colspan that are
433             # too many. for example, if all exptable cells in column 1 has colspan=2
434             # (or one row has colspan=2 and another row has colspan=3), we might as
435             # remove 1 column because the extra column span doesn't have any
436             # content. same case for extraneous row spans.
437              
438             # 2a. remove extra undefs. skip this. doesn't make a difference.
439             #for my $exptable_row (@{ $exptable }) {
440             # splice @$exptable_row, $N if @$exptable_row > $N;
441             #}
442              
443 22         25 1;
  22         26  
444             } # OPTIMIZE_EXPTABLE
445             #use DDC; dd $exptable; # debug
446              
447 22         37 my $exptable_column_widths = []; # idx=exptable colnum
448 22         32 my $exptable_row_heights = []; # idx=exptable rownum
449             DETERMINE_SIZE_OF_EACH_EXPTABLE_COLUMN_AND_ROW: {
450             # 3. before we draw the exptable, we need to determine the width and
451             # height of each exptable column and row.
452             #use DDC;
453 22         23 for my $ir (0..$M-1) {
  22         35  
454 61         77 my $exptable_row = $exptable->[$ir];
455             $exptable_row_heights->[$ir] = max(
456 61   100     80 1, map {$_->[IDX_EXPTABLE_CELL_HEIGHT] // 0} @$exptable_row);
  155         322  
457             }
458              
459 22         43 for my $ic (0..$N-1) {
460             $exptable_column_widths->[$ic] = max(
461 48 50       78 1, map {$exptable->[$_][$ic] ? $exptable->[$_][$ic][IDX_EXPTABLE_CELL_WIDTH] : 0} 0..$M-1);
  149         270  
462             }
463             } # DETERMINE_SIZE_OF_EACH_EXPTABLE_COLUMN_AND_ROW
464             #use DDC; print "column widths: "; dd $exptable_column_widths; # debug
465             #use DDC; print "row heights: "; dd $exptable_row_heights; # debug
466              
467             # each elem is an arrayref containing characters to render a line of the
468             # table, e.g. for element [0] the row is all borders. for element [1]:
469             # [$left_border_str, $exptable_cell_content1, $border_between_col,
470             # $exptable_cell_content2, ...]. all will be joined together with "\n" to
471             # form the final rendered table.
472 22         28 my @buf;
473              
474             DRAW_EXPTABLE: {
475             # 4. finally we draw the (exp)table.
476              
477 22         24 my $y = 0;
  22         25  
478              
479 22         38 for my $ir (0..$M-1) {
480              
481 61 100       186 my %gbcargs = (
482             $header_row >= $ir+1 ? (for_header_row=>1) :
483             (for_data_row=>1),
484             );
485              
486             DRAW_TOP_BORDER:
487             {
488 61 100       92 last unless $ir == 0;
  61         103  
489 21         507 my $b_topleft = $bs_obj->get_border_char(char=>'rd_t', %gbcargs);
490 21         1900 my $b_topline = $bs_obj->get_border_char(char=>'h_t', %gbcargs);
491 21         1700 my $b_topbetwcol = $bs_obj->get_border_char(char=>'hd_t', %gbcargs);
492 21         1714 my $b_topright = $bs_obj->get_border_char(char=>'ld_t', %gbcargs);
493 21 0 33     1380 last unless length $b_topleft || length $b_topline || length $b_topbetwcol || length $b_topright;
      33        
      0        
494 21         51 $buf[$y][0] = $b_topleft;
495 21         51 for my $ic (0..$N-1) {
496 48 100       100 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
497 48   100     112 my $cell_right_has_content = defined $cell_right && _exptable_cell_is_head($cell_right);
498 48         1657 $buf[$y][$ic*4+2] = $bs_obj->get_border_char(char=>'h_t', repeat=>$exptable_column_widths->[$ic], %gbcargs); # +1, +2, +3
499 48 100       3328 $buf[$y][$ic*4+4] = $ic == $N-1 ? $b_topright : ($cell_right_has_content ? $b_topbetwcol : $b_topline);
    100          
500             }
501 21         39 $y++;
502             } # DRAW_TOP_BORDER
503              
504             DRAW_DATA_OR_HEADER_ROW:
505             {
506             # draw leftmost border, which we always do.
507 61         73 for my $i (1 .. $exptable_row_heights->[$ir]) {
  61         121  
508 83         2898 $buf[$y+$i-1][0] = $bs_obj->get_border_char(char=>'v_l', %gbcargs);
509             }
510              
511 61         4167 my $lines;
512 61         100 for my $ic (0..$N-1) {
513 149         209 my $cell = $exptable->[$ir][$ic];
514             # draw cell content. also possibly draw border between
515             # cells. we don't draw border inside a row/colspan.
516 149 100       228 if (_exptable_cell_is_head($cell)) {
517 125         220 $lines = _get_exptable_cell_lines(
518             \%args, $exptable, $exptable_row_heights, $exptable_column_widths,
519             $exptable_bottom_borders, $intercol_width, $ir, $ic);
520 125         178 for my $i (0..$#{$lines}) {
  125         235  
521 195         3548 $buf[$y+$i][$ic*4+0] = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
522 195         13303 $buf[$y+$i][$ic*4+1] = "";
523 195         371 $buf[$y+$i][$ic*4+2] = $lines->[$i];
524 195         331 $buf[$y+$i][$ic*4+3] = "";
525             }
526             #use DDC; say "D: Drawing exptable_cell($ir,$ic): ", DDC::dump($lines);
527             }
528              
529             # draw rightmost border, which we always do.
530 149 100       332 if ($ic == $N-1) {
531 61         99 for my $i (1 .. $exptable_row_heights->[$ir]) {
532 83         2883 $buf[$y+$i-1][$ic*4+4] = $bs_obj->get_border_char(char=>'v_r', %gbcargs);
533             }
534             }
535              
536             }
537             } # DRAW_DATA_OR_HEADER_ROW
538 61         4172 $y += $exptable_row_heights->[$ir];
539              
540 61 100       130 $gbcargs{for_header_data_separator} = 1 if $header_row == $ir+1;
541             DRAW_ROW_SEPARATOR:
542             {
543 61 100       74 last unless $ir < $M-1;
  61         105  
544 40 100       81 last unless $exptable_bottom_borders->[$ir];
545              
546 31         551 my $b_betwrowleft = $bs_obj->get_border_char(char=>'rv_l', %gbcargs);
547 31         2472 my $b_betwrowline = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
548 31         2454 my $b_betwrowbetwcol = $bs_obj->get_border_char(char=>'hv_i', %gbcargs);
549 31         2459 my $b_betwrowright = $bs_obj->get_border_char(char=>'lv_r', %gbcargs);
550 31 0 33     2042 last unless length $b_betwrowleft || length $b_betwrowline || length $b_betwrowbetwcol || length $b_betwrowright;
      33        
      0        
551 31         505 my $b_betwrowbetwcol_notop = $bs_obj->get_border_char(char=>'hd_i', %gbcargs);
552 31         2424 my $b_betwrowbetwcol_nobot = $bs_obj->get_border_char(char=>'hu_i', %gbcargs);
553 31         2419 my $b_betwrowbetwcol_noleft = $bs_obj->get_border_char(char=>'rv_i', %gbcargs);
554 31         2741 my $b_betwrowbetwcol_noright = $bs_obj->get_border_char(char=>'lv_i', %gbcargs);
555 31         2396 my $b_dataorheaderrowleft = $bs_obj->get_border_char(char=>'v_l', %gbcargs);
556 31         2410 my $b_dataorheaderrowbetwcol = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
557 31         2451 my $b_dataorheaderrowright = $bs_obj->get_border_char(char=>'v_r', %gbcargs);
558 31         2035 for my $ic (0..$N-1) {
559 82 100       187 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
560 82 50       153 my $cell_bottom = $ir < $M-1 ? $exptable->[$ir+1][$ic] : undef;
561 82 100 66     286 my $cell_rightbottom = $ir < $M-1 && $ic < $N-1 ? $exptable->[$ir+1][$ic+1] : undef;
562              
563             # leftmost border
564 82 100       130 if ($ic == 0) {
565 31 100       59 $buf[$y][0] = _exptable_cell_is_rowspan_tail($cell_bottom) ? $b_dataorheaderrowleft : $b_betwrowleft;
566             }
567              
568             # along the width of cell content
569 82 100       143 if (_exptable_cell_is_rowspan_head($cell_bottom)) {
570 67         1238 $buf[$y][$ic*4+2] = $bs_obj->get_border_char(char=>'h_i', repeat=>$exptable_column_widths->[$ic], %gbcargs);
571             }
572              
573 82         4559 my $char;
574 82 100       139 if ($ic == $N-1) {
575             # rightmost
576 31 100       52 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
577 6         9 $char = $b_dataorheaderrowright;
578             } else {
579 25         38 $char = $b_betwrowright;
580             }
581             } else {
582             # between cells
583 51 100       167 if (_exptable_cell_is_colspan_tail($cell_right)) {
584 10 100       17 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
585 5 50       9 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
586 5         5 $char = "";
587             } else {
588 0         0 $char = $b_betwrowline;
589             }
590             } else {
591 5         8 $char = $b_betwrowbetwcol_notop;
592             }
593             } else {
594 41 100       58 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
595 7         9 $char = $b_betwrowbetwcol_nobot;
596             } else {
597 34 100       53 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
    100          
598 4 50       8 if (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
599 0         0 $char = $b_dataorheaderrowbetwcol;
600             } else {
601 4         6 $char = $b_betwrowbetwcol_noleft;
602             }
603             } elsif (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
604 6         11 $char = $b_betwrowbetwcol_noright;
605             } else {
606 24         35 $char = $b_betwrowbetwcol;
607             }
608             }
609             }
610             }
611 82         206 $buf[$y][$ic*4+4] = $char;
612              
613             }
614 31         46 $y++;
615             } # DRAW_ROW_SEPARATOR
616 61         128 delete $gbcargs{for_header_data_separator};
617              
618             DRAW_BOTTOM_BORDER:
619             {
620 61 100       65 last unless $ir == $M-1;
  61         147  
621 21         360 my $b_botleft = $bs_obj->get_border_char(char=>'ru_b', %gbcargs);
622 21         1679 my $b_botline = $bs_obj->get_border_char(char=>'h_b', %gbcargs);
623 21         1746 my $b_botbetwcol = $bs_obj->get_border_char(char=>'hu_b', %gbcargs);
624 21         1708 my $b_botright = $bs_obj->get_border_char(char=>'lu_b', %gbcargs);
625 21 0 33     1377 last unless length $b_botleft || length $b_botline || length $b_botbetwcol || length $b_botright;
      33        
      0        
626 21         49 $buf[$y][0] = $b_botleft;
627 21         48 for my $ic (0..$N-1) {
628 48 100       92 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
629 48         802 $buf[$y][$ic*4+2] = $bs_obj->get_border_char(char=>'h_b', repeat=>$exptable_column_widths->[$ic], %gbcargs);
630 48 100       3315 $buf[$y][$ic*4+4] = $ic == $N-1 ? $b_botright : (_exptable_cell_is_colspan_tail($cell_right) ? $b_botline : $b_botbetwcol);
    100          
631             }
632 21         49 $y++;
633             } # DRAW_BOTTOM_BORDER
634              
635             }
636             } # DRAW_EXPTABLE
637              
638 22 100       41 for my $row (@buf) { for (@$row) { $_ = "" if !defined($_) } } # debug. remove undef to "" to save dump width
  156         193  
  1672         2664  
639             #use DDC; dd \@buf;
640 22         56 join "", (map { my $linebuf = $_; join("", grep {defined} @$linebuf)."\n" } @buf);
  156         177  
  156         177  
  1672         2400  
641             }
642              
643             # Back-compat: 'table' is an alias for 'generate_table', but isn't exported
644             {
645 1     1   9 no warnings 'once';
  1         1  
  1         84  
646             *table = \&generate_table;
647             }
648              
649             1;
650             # ABSTRACT: Generate text table with simple interface and many options
651              
652             __END__