1package Text::Table::TinyBorderStyle;
2
3our $AUTHORITY = 'cpan:PERLANCAR'; # AUTHORITY
4our $DATE = '2020-06-12'; # DATE
5our $DIST = 'Text-Table-TinyBorderStyle'; # DIST
6our $VERSION = '0.004'; # VERSION
7
8use 5.006;
9use strict;
10use warnings;
11
12use List::Util ();
13
14use Exporter qw(import);
15our @EXPORT_OK = qw/ generate_table /;
16
17sub generate_table {
18
19    my %params = @_;
20    my $rows = $params{rows} or die "Must provide rows!";
21
22    my $border_style_name = $params{border_style} ||
23        $ENV{TEXT_TABLE_TINY_BORDER_STYLE} ||
24        $ENV{BORDER_STYLE} ||
25        'BorderStyle::ASCII::SingleLine';
26
27    require Module::Load::Util;
28    my $border_style_obj = Module::Load::Util::instantiate_class_with_optional_args($border_style_name);
29
30    # foreach col, get the biggest width
31    my $widths = _maxwidths($rows);
32    my $max_index = _max_array_index($rows);
33
34    # use that to get the field format and separators
35    my $row_format        = _get_row_format          ($border_style_obj, $widths);
36    my $header_row_format = _get_header_row_format   ($border_style_obj, $widths);
37    my $top_border        = _get_top_border          ($border_style_obj, $widths);
38    my $head_row_sep      = _get_header_row_separator($border_style_obj, $widths);
39    my $row_sep           = _get_row_separator       ($border_style_obj, $widths);
40    my $bottom_border     = _get_bottom_border       ($border_style_obj, $widths);
41
42    # here we go...
43    my @table;
44    push @table, $top_border;
45
46    # if the first row's a header:
47    my $data_begins = 0;
48    if ( $params{header_row} ) {
49        my $header_row = $rows->[0];
50        $data_begins++;
51        push @table, sprintf(
52                         $header_row_format,
53                         map { defined($header_row->[$_]) ? $header_row->[$_] : '' } (0..$max_index)
54                     );
55        push @table, $head_row_sep;
56    }
57
58    # then the data
59    my $i = 0;
60    foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
61        push @table, $row_sep if $params{separate_rows} && $i++;
62        push @table, sprintf(
63	    $row_format,
64	    map { defined($row->[$_]) ? $row->[$_] : '' } (0..$max_index)
65	);
66    }
67
68    # this will have already done the bottom if called explicitly
69    push @table, $bottom_border;
70    return join("\n",grep {$_} @table);
71}
72
73sub _get_cols_and_rows ($) {
74    my $rows = shift;
75    return ( List::Util::max( map { scalar @$_ } @$rows), scalar @$rows);
76}
77
78sub _maxwidths {
79    my $rows = shift;
80    # what's the longest array in this list of arrays?
81    my $max_index = _max_array_index($rows);
82    my $widths = [];
83    for my $i (0..$max_index) {
84        # go through the $i-th element of each array, find the longest
85        my $max = List::Util::max(map {defined $$_[$i] ? length($$_[$i]) : 0} @$rows);
86        push @$widths, $max;
87    }
88    return $widths;
89}
90
91# return highest top-index from all rows in case they're different lengths
92sub _max_array_index {
93    my $rows = shift;
94    return List::Util::max( map { $#$_ } @$rows );
95}
96
97# TODO: what if border character contains %
98sub _get_row_format {
99    my ($border_style_obj, $widths) = @_;
100    join(
101        "",
102        $border_style_obj->get_border_char(3, 0). " ",
103        join(" ".$border_style_obj->get_border_char(3, 1)." ",  map { "%-${_}s" } @$widths),
104        " " . $border_style_obj->get_border_char(3, 2),
105    );
106}
107
108# TODO: what if border character contains %
109sub _get_header_row_format {
110    my ($border_style_obj, $widths) = @_;
111    join(
112        "",
113        $border_style_obj->get_border_char(1, 0) . " ",
114        join(" ".$border_style_obj->get_border_char(1, 1)." ",  map { "%-${_}s" } @$widths),
115        " " . $border_style_obj->get_border_char(1, 2),
116    );
117}
118
119sub _get_top_border {
120    my ($border_style_obj, $widths) = @_;
121    join(
122        "",
123        $border_style_obj->get_border_char(0, 0) . $border_style_obj->get_border_char(0, 1),
124        join($border_style_obj->get_border_char(0, 1) . $border_style_obj->get_border_char(0, 2) . $border_style_obj->get_border_char(0, 1),  map { $border_style_obj->get_border_char(0, 1, $_) } @$widths),
125        $border_style_obj->get_border_char(0, 1) . $border_style_obj->get_border_char(0, 3),
126    );
127}
128
129sub _get_header_row_separator {
130    my ($border_style_obj, $widths) = @_;
131    join(
132        "",
133        $border_style_obj->get_border_char(2, 0) . $border_style_obj->get_border_char(2, 1),
134        join($border_style_obj->get_border_char(2, 1) . $border_style_obj->get_border_char(2, 2) . $border_style_obj->get_border_char(2, 1),  map { $border_style_obj->get_border_char(2, 1, $_) } @$widths),
135        $border_style_obj->get_border_char(2, 1) . $border_style_obj->get_border_char(2, 3),
136    );
137}
138
139sub _get_row_separator {
140    my ($border_style_obj, $widths) = @_;
141    join(
142        "",
143        $border_style_obj->get_border_char(4, 0) . $border_style_obj->get_border_char(4, 1),
144        join($border_style_obj->get_border_char(4, 1) . $border_style_obj->get_border_char(4, 2) . $border_style_obj->get_border_char(4, 1),  map { $border_style_obj->get_border_char(4, 1, $_) } @$widths),
145        $border_style_obj->get_border_char(4, 1) . $border_style_obj->get_border_char(4, 3),
146    );
147}
148
149sub _get_bottom_border {
150    my ($border_style_obj, $widths) = @_;
151    join(
152        "",
153        $border_style_obj->get_border_char(5, 0) . $border_style_obj->get_border_char(5, 1) ,
154        join($border_style_obj->get_border_char(5, 1) . $border_style_obj->get_border_char(5, 2) . $border_style_obj->get_border_char(5, 1),  map { $border_style_obj->get_border_char(5, 1, $_) } @$widths),
155        $border_style_obj->get_border_char(5, 1) . $border_style_obj->get_border_char(5, 3),
156    );
157}
158
159# Back-compat: 'table' is an alias for 'generate_table', but isn't exported
160{
161    no warnings 'once';
162    *table = \&generate_table;
163}
164
1651;
166# ABSTRACT: Text::Table::Tiny + support for border styles
167
168__END__
169
170=pod
171
172=encoding UTF-8
173
174=head1 NAME
175
176Text::Table::TinyBorderStyle - Text::Table::Tiny + support for border styles
177
178=head1 VERSION
179
180This document describes version 0.004 of Text::Table::TinyBorderStyle (from Perl distribution Text-Table-TinyBorderStyle), released on 2020-06-12.
181
182=head1 SYNOPSIS
183
184 use Text::Table::TinyBorderStyle qw/ generate_table /;
185
186 my $rows = [
187     # header row
188     ['Name','Rank','Serial'],
189     # rows
190     ['alice', 'pvt', '123456'],
191     ['bob',   'cpl', '98765321'],
192     ['carol', 'brig gen', '8745'],
193 ];
194 print generate_table(rows => $rows, header_row => 1, border_style => 'BorderStyle::ASCII::SingleLine');
195
196=head1 DESCRIPTION
197
198This module is like L<Text::Table::Tiny> (0.04) with added support for using
199border styles. For more details about border styles, see L<BorderStyle>
200specification. The styles are in C<BorderStyle::*> modules. Try installing and
201using the border style modules to see what they look like.
202
203Interface, options, and format variables are the same as in Text::Table::Tiny.
204
205=for Pod::Coverage ^(.+)$
206
207=head1 ENVIRONMENT
208
209=head2 BORDER_STYLE
210
211Set default for C<border_style> argument. See also
212L</TEXT_TABLE_TINY_BORDER_STYLE>.
213
214=head2 BORDER_STYLE
215
216Set default for C<border_style> argument. Takes precedence over
217L</BORDER_STYLE>.
218
219=head1 HOMEPAGE
220
221Please visit the project's homepage at L<https://metacpan.org/release/Text-Table-TinyBorderStyle>.
222
223=head1 SOURCE
224
225Source repository is at L<https://github.com/perlancar/perl-Text-Table-TinyBorderStyle>.
226
227=head1 BUGS
228
229Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Text-Table-TinyBorderStyle>
230
231When submitting a bug or request, please include a test-file or a
232patch to an existing test-file that illustrates the bug or desired
233feature.
234
235=head1 SEE ALSO
236
237L<Text::Table::Tiny> and other variants like L<Text::Table::TinyColor>,
238L<Text::Table::TinyWide>, L<Text::Table::TinyColorWide>.
239
240L<BorderStyle> and C<BorderStyle::*> modules, e.g.
241L<BorderStyle::ASCII::SingleLine> or L<BorderStyle::UTF8::DoubleLine>.
242
243L<Text::Table::Any>
244
245L<Text::ANSITable> which also supports border styles as well as color themes
246(including coloring the borders), aligning wide/colored text, and other
247features, but with larger footprint and slower rendering speed.
248
249=head1 AUTHOR
250
251perlancar <perlancar@cpan.org>
252
253=head1 COPYRIGHT AND LICENSE
254
255This software is copyright (c) 2020 by perlancar@cpan.org.
256
257This is free software; you can redistribute it and/or modify it under
258the same terms as the Perl 5 programming language system itself.
259
260=cut
261