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   74316 use 5.010001;
  1         9  
4 1     1   4 use strict;
  1         1  
  1         14  
5 1     1   4 use warnings;
  1         1  
  1         133  
6             #use utf8;
7              
8             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
9             our $DATE = '2022-03-27'; # DATE
10             our $DIST = 'Text-Table-More'; # DIST
11             our $VERSION = '0.025'; # 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   428 use List::AllUtils qw(first firstidx max);
  1         12094  
  1         70  
69              
70 1     1   6 use Exporter qw(import);
  1         2  
  1         3151  
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   325 sub _exptable_cell_is_rowspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] }
92 129 50   129   327 sub _exptable_cell_is_colspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] }
93 149 50 66 149   382 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   199 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   512 sub _exptable_cell_is_head { defined($_[0]) && defined $_[0][IDX_EXPTABLE_CELL_ORIG] }
97              
98             sub _divide_int_to_n_ints {
99 250     250   312 my ($int, $n) = @_;
100 250         223 my $subtot = 0;
101 250         222 my $int_subtot = 0;
102 250         230 my $prev_int_subtot = 0;
103 250         216 my @ints;
104 250         298 for (1..$n) {
105 269         304 $subtot += $int/$n;
106 269         328 $int_subtot = sprintf "%.0f", $subtot;
107 269         304 push @ints, $int_subtot - $prev_int_subtot;
108 269         300 $prev_int_subtot = $int_subtot;
109             }
110 250         330 @ints;
111             }
112              
113             sub _vpad {
114 125     125   181 my ($lines, $num_lines, $width, $which, $pad_char) = @_;
115 125 100       286 return $lines if @$lines >= $num_lines; # we don't do truncate
116 15         17 my @vpadded_lines;
117 15         28 my $pad_line = $pad_char x $width;
118 15 100       40 if ($which =~ /^b/) { # bottom padding
    100          
119 12         24 push @vpadded_lines, @$lines;
120 12         32 push @vpadded_lines, $pad_line for @$lines+1 .. $num_lines;
121             } elsif ($which =~ /^t/) { # top padding
122 1         6 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         4 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         35 \@vpadded_lines;
133             }
134              
135             sub _get_attr {
136 1412     1412   1698 my ($attr_name, $y, $x, $cell_value, $table_args) = @_;
137              
138             CELL_ATTRS_FROM_CELL_VALUE: {
139 1412 100       1357 last unless ref $cell_value eq 'HASH';
  1412         1803  
140 216         231 my $attr_val = $cell_value->{$attr_name};
141 216 100       263 return $attr_val if defined $attr_val;
142             }
143              
144             CELL_ATTRS_FROM_CELL_ATTRS_ARG:
145             {
146 1405 100 66     1230 last unless defined $x && defined $y;
  1405         2821  
147 1199         1160 my $cell_attrs = $table_args->{cell_attrs};
148 1199 100       1470 last unless $cell_attrs;
149 255         287 for my $entry (@$cell_attrs) {
150 255 100 100     469 next unless $entry->[0] == $y && $entry->[1] == $x;
151 32         35 my $attr_val = $entry->[2]{$attr_name};
152 32 100       55 return $attr_val if defined $attr_val;
153             }
154             }
155              
156             COL_ATTRS:
157             {
158 1402 100       1215 last unless defined $x;
  1402         1682  
159 1196         1076 my $col_attrs = $table_args->{col_attrs};
160 1196 100       1487 last unless $col_attrs;
161 252         265 for my $entry (@$col_attrs) {
162 252 100       366 next unless $entry->[0] == $x;
163 72         72 my $attr_val = $entry->[1]{$attr_name};
164 72 100       106 return $attr_val if defined $attr_val;
165             }
166             }
167              
168             ROW_ATTRS:
169             {
170 1393 50       1237 last unless defined $y;
  1393         1607  
171 1393         1274 my $row_attrs = $table_args->{row_attrs};
172 1393 100       1614 last unless $row_attrs;
173 373         396 for my $entry (@$row_attrs) {
174 373 100       498 next unless $entry->[0] == $y;
175 128         128 my $attr_val = $entry->[1]{$attr_name};
176 128 100       189 return $attr_val if defined $attr_val;
177             }
178             }
179              
180             TABLE_ARGS:
181             {
182 1384         1247 my $attr_val = $table_args->{$attr_name};
  1384         1326  
183 1384 100       1812 return $attr_val if defined $attr_val;
184             }
185              
186 1103         1732 undef;
187             }
188              
189             sub _get_exptable_cell_lines {
190 125     125   179 my ($table_args, $exptable, $row_heights, $column_widths,
191             $bottom_borders, $intercol_width, $y, $x) = @_;
192              
193 125         131 my $exptable_cell = $exptable->[$y][$x];
194 125         148 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
195 125         139 my $text = $exptable_cell->[IDX_EXPTABLE_CELL_TEXT];
196 125   100     174 my $align = _get_attr('align', $y, $x, $cell, $table_args) // 'left';
197 125   100     183 my $valign = _get_attr('valign', $y, $x, $cell, $table_args) // 'top';
198 125 100       204 my $pad = $align eq 'left' ? 'r' : $align eq 'right' ? 'l' : 'c';
    100          
199 125 100       162 my $vpad = $valign eq 'top' ? 'b' : $valign eq 'bottom' ? 't' : 'c';
    100          
200 125         127 my $pad_char = $table_args->{pad_char};
201 125         123 my $height = 0;
202 125         148 my $width = 0;
203 125         178 for my $ic (1..$exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN]) {
204 134         152 $width += $column_widths->[$x+$ic-1];
205 134 100       188 $width += $intercol_width if $ic > 1;
206             }
207 125         148 for my $ir (1..$exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN]) {
208 135         151 $height += $row_heights->[$y+$ir-1];
209 135 100 100     318 $height++ if $bottom_borders->[$y+$ir-2] && $ir > 1;
210             }
211              
212 125         183 my @datalines = map { $_pad_func->($_, $width, $pad, $pad_char, 'truncate') }
  170         1222  
213             ($_split_lines_func->($text));
214 125         2290 _vpad(\@datalines, $height, $width, $vpad, $pad_char);
215             }
216              
217             sub generate_table {
218 22     22 1 98787 require Module::Load::Util;
219 22         1518 require Text::NonWideChar::Util;
220              
221 22         246 my %args = @_;
222 22   100     73 $args{header_row} //= 0; my $header_row = $args{header_row};
  22         32  
223 22   50     83 $args{pad_char} //= ' ';
224 22   100     64 $args{hpad} //= 1;
225 22   100     78 $args{vpad} //= 0;
226              
227 22 50       37 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     125 'ASCII::SingleLineDoubleAfterHeader';
      33        
      50        
232 22   100     60 my $cell_attrs = $args{cell_attrs} // [];
233              
234 22         1107 my $bs_obj = Module::Load::Util::instantiate_class_with_optional_args({ns_prefix=>"BorderStyle"}, $bs_name);
235              
236             DETERMINE_CODES: {
237 22         11264 my $color = $args{color};
  22         30  
238 22         29 my $wide_char = $args{wide_char};
239              
240             # split_lines
241 22 100       39 if ($color) {
242 1         3 require Text::ANSI::Util;
243 1     9   8 $_split_lines_func = sub { Text::ANSI::Util::ta_add_color_resets(split /\R/, $_[0]) };
  9         34  
244             } else {
245 21     116   96 $_split_lines_func = sub { split /\R/, $_[0] };
  116         305  
246             }
247              
248             # pad & length_height
249 22 100       47 if ($color) {
250 1 50       3 if ($wide_char) {
251 1         369 require Text::ANSI::WideUtil;
252 1         295 $_pad_func = \&Text::ANSI::WideUtil::ta_mbpad;
253 1         3 $_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       34 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         404 require String::Pad;
266 21         450 require Text::NonWideChar::Util;
267 21         32 $_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         406 my $intercol_width = length($bs_obj->get_border_char(char=>'v_i'));
276              
277 22         1558 my $exptable = []; # [ [[$orig_rowidx,$orig_colidx,$rowspan,$colspan,...], ...], [[...], ...], ... ]
278 22         27 my $exptable_bottom_borders = []; # idx=exptable rownum, val=bool
279 22         24 my $M = 0; # number of rows in the exptable
280 22         23 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         23 my $rownum;
  22         21  
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         30 $rownum = -1;
296 22         33 for my $row (@$rows) {
297 61         61 $rownum++;
298 61         61 my $colnum = -1;
299 61         56 my $separator_type = do {
300 61         77 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       106 $cmp==0 ? 2 : $cmp==1 ? 8 : 4;
    100          
305             };
306 61   100     178 $exptable->[$rownum] //= [];
307 61         94 push @{ $exptable->[$rownum] }, undef
308 61 50 66     61 if (@{ $exptable->[$rownum] } == 0 ||
  61         143  
309             defined($exptable->[$rownum][-1]));
310             #use DDC; say "D:exptable->[$rownum] = ", DDC::dump($exptable->[$rownum]);
311 61     66   134 my $exptable_colnum = firstidx {!defined} @{ $exptable->[$rownum] };
  66         99  
  61         152  
312             #say "D:rownum=$rownum, exptable_colnum=$exptable_colnum";
313 61 50       143 if ($exptable_colnum == -1) { $exptable_colnum = 0 }
  0         0  
314 61 100 66     198 $exptable_bottom_borders->[$rownum] //= $args{separate_rows} ? $separator_type : 0;
315              
316 61         77 for my $cell (@$row) {
317 125         123 $colnum++;
318 125         112 my $text;
319              
320 125         131 my $rowspan = 1;
321 125         116 my $colspan = 1;
322 125 100       159 if (ref $cell eq 'HASH') {
323 21         31 $text = $cell->{text};
324 21 100       37 $rowspan = $cell->{rowspan} if $cell->{rowspan};
325 21 100       43 $colspan = $cell->{colspan} if $cell->{colspan};
326             } else {
327 104         110 $text = $cell;
328 104         94 my $el;
329 104 100 100 21   292 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{rowspan}} @$cell_attrs;
  21         57  
330 104 50       224 $rowspan = $el->[2]{rowspan} if $el;
331 104 100 100 21   223 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{colspan}} @$cell_attrs;
  21         47  
332 104 50       191 $colspan = $el->[2]{colspan} if $el;
333             }
334              
335 125         132 my @widths;
336             my @heights;
337             ROW:
338 125         170 for my $ir (1..$rowspan) {
339 135         147 for my $ic (1..$colspan) {
340 149         139 my $exptable_cell;
341 149         203 $exptable->[$rownum+$ir-1][$exptable_colnum+$ic-1] = $exptable_cell = [];
342              
343 149         177 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG_ROWNUM] = $rownum;
344 149         179 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG_COLNUM] = $colnum;
345              
346 149 100 100     318 if ($ir == 1 && $ic == 1) {
347 125         148 $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN] = $rowspan;
348 125         121 $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN] = $colspan;
349 125         185 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG] = $cell;
350             } else {
351 24 100       65 $exptable_cell->[IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] = 1 if $ir > 1;
352 24 100       40 $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     262 if ($rownum+$ir-1 == 0 && $header_row > 0) {
359 32         41 $exptable_bottom_borders->[0] = $separator_type;
360             } else {
361 103         107 my $val;
362 103 100       166 $val = _get_attr('bottom_border', $rownum+$ir-1, 0, $cell, \%args); $exptable_bottom_borders->[$rownum+$ir-1] = $separator_type if $val;
  103         137  
363 103 50       158 $val = _get_attr('top_border' , $rownum+$ir-1, 0, $cell, \%args); $exptable_bottom_borders->[$rownum+$ir-2] = $separator_type if $val;
  103         134  
364 103 100       156 $val = _get_attr('bottom_border', $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-1] = $separator_type if $val;
  103         137  
365 103 50       125 $val = _get_attr('top_border' , $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-2] = $separator_type if $val;
  103         142  
366             }
367              
368 135 100       199 $M = $rownum+$ir if $M < $rownum+$ir;
369             }
370              
371 125         140 $exptable_colnum += $colspan;
372 125         213 $exptable_colnum++ while defined $exptable->[$rownum][$exptable_colnum];
373              
374             } # for a row
375 61 100       91 $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         35 for my $exptable_rownum (0..$M-1) {
383 61         88 for my $exptable_colnum (0..$N-1) {
384 149         180 my $exptable_cell = $exptable->[$exptable_rownum][$exptable_colnum];
385 149 100       171 next if _exptable_cell_is_tail($exptable_cell);
386 125         142 my $rowspan = $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN];
387 125         115 my $colspan = $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN];
388 125         121 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
389 125 100       186 my $text = ref $cell eq 'HASH' ? $cell->{text} : $cell;
390              
391             # pad the text, put in exptable text
392 125         172 my $hpad = _get_attr('hpad', $exptable_rownum, $exptable_colnum, $cell, \%args);
393 125   100     177 my $lpad = _get_attr('lpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $hpad;
394 125   100     184 my $rpad = _get_attr('rpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $hpad;
395 125         183 my $vpad = _get_attr('vpad', $exptable_rownum, $exptable_colnum, $cell, \%args);
396 125   100     153 my $tpad = _get_attr('tpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $vpad;
397 125   100     162 my $bpad = _get_attr('bpad', $exptable_rownum, $exptable_colnum, $cell, \%args) // $vpad;
398 125         143 my $pad_char = $args{pad_char};
399 125 100       155 if ($lpad > 0) { my $p = $pad_char x $lpad; $text =~ s/^/$p/gm }
  117         136  
  117         340  
400 125 100       203 if ($rpad > 0) { my $p = $pad_char x $rpad; $text =~ s/$/$p/gm }
  116         129  
  116         264  
401 125 100       176 if ($tpad > 0) { $text = ("\n" x $tpad) . $text }
  9         14  
402 125 100       166 if ($bpad > 0) { $text = $text . ("\n$pad_char" x $bpad) }
  9         14  
403 125         147 $exptable_cell->[IDX_EXPTABLE_CELL_TEXT] = $text;
404              
405 125         224 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         1946 my $tot_intercol_widths = ($colspan-1) * $intercol_width;
409 125 50       125 my $tot_interrow_heights = 0; for (1..$rowspan-1) { $tot_interrow_heights++ if $exptable_bottom_borders->[$exptable_rownum+$_-1] }
  125         170  
  10         25  
410             #say "D:tot_intercol_widths=$tot_intercol_widths";
411             #say "D:to_interrow_heights=$tot_interrow_heights";
412 125         257 my @heights = _divide_int_to_n_ints(max(0, $lh->[1] - $tot_interrow_heights), $rowspan);
413 125         200 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         144 for my $ir (1..$rowspan) {
416 135         137 for my $ic (1..$colspan) {
417 149         224 $exptable->[$exptable_rownum+$ir-1][$exptable_colnum+$ic-1][IDX_EXPTABLE_CELL_HEIGHT] = $heights[$ir-1];
418 149         313 $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         24 1;
  22         22  
444             } # OPTIMIZE_EXPTABLE
445             #use DDC; dd $exptable; # debug
446              
447 22         36 my $exptable_column_widths = []; # idx=exptable colnum
448 22         26 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         25 for my $ir (0..$M-1) {
  22         37  
454 61         66 my $exptable_row = $exptable->[$ir];
455             $exptable_row_heights->[$ir] = max(
456 61   100     77 1, map {$_->[IDX_EXPTABLE_CELL_HEIGHT] // 0} @$exptable_row);
  155         285  
457             }
458              
459 22         35 for my $ic (0..$N-1) {
460             $exptable_column_widths->[$ic] = max(
461 48 50       64 1, map {$exptable->[$_][$ic] ? $exptable->[$_][$ic][IDX_EXPTABLE_CELL_WIDTH] : 0} 0..$M-1);
  149         259  
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         26 my @buf;
473              
474             DRAW_EXPTABLE: {
475             # 4. finally we draw the (exp)table.
476              
477 22         25 my $y = 0;
  22         24  
478              
479 22         31 for my $ir (0..$M-1) {
480              
481 61 100       157 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       70 last unless $ir == 0;
  61         83  
489 21         415 my $b_topleft = $bs_obj->get_border_char(char=>'rd_t', %gbcargs);
490 21         1687 my $b_topline = $bs_obj->get_border_char(char=>'h_t', %gbcargs);
491 21         1513 my $b_topbetwcol = $bs_obj->get_border_char(char=>'hd_t', %gbcargs);
492 21         1473 my $b_topright = $bs_obj->get_border_char(char=>'ld_t', %gbcargs);
493 21 0 33     1196 last unless length $b_topleft || length $b_topline || length $b_topbetwcol || length $b_topright;
      33        
      0        
494 21         40 $buf[$y][0] = $b_topleft;
495 21         43 for my $ic (0..$N-1) {
496 48 100       87 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
497 48   100     93 my $cell_right_has_content = defined $cell_right && _exptable_cell_is_head($cell_right);
498 48         699 $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       2922 $buf[$y][$ic*4+4] = $ic == $N-1 ? $b_topright : ($cell_right_has_content ? $b_topbetwcol : $b_topline);
    100          
500             }
501 21         29 $y++;
502             } # DRAW_TOP_BORDER
503              
504             DRAW_DATA_OR_HEADER_ROW:
505             {
506             # draw leftmost border, which we always do.
507 61         61 for my $i (1 .. $exptable_row_heights->[$ir]) {
  61         106  
508 83         2518 $buf[$y+$i-1][0] = $bs_obj->get_border_char(char=>'v_l', %gbcargs);
509             }
510              
511 61         3569 my $lines;
512 61         91 for my $ic (0..$N-1) {
513 149         177 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       191 if (_exptable_cell_is_head($cell)) {
517 125         222 $lines = _get_exptable_cell_lines(
518             \%args, $exptable, $exptable_row_heights, $exptable_column_widths,
519             $exptable_bottom_borders, $intercol_width, $ir, $ic);
520 125         166 for my $i (0..$#{$lines}) {
  125         195  
521 195         2983 $buf[$y+$i][$ic*4+0] = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
522 195         11669 $buf[$y+$i][$ic*4+1] = "";
523 195         335 $buf[$y+$i][$ic*4+2] = $lines->[$i];
524 195         293 $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       268 if ($ic == $N-1) {
531 61         88 for my $i (1 .. $exptable_row_heights->[$ir]) {
532 83         2390 $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         3534 $y += $exptable_row_heights->[$ir];
539              
540 61 100       103 $gbcargs{for_header_data_separator} = 1 if $header_row == $ir+1;
541             DRAW_ROW_SEPARATOR:
542             {
543 61 100       62 last unless $ir < $M-1;
  61         90  
544 40 100       68 last unless $exptable_bottom_borders->[$ir];
545              
546 31         437 my $b_betwrowleft = $bs_obj->get_border_char(char=>'rv_l', %gbcargs);
547 31         2110 my $b_betwrowline = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
548 31         2073 my $b_betwrowbetwcol = $bs_obj->get_border_char(char=>'hv_i', %gbcargs);
549 31         2092 my $b_betwrowright = $bs_obj->get_border_char(char=>'lv_r', %gbcargs);
550 31 0 33     1716 last unless length $b_betwrowleft || length $b_betwrowline || length $b_betwrowbetwcol || length $b_betwrowright;
      33        
      0        
551 31         417 my $b_betwrowbetwcol_notop = $bs_obj->get_border_char(char=>'hd_i', %gbcargs);
552 31         2106 my $b_betwrowbetwcol_nobot = $bs_obj->get_border_char(char=>'hu_i', %gbcargs);
553 31         2066 my $b_betwrowbetwcol_noleft = $bs_obj->get_border_char(char=>'rv_i', %gbcargs);
554 31         2058 my $b_betwrowbetwcol_noright = $bs_obj->get_border_char(char=>'lv_i', %gbcargs);
555 31         2083 my $b_dataorheaderrowleft = $bs_obj->get_border_char(char=>'v_l', %gbcargs);
556 31         2050 my $b_dataorheaderrowbetwcol = $bs_obj->get_border_char(char=>'v_i', %gbcargs);
557 31         2082 my $b_dataorheaderrowright = $bs_obj->get_border_char(char=>'v_r', %gbcargs);
558 31         1766 for my $ic (0..$N-1) {
559 82 100       418 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
560 82 50       131 my $cell_bottom = $ir < $M-1 ? $exptable->[$ir+1][$ic] : undef;
561 82 100 66     205 my $cell_rightbottom = $ir < $M-1 && $ic < $N-1 ? $exptable->[$ir+1][$ic+1] : undef;
562              
563             # leftmost border
564 82 100       112 if ($ic == 0) {
565 31 100       52 $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       105 if (_exptable_cell_is_rowspan_head($cell_bottom)) {
570 67         1027 $buf[$y][$ic*4+2] = $bs_obj->get_border_char(char=>'h_i', repeat=>$exptable_column_widths->[$ic], %gbcargs);
571             }
572              
573 82         3957 my $char;
574 82 100       124 if ($ic == $N-1) {
575             # rightmost
576 31 100       40 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
577 6         8 $char = $b_dataorheaderrowright;
578             } else {
579 25         30 $char = $b_betwrowright;
580             }
581             } else {
582             # between cells
583 51 100       62 if (_exptable_cell_is_colspan_tail($cell_right)) {
584 10 100       13 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
585 5 50       8 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
586 5         8 $char = "";
587             } else {
588 0         0 $char = $b_betwrowline;
589             }
590             } else {
591 5         6 $char = $b_betwrowbetwcol_notop;
592             }
593             } else {
594 41 100       58 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
595 7         10 $char = $b_betwrowbetwcol_nobot;
596             } else {
597 34 100       46 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
    100          
598 4 50       6 if (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
599 0         0 $char = $b_dataorheaderrowbetwcol;
600             } else {
601 4         5 $char = $b_betwrowbetwcol_noleft;
602             }
603             } elsif (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
604 6         8 $char = $b_betwrowbetwcol_noright;
605             } else {
606 24         29 $char = $b_betwrowbetwcol;
607             }
608             }
609             }
610             }
611 82         162 $buf[$y][$ic*4+4] = $char;
612              
613             }
614 31         35 $y++;
615             } # DRAW_ROW_SEPARATOR
616 61         76 delete $gbcargs{for_header_data_separator};
617              
618             DRAW_BOTTOM_BORDER:
619             {
620 61 100       57 last unless $ir == $M-1;
  61         123  
621 21         319 my $b_botleft = $bs_obj->get_border_char(char=>'ru_b', %gbcargs);
622 21         1459 my $b_botline = $bs_obj->get_border_char(char=>'h_b', %gbcargs);
623 21         1469 my $b_botbetwcol = $bs_obj->get_border_char(char=>'hu_b', %gbcargs);
624 21         1436 my $b_botright = $bs_obj->get_border_char(char=>'lu_b', %gbcargs);
625 21 0 33     1219 last unless length $b_botleft || length $b_botline || length $b_botbetwcol || length $b_botright;
      33        
      0        
626 21         52 $buf[$y][0] = $b_botleft;
627 21         40 for my $ic (0..$N-1) {
628 48 100       134 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
629 48         700 $buf[$y][$ic*4+2] = $bs_obj->get_border_char(char=>'h_b', repeat=>$exptable_column_widths->[$ic], %gbcargs);
630 48 100       2837 $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         44 $y++;
633             } # DRAW_BOTTOM_BORDER
634              
635             }
636             } # DRAW_EXPTABLE
637              
638 22 100       40 for my $row (@buf) { for (@$row) { $_ = "" if !defined($_) } } # debug. remove undef to "" to save dump width
  156         164  
  1672         2201  
639             #use DDC; dd \@buf;
640 22         46 join "", (map { my $linebuf = $_; join("", grep {defined} @$linebuf)."\n" } @buf);
  156         151  
  156         162  
  1672         2098  
641             }
642              
643             # Back-compat: 'table' is an alias for 'generate_table', but isn't exported
644             {
645 1     1   6 no warnings 'once';
  1         2  
  1         64  
646             *table = \&generate_table;
647             }
648              
649             1;
650             # ABSTRACT: Generate text table with simple interface and many options
651              
652             __END__