File Coverage

blib/lib/Text/Table/Span.pm
Criterion Covered Total %
statement 303 331 91.5
branch 140 190 73.6
condition 48 90 53.3
subroutine 20 22 90.9
pod 1 1 100.0
total 512 634 80.7


line stmt bran cond sub pod time code
1             package Text::Table::Span;
2              
3             our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4             our $DATE = '2021-02-20'; # DATE
5             our $DIST = 'Text-Table-Span'; # DIST
6             our $VERSION = '0.008'; # VERSION
7              
8 1     1   69466 use 5.010001;
  1         12  
9 1     1   5 use strict;
  1         2  
  1         22  
10 1     1   15 use warnings;
  1         2  
  1         34  
11              
12 1     1   639 use List::AllUtils qw(first firstidx max);
  1         17367  
  1         99  
13              
14 1     1   8 use Exporter qw(import);
  1         2  
  1         4363  
15             our @EXPORT_OK = qw/ generate_table /;
16              
17             our $_split_lines_func;
18             our $_pad_func;
19             our $_length_height_func;
20              
21             # consts
22             sub IDX_EXPTABLE_CELL_ROWSPAN() {0} # number of rowspan, only defined for the rowspan head
23             sub IDX_EXPTABLE_CELL_COLSPAN() {1} # number of colspan, only defined for the colspan head
24             sub IDX_EXPTABLE_CELL_WIDTH() {2} # visual width. this does not include the cell padding.
25             sub IDX_EXPTABLE_CELL_HEIGHT() {3} # visual height. this does not include row separator.
26             sub IDX_EXPTABLE_CELL_ORIG() {4} # str/hash
27             sub IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL() {5} # whether this cell is tail of a rowspan
28             sub IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL() {6} # whether this cell is tail of a colspan
29              
30             # whether an exptable cell is the head (1st cell) or tail (the rest) of a
31             # rowspan/colspan. these should be macros if possible, for speed.
32 15 50   15   55 sub _exptable_cell_is_rowspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] }
33 14 50   14   47 sub _exptable_cell_is_colspan_tail { defined($_[0]) && $_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] }
34 12 50 66 12   52 sub _exptable_cell_is_tail { defined($_[0]) && ($_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] || $_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL]) }
35 9 50   9   37 sub _exptable_cell_is_rowspan_head { defined($_[0]) && !$_[0][IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] }
36 0 0   0   0 sub _exptable_cell_is_colspan_head { defined($_[0]) && !$_[0][IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] }
37 14 50   14   62 sub _exptable_cell_is_head { defined($_[0]) && defined $_[0][IDX_EXPTABLE_CELL_ORIG] }
38              
39             sub _divide_int_to_n_ints {
40 18     18   31 my ($int, $n) = @_;
41 18         25 my $subtot = 0;
42 18         21 my $int_subtot = 0;
43 18         25 my $prev_int_subtot = 0;
44 18         21 my @ints;
45 18         28 for (1..$n) {
46 20         36 $subtot += $int/$n;
47 20         39 $int_subtot = sprintf "%.0f", $subtot;
48 20         33 push @ints, $int_subtot - $prev_int_subtot;
49 20         32 $prev_int_subtot = $int_subtot;
50             }
51 18         37 @ints;
52             }
53              
54             sub _vpad {
55 9     9   21 my ($lines, $num_lines, $width, $which) = @_;
56 9 100       37 return $lines if @$lines >= $num_lines; # we don't do truncate
57 2         4 my @vpadded_lines;
58 2         6 my $pad_line = " " x $width;
59 2 50       12 if ($which =~ /^b/) { # bottom padding
    0          
60 2         6 push @vpadded_lines, @$lines;
61 2         10 push @vpadded_lines, $pad_line for @$lines+1 .. $num_lines;
62             } elsif ($which =~ /^t/) { # top padding
63 0         0 push @vpadded_lines, $pad_line for @$lines+1 .. $num_lines;
64 0         0 push @vpadded_lines, @$lines;
65             } else { # center padding
66 0         0 my $p = $num_lines - @$lines;
67 0         0 my $p1 = int($p/2);
68 0         0 my $p2 = $p - $p1;
69 0         0 push @vpadded_lines, $pad_line for 1..$p1;
70 0         0 push @vpadded_lines, @$lines;
71 0         0 push @vpadded_lines, $pad_line for 1..$p2;
72             }
73 2         8 \@vpadded_lines;
74             }
75              
76             sub _get_attr {
77 38     38   72 my ($attr_name, $y, $x, $cell_value, $table_args) = @_;
78              
79             CELL_ATTRS_FROM_CELL_VALUE: {
80 38 100       48 last unless ref $cell_value eq 'HASH';
  38         79  
81 4         9 my $attr_val = $cell_value->{$attr_name};
82 4 100       14 return $attr_val if defined $attr_val;
83             }
84              
85             CELL_ATTRS_FROM_CELL_ATTRS_ARG:
86             {
87 37 100 66     51 last unless defined $x && defined $y;
  37         89  
88 17         30 my $cell_attrs = $table_args->{cell_attrs};
89 17 50       25 last unless $cell_attrs;
90 17         28 for my $entry (@$cell_attrs) {
91 17 100 100     52 next unless $entry->[0] == $y && $entry->[1] == $x;
92 2         6 my $attr_val = $entry->[2]{$attr_name};
93 2 100       9 return $attr_val if defined $attr_val;
94             }
95             }
96              
97             COL_ATTRS:
98             {
99 36 100       45 last unless defined $x;
  36         63  
100 16         24 my $col_attrs = $table_args->{col_attrs};
101 16 50       31 last unless $col_attrs;
102 16         25 for my $entry (@$col_attrs) {
103 16 100       32 next unless $entry->[0] == $x;
104 6         10 my $attr_val = $entry->[1]{$attr_name};
105 6 100       19 return $attr_val if defined $attr_val;
106             }
107             }
108              
109             ROW_ATTRS:
110             {
111 33 50       46 last unless defined $y;
  33         51  
112 33         52 my $row_attrs = $table_args->{row_attrs};
113 33 50       55 last unless $row_attrs;
114 33         57 for my $entry (@$row_attrs) {
115 33 100       69 next unless $entry->[0] == $y;
116 11         20 my $attr_val = $entry->[1]{$attr_name};
117 11 100       27 return $attr_val if defined $attr_val;
118             }
119             }
120              
121             TABLE_ARGS:
122             {
123 31         37 my $attr_val = $table_args->{$attr_name};
  31         50  
124 31 100       60 return $attr_val if defined $attr_val;
125             }
126              
127 29         58 undef;
128             }
129              
130             sub _get_exptable_cell_lines {
131 9     9   22 my ($table_args, $exptable, $row_heights, $column_widths,
132             $bottom_borders, $intercol_width, $y, $x) = @_;
133              
134 9         16 my $exptable_cell = $exptable->[$y][$x];
135 9         12 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
136 9 100       25 my $text = ref $cell eq 'HASH' ? $cell->{text} : $cell;
137 9   50     19 my $align = _get_attr('align', $y, $x, $cell, $table_args) // 'left';
138 9   50     21 my $valign = _get_attr('valign', $y, $x, $cell, $table_args) // 'top';
139 9 100       25 my $pad = $align eq 'left' ? 'r' : $align eq 'right' ? 'l' : 'c';
    100          
140 9 0       21 my $vpad = $valign eq 'top' ? 'b' : $valign eq 'bottom' ? 't' : 'c';
    50          
141 9         11 my $height = 0;
142 9         17 my $width = 0;
143 9         17 for my $ic (1..$exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN]) {
144 10         18 $width += $column_widths->[$x+$ic-1];
145 10 100       24 $width += $intercol_width if $ic > 1;
146             }
147 9         17 for my $ir (1..$exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN]) {
148 10         16 $height += $row_heights->[$y+$ir-1];
149 10 100 66     39 $height++ if $bottom_borders->[$y+$ir-2] && $ir > 1;
150             }
151              
152 9         22 my @datalines = map { $_pad_func->($_, $width, $pad, ' ', 'truncate') }
  12         540  
153             ($_split_lines_func->($text));
154 9         434 _vpad(\@datalines, $height, $width, $vpad);
155             }
156              
157             sub generate_table {
158 1     1 1 2215 require Module::Load::Util;
159 1         2051 require Text::NonWideChar::Util;
160              
161 1         302 my %args = @_;
162 1 50       6 my $rows = $args{rows} or die "Please specify rows";
163 1   50     8 my $bs_name = $args{border_style} // 'ASCII::SingleLineDoubleAfterHeader';
164 1   50     4 my $cell_attrs = $args{cell_attrs} // [];
165              
166 1         6 my $bs_obj = Module::Load::Util::instantiate_class_with_optional_args({ns_prefix=>"BorderStyle"}, $bs_name);
167              
168             DETERMINE_CODES: {
169 1         3499 my $color = $args{color};
  1         22  
170 1         3 my $wide_char = $args{wide_char};
171              
172             # split_lines
173 1 50       5 if ($color) {
174 1         579 require Text::ANSI::Util;
175 1     9   5858 $_split_lines_func = sub { Text::ANSI::Util::ta_add_color_resets(split /\R/, $_[0]) };
  9         56  
176             } else {
177 0     0   0 $_split_lines_func = sub { split /\R/, $_[0] };
  0         0  
178             }
179              
180             # pad & length_height
181 1 50       7 if ($color) {
182 1 50       4 if ($wide_char) {
183 1         683 require Text::ANSI::WideUtil;
184 1         62455 $_pad_func = \&Text::ANSI::WideUtil::ta_mbpad;
185 1         5 $_length_height_func = \&Text::ANSI::WideUtil::ta_mbswidth_height;
186             } else {
187 0         0 require Text::ANSI::Util;
188 0         0 $_pad_func = \&Text::ANSI::Util::ta_pad;
189 0         0 $_length_height_func = \&Text::ANSI::Util::ta_length_height;
190             }
191             } else {
192 0 0       0 if ($wide_char) {
193 0         0 require Text::WideChar::Util;
194 0         0 $_pad_func = \&Text::WideChar::Util::mbpad;
195 0         0 $_length_height_func = \&Text::WideChar::Util::mbswidth_height;
196             } else {
197 0         0 require String::Pad;
198 0         0 require Text::NonWideChar::Util;
199 0         0 $_pad_func = \&String::Pad::pad;
200 0         0 $_length_height_func = \&Text::NonWideChar::Util::length_height;
201             }
202             }
203             }
204              
205             # XXX when we allow cell attrs right_border and left_border, this will
206             # become array too like $exptable_bottom_borders.
207 1         15 my $intercol_width = length(" " . $bs_obj->get_border_char(3, 1) . " ");
208              
209 1         56 my $exptable = []; # [ [[$orig_rowidx,$orig_colidx,$rowspan,$colspan,...], ...], [[...], ...], ... ]
210 1         2 my $exptable_bottom_borders = []; # idx=exptable rownum, val=bool
211 1         3 my $M = 0; # number of rows in the exptable
212 1         2 my $N = 0; # number of columns in the exptable
213             CONSTRUCT_EXPTABLE: {
214             # 1. the first step is to construct a 2D array we call "exptable" (short
215             # for expanded table), which is like the original table but with all the
216             # spanning rows/columns split into the smaller boxes so it's easier to
217             # draw later. for example, a table cell with colspan=2 will become 2
218             # exptable cells. an m-row x n-column table will become M-row x N-column
219             # exptable, where M>=m, N>=n.
220              
221 1         3 my $rownum;
  1         2  
222              
223             # 1a. first substep: construct exptable and calculate everything except
224             # each exptable cell's width and height, because this will require
225             # information from the previous substeps.
226              
227 1         3 $rownum = -1;
228 1         3 for my $row (@$rows) {
229 4         7 $rownum++;
230 4         7 my $colnum = -1;
231 4   100     18 $exptable->[$rownum] //= [];
232 4         10 push @{ $exptable->[$rownum] }, undef
233 4 50 66     5 if (@{ $exptable->[$rownum] } == 0 ||
  4         17  
234             defined($exptable->[$rownum][-1]));
235             #use DDC; say "D:exptable->[$rownum] = ", DDC::dump($exptable->[$rownum]);
236 4     4   14 my $exptable_colnum = firstidx {!defined} @{ $exptable->[$rownum] };
  4         10  
  4         18  
237             #say "D:rownum=$rownum, exptable_colnum=$exptable_colnum";
238 4 50       19 if ($exptable_colnum == -1) { $exptable_colnum = 0 }
  0         0  
239 4 50 33     23 $exptable_bottom_borders->[$rownum] //= $args{separate_rows} ? 1:0;
240              
241 4         9 for my $cell (@$row) {
242 9         13 $colnum++;
243 9         12 my $text;
244              
245 9         12 my $rowspan = 1;
246 9         12 my $colspan = 1;
247 9 100       19 if (ref $cell eq 'HASH') {
248 2         6 $text = $cell->{text};
249 2 100       7 $rowspan = $cell->{rowspan} if $cell->{rowspan};
250 2 100       7 $colspan = $cell->{colspan} if $cell->{colspan};
251             } else {
252 7         11 $text = $cell;
253 7         9 my $el;
254 7 100 66 7   30 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{rowspan}} @$cell_attrs;
  7         27  
255 7 50       23 $rowspan = $el->[2]{rowspan} if $el;
256 7 100 66 7   21 $el = first {$_->[0] == $rownum && $_->[1] == $colnum && $_->[2]{colspan}} @$cell_attrs;
  7         23  
257 7 50       21 $colspan = $el->[2]{colspan} if $el;
258             }
259              
260 9         13 my @widths;
261             my @heights;
262 9         21 for my $ir (1..$rowspan) {
263 10         17 for my $ic (1..$colspan) {
264 12         16 my $exptable_cell;
265 12         81 $exptable->[$rownum+$ir-1][$exptable_colnum+$ic-1] = $exptable_cell = [];
266              
267 12 100 100     44 if ($ir == 1 && $ic == 1) {
268 9         18 $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN] = $rowspan;
269 9         13 $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN] = $colspan;
270 9         18 $exptable_cell->[IDX_EXPTABLE_CELL_ORIG] = $cell;
271             } else {
272 3 100       8 $exptable_cell->[IDX_EXPTABLE_CELL_IS_ROWSPAN_TAIL] = 1 if $ir > 1;
273 3 100       9 $exptable_cell->[IDX_EXPTABLE_CELL_IS_COLSPAN_TAIL] = 1 if $ic > 1;
274             }
275             #use DDC; dd $exptable; say ''; # debug
276             }
277              
278 10         14 my $val;
279 10 50       26 $val = _get_attr('bottom_border', $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-1] = $val if $val;
  10         21  
280 10 50       20 $val = _get_attr('top_border' , $rownum+$ir-1, undef, undef, \%args); $exptable_bottom_borders->[$rownum+$ir-2] = $val if $val;
  10         22  
281 10 50 66     29 $exptable_bottom_borders->[0] = 1 if $rownum+$ir-1 == 0 && $args{header_row};
282              
283 10 100       25 $M = $rownum+$ir if $M < $rownum+$ir;
284             }
285              
286 9         12 $exptable_colnum += $colspan;
287 9         23 $exptable_colnum++ while defined $exptable->[$rownum][$exptable_colnum];
288              
289             } # for a row
290 4 100       11 $N = $exptable_colnum if $N < $exptable_colnum;
291             } # for rows
292              
293             # 1b. calculate the heigth and width of each exptable cell (as required
294             # by the text, or specified width/height when we allow cell attrs width,
295             # height)
296              
297 1         5 for my $exptable_rownum (0..$M-1) {
298 4         8 for my $exptable_colnum (0..$N-1) {
299 12         17 my $exptable_cell = $exptable->[$exptable_rownum][$exptable_colnum];
300 12 100       25 next if _exptable_cell_is_tail($exptable_cell);
301 9         14 my $rowspan = $exptable_cell->[IDX_EXPTABLE_CELL_ROWSPAN];
302 9         14 my $colspan = $exptable_cell->[IDX_EXPTABLE_CELL_COLSPAN];
303 9         13 my $cell = $exptable_cell->[IDX_EXPTABLE_CELL_ORIG];
304 9 100       22 my $text = ref $cell eq 'HASH' ? $cell->{text} : $cell;
305 9         23 my $lh = $_length_height_func->($text);
306             #use DDC; say "D:length_height[$exptable_rownum,$exptable_colnum] = (".DDC::dump($text)."): ".DDC::dump($lh);
307 9         491 my $tot_intercol_widths = ($colspan-1) * $intercol_width;
308 9 50       15 my $tot_interrow_heights = 0; for (1..$rowspan-1) { $tot_interrow_heights++ if $exptable_bottom_borders->[$exptable_rownum+$_-1] }
  9         20  
  1         5  
309             #say "D:interrow_heights=$tot_interrow_heights";
310 9         27 my @heights = _divide_int_to_n_ints(max(0, $lh->[1] - $tot_interrow_heights), $rowspan);
311 9         22 my @widths = _divide_int_to_n_ints(max(0, $lh->[0] - $tot_intercol_widths ), $colspan);
312 9         17 for my $ir (1..$rowspan) {
313 10         16 for my $ic (1..$colspan) {
314 12         26 $exptable->[$exptable_rownum+$ir-1][$exptable_colnum+$ic-1][IDX_EXPTABLE_CELL_HEIGHT] = $heights[$ir-1];
315 12         37 $exptable->[$exptable_rownum+$ir-1][$exptable_colnum+$ic-1][IDX_EXPTABLE_CELL_WIDTH] = $widths [$ic-1];
316             }
317             }
318             }
319             } # for rows
320              
321             } # CONSTRUCT_EXPTABLE
322             #use DDC; dd $exptable; # debug
323             #print "D: exptable size: $M x $N (HxW)\n"; # debug
324             #use DDC; print "bottom borders: "; dd $exptable_bottom_borders; # debug
325              
326             OPTIMIZE_EXPTABLE: {
327             # TODO
328              
329             # 2. we reduce extraneous columns and rows if there are colspan that are
330             # too many. for example, if all exptable cells in column 1 has colspan=2
331             # (or one row has colspan=2 and another row has colspan=3), we might as
332             # remove 1 column because the extra column span doesn't have any
333             # content. same case for extraneous row spans.
334              
335             # 2a. remove extra undefs. skip this. doesn't make a difference.
336             #for my $exptable_row (@{ $exptable }) {
337             # splice @$exptable_row, $N if @$exptable_row > $N;
338             #}
339              
340 1         3 1;
  1         1  
341             } # OPTIMIZE_EXPTABLE
342             #use DDC; dd $exptable; # debug
343              
344 1         3 my $exptable_column_widths = []; # idx=exptable colnum
345 1         3 my $exptable_row_heights = []; # idx=exptable rownum
346             DETERMINE_SIZE_OF_EACH_EXPTABLE_COLUMN_AND_ROW: {
347             # 3. before we draw the exptable, we need to determine the width and
348             # height of each exptable column and row.
349             #use DDC;
350 1         2 for my $ir (0..$M-1) {
  1         3  
351 4         6 my $exptable_row = $exptable->[$ir];
352             $exptable_row_heights->[$ir] = max(
353 4   100     10 1, map {$_->[IDX_EXPTABLE_CELL_HEIGHT] // 0} @$exptable_row);
  13         38  
354             }
355              
356 1         4 for my $ic (0..$N-1) {
357             $exptable_column_widths->[$ic] = max(
358 3 50       40 1, map {$exptable->[$_][$ic] ? $exptable->[$_][$ic][IDX_EXPTABLE_CELL_WIDTH] : 0} 0..$M-1);
  12         32  
359             }
360             } # DETERMINE_SIZE_OF_EACH_EXPTABLE_COLUMN_AND_ROW
361             #use DDC; print "column widths: "; dd $exptable_column_widths; # debug
362             #use DDC; print "row heights: "; dd $exptable_row_heights; # debug
363              
364             # each elem is an arrayref containing characters to render a line of the
365             # table, e.g. for element [0] the row is all borders. for element [1]:
366             # [$left_border_str, $exptable_cell_content1, $border_between_col,
367             # $exptable_cell_content2, ...]. all will be joined together with "\n" to
368             # form the final rendered table.
369 1         2 my @buf;
370              
371             DRAW_EXPTABLE: {
372             # 4. finally we draw the (exp)table.
373              
374 1         3 my $y = 0;
  1         2  
375              
376 1         3 for my $ir (0..$M-1) {
377              
378             DRAW_TOP_BORDER:
379             {
380 4 100       13 last unless $ir == 0;
381 1 50       5 my $b_y = $args{header_row} ? 0 : 6;
382 1         8 my $b_topleft = $bs_obj->get_border_char($b_y, 0);
383 1         40 my $b_topline = $bs_obj->get_border_char($b_y, 1);
384 1         22 my $b_topbetwcol = $bs_obj->get_border_char($b_y, 2);
385 1         21 my $b_topright = $bs_obj->get_border_char($b_y, 3);
386 1 0 33     23 last unless length $b_topleft || length $b_topline || length $b_topbetwcol || length $b_topright;
      33        
      0        
387 1         4 $buf[$y][0] = $b_topleft;
388 1         4 for my $ic (0..$N-1) {
389 3 100       11 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
390 3   66     13 my $cell_right_has_content = defined $cell_right && _exptable_cell_is_head($cell_right);
391 3         11 $buf[$y][$ic*4+2] = $bs_obj->get_border_char($b_y, 1, $exptable_column_widths->[$ic]+2); # +1, +2, +3
392 3 50       75 $buf[$y][$ic*4+4] = $ic == $N-1 ? $b_topright : ($cell_right_has_content ? $b_topbetwcol : $b_topline);
    100          
393             }
394 1         3 $y++;
395             } # DRAW_TOP_BORDER
396              
397             # DRAW_DATA_OR_HEADER_ROW
398             {
399             # draw leftmost border, which we always do.
400 4 100 66     8 my $b_y = $ir == 0 && $args{header_row} ? 1 : 3;
  4         6  
  4         17  
401 4         12 for my $i (1 .. $exptable_row_heights->[$ir]) {
402 5         31 $buf[$y+$i-1][0] = $bs_obj->get_border_char($b_y, 0);
403             }
404              
405 4         87 my $lines;
406 4         9 for my $ic (0..$N-1) {
407 12         22 my $cell = $exptable->[$ir][$ic];
408              
409             # draw cell content. also possibly draw border between
410             # cells. we don't draw border inside a row/colspan.
411 12 100       21 if (_exptable_cell_is_head($cell)) {
412 9         22 $lines = _get_exptable_cell_lines(
413             \%args, $exptable, $exptable_row_heights, $exptable_column_widths,
414             $exptable_bottom_borders, $intercol_width, $ir, $ic);
415 9         16 for my $i (0..$#{$lines}) {
  9         24  
416 14         36 $buf[$y+$i][$ic*4+0] = $bs_obj->get_border_char($b_y, 1);
417 14         318 $buf[$y+$i][$ic*4+1] = " ";
418 14         33 $buf[$y+$i][$ic*4+2] = $lines->[$i];
419 14         30 $buf[$y+$i][$ic*4+3] = " ";
420             }
421             #use DDC; say "D: Drawing exptable_cell($ir,$ic): ", DDC::dump($lines);
422             }
423              
424             # draw rightmost border, which we always do.
425 12 100       36 if ($ic == $N-1) {
426 4 100 66     17 my $b_y = $ir == 0 && $args{header_row} ? 1 : 3;
427 4         10 for my $i (1 .. $exptable_row_heights->[$ir]) {
428 5         34 $buf[$y+$i-1][$ic*4+4] = $bs_obj->get_border_char($b_y, 2);
429             }
430             }
431              
432             }
433             } # DRAW_DATA_OR_HEADER_ROW
434 4         92 $y += $exptable_row_heights->[$ir];
435              
436             DRAW_ROW_SEPARATOR:
437             {
438 4 100       7 last unless $ir < $M-1;
  4         11  
439 3 50       9 last unless $exptable_bottom_borders->[$ir];
440 3 100 66     15 my $b_y = $ir == 0 && $args{header_row} ? 2 : 4;
441 3         10 my $b_betwrowleft = $bs_obj->get_border_char($b_y, 0);
442 3         63 my $b_betwrowline = $bs_obj->get_border_char($b_y, 1);
443 3         147 my $b_betwrowbetwcol = $bs_obj->get_border_char($b_y, 2);
444 3         68 my $b_betwrowright = $bs_obj->get_border_char($b_y, 3);
445 3 0 33     68 last unless length $b_betwrowleft || length $b_betwrowline || length $b_betwrowbetwcol || length $b_betwrowright;
      33        
      0        
446 3         7 my $b_betwrowbetwcol_notop = $bs_obj->get_border_char($b_y, 4);
447 3         61 my $b_betwrowbetwcol_nobot = $bs_obj->get_border_char($b_y, 5);
448 3         60 my $b_betwrowbetwcol_noleft = $bs_obj->get_border_char($b_y, 6);
449 3         59 my $b_betwrowbetwcol_noright = $bs_obj->get_border_char($b_y, 7);
450 3 100 66     65 my $b_yd = $ir == 0 && $args{header_row} ? 2 : 3;
451 3         8 my $b_datarowleft = $bs_obj->get_border_char($b_yd, 0);
452 3         61 my $b_datarowbetwcol = $bs_obj->get_border_char($b_yd, 1);
453 3         58 my $b_datarowright = $bs_obj->get_border_char($b_yd, 2);
454 3         64 for my $ic (0..$N-1) {
455 9         16 my $cell = $exptable->[$ir][$ic];
456 9 100       22 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
457 9 50       26 my $cell_bottom = $ir < $M-1 ? $exptable->[$ir+1][$ic] : undef;
458 9 100 66     34 my $cell_rightbottom = $ir < $M-1 && $ic < $N-1 ? $exptable->[$ir+1][$ic+1] : undef;
459              
460             # leftmost border
461 9 100       21 if ($ic == 0) {
462 3 50       10 $buf[$y][0] = _exptable_cell_is_rowspan_tail($cell_bottom) ? $b_datarowleft : $b_betwrowleft;
463             }
464              
465             # along the width of cell content
466 9 100       18 if (_exptable_cell_is_rowspan_head($cell_bottom)) {
467 7         20 $buf[$y][$ic*4+2] = $bs_obj->get_border_char($b_y, 1, $exptable_column_widths->[$ic]+2);
468             }
469              
470 9         155 my $char;
471 9 100       21 if ($ic == $N-1) {
472             # rightmost
473 3 100       7 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
474 1         2 $char = $b_datarowright;
475             } else {
476 2         5 $char = $b_betwrowright;
477             }
478             } else {
479             # between cells
480 6 100       14 if (_exptable_cell_is_colspan_tail($cell_right)) {
481 1 50       4 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
482 1 50       5 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
483 1         4 $char = "";
484             } else {
485 0         0 $char = $b_betwrowline;
486             }
487             } else {
488 0         0 $char = $b_betwrowbetwcol_notop;
489             }
490             } else {
491 5 100       12 if (_exptable_cell_is_colspan_tail($cell_rightbottom)) {
492 1         3 $char = $b_betwrowbetwcol_nobot;
493             } else {
494 4 50       8 if (_exptable_cell_is_rowspan_tail($cell_bottom)) {
    100          
495 0 0       0 if (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
496 0         0 $char = $b_datarowbetwcol;
497             } else {
498 0         0 $char = $b_betwrowbetwcol_noleft;
499             }
500             } elsif (_exptable_cell_is_rowspan_tail($cell_rightbottom)) {
501 1         3 $char = $b_betwrowbetwcol_noright;
502             } else {
503 3         7 $char = $b_betwrowbetwcol;
504             }
505             }
506             }
507             }
508 9         26 $buf[$y][$ic*4+4] = $char;
509              
510             }
511 3         6 $y++;
512             } # DRAW_ROW_SEPARATOR
513              
514             DRAW_BOTTOM_BORDER:
515             {
516 4 100       6 last unless $ir == $M-1;
  4         13  
517 1 50 33     6 my $b_y = $ir == 0 && $args{header_row} ? 7 : 5;
518 1         4 my $b_botleft = $bs_obj->get_border_char($b_y, 0);
519 1         23 my $b_botline = $bs_obj->get_border_char($b_y, 1);
520 1         22 my $b_botbetwcol = $bs_obj->get_border_char($b_y, 2);
521 1         22 my $b_botright = $bs_obj->get_border_char($b_y, 3);
522 1 0 33     23 last unless length $b_botleft || length $b_botline || length $b_botbetwcol || length $b_botright;
      33        
      0        
523 1         3 $buf[$y][0] = $b_botleft;
524 1         4 for my $ic (0..$N-1) {
525 3 100       8 my $cell_right = $ic < $N-1 ? $exptable->[$ir][$ic+1] : undef;
526 3         10 $buf[$y][$ic*4+2] = $bs_obj->get_border_char($b_y, 1, $exptable_column_widths->[$ic]+2);
527 3 100       72 $buf[$y][$ic*4+4] = $ic == $N-1 ? $b_botright : (_exptable_cell_is_colspan_tail($cell_right) ? $b_botline : $b_botbetwcol);
    100          
528             }
529 1         4 $y++;
530             } # DRAW_BOTTOM_BORDER
531              
532             }
533             } # DRAW_EXPTABLE
534              
535 1 100       3 for my $row (@buf) { for (@$row) { $_ = "" if !defined($_) } } # debug. remove undef to "" to save dump width
  10         18  
  130         313  
536             #use DDC; dd \@buf;
537 1         4 join "", (map { my $linebuf = $_; join("", grep {defined} @$linebuf)."\n" } @buf);
  10         14  
  10         16  
  130         265  
538             }
539              
540             # Back-compat: 'table' is an alias for 'generate_table', but isn't exported
541             {
542 1     1   18 no warnings 'once';
  1         3  
  1         98  
543             *table = \&generate_table;
544             }
545              
546             1;
547             # ABSTRACT: Text::Table::Tiny + support for column/row spans
548              
549             __END__