1package Text::Table::TinyWide;
2
3our $DATE = '2016-10-19'; # DATE
4our $VERSION = '0.001'; # VERSION
5
6use 5.006;
7use strict;
8use warnings;
9
10use List::Util qw();
11use Text::WideChar::Util qw(mbswidth mbpad);
12
13use Exporter qw(import);
14our @EXPORT_OK = qw/ generate_table /;
15
16our $COLUMN_SEPARATOR = '|';
17our $ROW_SEPARATOR = '-';
18our $CORNER_MARKER = '+';
19our $HEADER_ROW_SEPARATOR = '=';
20our $HEADER_CORNER_MARKER = 'O';
21
22sub generate_table {
23
24    my %params = @_;
25    my $rows = $params{rows} or die "Must provide rows!";
26
27    # foreach col, get the biggest width
28    my $widths = _maxwidths($rows);
29    my $max_index = _max_array_index($rows);
30
31    # use that to get the field format and separators
32    my $format = _get_format($widths);
33    my $row_sep = _get_row_separator($widths);
34    my $head_row_sep = _get_header_row_separator($widths);
35
36    # here we go...
37    my @table;
38    push @table, $row_sep;
39
40    # if the first row's a header:
41    my $data_begins = 0;
42    if ( $params{header_row} ) {
43        my $header_row = $rows->[0];
44        $data_begins++;
45        push @table, sprintf(
46                         $format,
47                         map { mbpad((defined($header_row->[$_]) ? $header_row->[$_] : ''), $widths->[$_]) } (0..$max_index)
48                     );
49        push @table, $params{separate_rows} ? $head_row_sep : $row_sep;
50    }
51
52    # then the data
53    foreach my $row ( @{ $rows }[$data_begins..$#$rows] ) {
54        push @table, sprintf(
55	    $format,
56	    map { mbpad((defined($row->[$_]) ? $row->[$_] : ''), $widths->[$_]) } (0..$max_index)
57	);
58        push @table, $row_sep if $params{separate_rows};
59    }
60
61    # this will have already done the bottom if called explicitly
62    push @table, $row_sep unless $params{separate_rows};
63    return join("\n",grep {$_} @table);
64}
65
66sub _get_cols_and_rows ($) {
67    my $rows = shift;
68    return ( List::Util::max( map { scalar @$_ } @$rows), scalar @$rows);
69}
70
71sub _maxwidths {
72    my $rows = shift;
73    # what's the longest array in this list of arrays?
74    my $max_index = _max_array_index($rows);
75    my $widths = [];
76    for my $i (0..$max_index) {
77        # go through the $i-th element of each array, find the longest
78        my $max = List::Util::max(map {defined $$_[$i] ? mbswidth($$_[$i]) : 0} @$rows);
79        push @$widths, $max;
80    }
81    return $widths;
82}
83
84# return highest top-index from all rows in case they're different lengths
85sub _max_array_index {
86    my $rows = shift;
87    return List::Util::max( map { $#$_ } @$rows );
88}
89
90sub _get_format {
91    my $widths = shift;
92    return "$COLUMN_SEPARATOR ".join(" $COLUMN_SEPARATOR ",map { "%s" } @$widths)." $COLUMN_SEPARATOR";
93}
94
95sub _get_row_separator {
96    my $widths = shift;
97    return "$CORNER_MARKER$ROW_SEPARATOR".join("$ROW_SEPARATOR$CORNER_MARKER$ROW_SEPARATOR",map { $ROW_SEPARATOR x $_ } @$widths)."$ROW_SEPARATOR$CORNER_MARKER";
98}
99
100sub _get_header_row_separator {
101    my $widths = shift;
102    return "$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR".join("$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER$HEADER_ROW_SEPARATOR",map { $HEADER_ROW_SEPARATOR x $_ } @$widths)."$HEADER_ROW_SEPARATOR$HEADER_CORNER_MARKER";
103}
104
105# Back-compat: 'table' is an alias for 'generate_table', but isn't exported
106{
107    no warnings 'once';
108    *table = \&generate_table;
109}
110
1111;
112# ABSTRACT: Text::Table::Tiny + support for wide character
113
114__END__
115
116=pod
117
118=encoding UTF-8
119
120=head1 NAME
121
122Text::Table::TinyWide - Text::Table::Tiny + support for wide character
123
124=head1 VERSION
125
126This document describes version 0.001 of Text::Table::TinyWide (from Perl distribution Text-Table-TinyWide), released on 2016-10-19.
127
128=head1 SYNOPSIS
129
130 use Text::Table::TinyWide qw/ generate_table /;
131
132 my $rows = [
133     # header row
134     ['Name', 'Rank', 'Serial'],
135     # rows
136     ["\x{7231}\x{4E3D}\x{4E1D}", 'pvt', '123456'],
137     ['bob',   'cpl', '98765321'],
138     ['carol', 'brig gen', '8745'],
139 ];
140 binmode('STDOUT', ':utf8');
141 print generate_table(rows => $rows, header_row => 1);
142
143=head1 DESCRIPTION
144
145This module is like L<Text::Table::Tiny> (0.04) with added support for wide
146characters. With this module, text with wide characters will still line up.
147
148Interface, options, and format variables are the same as in Text::Table::Tiny.
149
150=for Pod::Coverage ^(.+)$
151
152=head1 HOMEPAGE
153
154Please visit the project's homepage at L<https://metacpan.org/release/Text-Table-TinyWide>.
155
156=head1 SOURCE
157
158Source repository is at L<https://github.com/perlancar/perl-Text-Table-TinyWide>.
159
160=head1 BUGS
161
162Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Text-Table-TinyWide>
163
164When submitting a bug or request, please include a test-file or a
165patch to an existing test-file that illustrates the bug or desired
166feature.
167
168=head1 SEE ALSO
169
170L<Text::Table::Tiny>
171
172L<Text::Table::TinyColor> for table with colored text support.
173
174L<Text::Table::TinyColorWide> for table with colored text and wide character
175support.
176
177L<Text::Table::Any>
178
179L<Text::ANSITable> for more formatting options and colored text support, but
180with larger footprint and slower rendering speed.
181
182=head1 AUTHOR
183
184perlancar <perlancar@cpan.org>
185
186=head1 COPYRIGHT AND LICENSE
187
188This software is copyright (c) 2016 by perlancar@cpan.org.
189
190This is free software; you can redistribute it and/or modify it under
191the same terms as the Perl 5 programming language system itself.
192
193=cut
194