File Coverage

blib/lib/Text/UnicodeTable/Simple.pm
Criterion Covered Total %
statement 208 210 99.0
branch 59 62 95.1
condition 10 11 90.9
subroutine 35 35 100.0
pod 6 6 100.0
total 318 324 98.1


line stmt bran cond sub pod time code
1             package Text::UnicodeTable::Simple;
2              
3 7     7   217690 use 5.008_001;
  7         29  
  7         278  
4 7     7   115 use strict;
  7         13  
  7         335  
5 7     7   56 use warnings;
  7         31  
  7         482  
6              
7             our $VERSION = '0.09';
8              
9 7     7   37 use Carp ();
  7         13  
  7         191  
10 7     7   32 use Scalar::Util qw(looks_like_number);
  7         12  
  7         1102  
11 7     7   7130 use Unicode::EastAsianWidth;
  7         4879  
  7         866  
12 7     7   8137 use Term::ANSIColor ();
  7         78860  
  7         327  
13              
14 7     7   79 use constant ALIGN_LEFT => 1;
  7         13  
  7         639  
15 7     7   34 use constant ALIGN_RIGHT => 2;
  7         12  
  7         547  
16              
17 7     7   14161 use overload '""' => sub { shift->draw };
  7     2   8714  
  7         68  
  2         8  
18              
19             # alias for Text::ASCIITable
20             {
21 7     7   557 no warnings 'once';
  7         12  
  7         20414  
22             *setCols = \&set_header;
23             *addRow = \&add_row;
24             *addRowLine = \&add_row_line;
25             }
26              
27             sub new {
28 29     29 1 14631 my ($class, %args) = @_;
29              
30 29         70 my $header = delete $args{header};
31 29 100 100     121 if (defined $header && (ref $header ne 'ARRAY')) {
32 1         357 Carp::croak("'header' param should be ArrayRef");
33             }
34              
35 28         51 my $alignment = delete $args{alignment};
36 28 100       195 if (defined $alignment) {
37 3 100 100     21 unless ($alignment eq 'left' || $alignment eq 'right') {
38 1         203 Carp::croak("'alignment' param should be 'left' or 'right'");
39             }
40 2 100       8 if ($alignment eq 'left') {
41 1         3 $alignment = ALIGN_LEFT;
42             } else {
43 1         3 $alignment = ALIGN_RIGHT;
44             }
45             }
46              
47 27   100     147 my $ansi_color = delete $args{ansi_color} || 0;
48 27         219 my $self = bless {
49             header => [],
50             rows => [],
51             border => 1,
52             ansi_color => $ansi_color,
53             alignment => $alignment,
54             %args,
55             }, $class;
56              
57 27 100       92 if (defined $header) {
58 1         4 $self->set_header($header);
59             }
60              
61 27         89 $self;
62             }
63              
64             sub set_header {
65 26     26 1 5893 my $self = shift;
66 26         74 my @headers = _check_argument(@_);
67              
68 25 100       77 if (scalar @headers == 0) {
69 1         175 Carp::croak("Error: Input array has no element");
70             }
71              
72 24         256 $self->{width} = scalar @headers;
73 24         80 $self->{header} = [ $self->_divide_multiline(\@headers) ];
74              
75 24         71 return $self;
76             }
77              
78             sub _divide_multiline {
79 50     50   66 my ($self, $elements_ref) = @_;
80              
81 50         53 my @each_lines;
82 50         64 my $longest = -1;
83 50         59 for my $element (@{$elements_ref}) {
  50         98  
84 119 100       401 my @divided = $element ne '' ? (split "\n", $element) : ('');
85 119         229 push @each_lines, [ @divided ];
86              
87 119 100       372 $longest = scalar(@divided) if $longest < scalar(@divided);
88             }
89              
90 50         122 _adjust_cols(\@each_lines, $longest);
91              
92 50         70 my @rows;
93             my @alignments;
94 50         93 for my $i (0..($longest-1)) {
95 56         59 my @cells;
96 56         123 for my $j (0..($self->{width}-1)) {
97 131   66     516 $alignments[$j] ||= $self->_decide_alignment($each_lines[$j]->[$i]);
98 131         399 push @cells, Text::UnicodeTable::Simple::Cell->new(
99             text => $each_lines[$j]->[$i],
100             alignment => $alignments[$j],
101             );
102             }
103              
104 56         177 push @rows, [ @cells ];
105             }
106              
107 50         195 return @rows;
108             }
109              
110             sub _decide_alignment {
111 121     121   1112 my ($self, $str) = @_;
112 121 100       371 return $self->{alignment} if $self->{alignment};
113 109 100       584 return looks_like_number($str) ? ALIGN_RIGHT : ALIGN_LEFT;
114             }
115              
116             sub _adjust_cols {
117 50     50   68 my ($cols_ref, $longest) = @_;
118              
119 50         54 for my $cols (@{$cols_ref}) {
  50         86  
120 119         219 my $spaces = $longest - scalar(@{$cols});
  119         206  
121 119         286 push @{$cols}, '' for 1..$spaces;
  0         0  
122             }
123             }
124              
125             sub add_rows {
126 1     1 1 7 my ($self, @rows) = @_;
127              
128 1         4 $self->add_row($_) for @rows;
129 1         2 return $self;
130             }
131              
132             sub add_row {
133 29     29 1 2659 my $self = shift;
134 29         61 my @rows = _check_argument(@_);
135              
136 28         73 $self->_check_set_header;
137              
138 27 100       79 if ($self->{width} < scalar @rows) {
139 1         111 Carp::croak("Error: Too many elements")
140             }
141              
142 26         72 push @rows, '' for 1..($self->{width} - scalar @rows);
143              
144 26         32 push @{$self->{rows}}, $self->_divide_multiline(\@rows);
  26         77  
145              
146 26         147 return $self;
147             }
148              
149             sub _check_set_header {
150 52     52   178 my $self = shift;
151              
152 52 100       153 unless (exists $self->{width}) {
153 3         607 Carp::croak("Error: you should call 'set_header' method previously");
154             }
155             }
156              
157             sub _check_argument {
158 55     55   174 my @args = @_;
159              
160 55         100 my @ret;
161 55 100       128 if (ref($args[0]) eq "ARRAY") {
162 7 100       17 if (scalar @args == 1) {
163 5         8 @ret = @{$args[0]}
  5         11  
164             } else {
165 2         220 Carp::croak("Error: Multiple ArrayRef arguments");
166             }
167             } else {
168 48         97 @ret = @_;
169             }
170              
171             # replace 'undef' with 0 length string ''
172 53 50       201 return map { defined $_ ? $_ : '' } @ret;
  123         567  
173             }
174              
175             sub add_row_line {
176 5     5 1 851 my $self = shift;
177              
178 5         18 $self->_check_set_header;
179              
180 4         25 my $line = bless [], 'Text::UnicodeTable::Simple::Line';
181 4         8 push @{$self->{rows}}, $line;
  4         10  
182              
183 4         9 return $self;
184             }
185              
186             sub draw {
187 19     19 1 104 my $self = shift;
188 19         32 my @ret;
189              
190 19         49 $self->_check_set_header;
191              
192 18         46 $self->_set_column_length();
193 18         91 $self->_set_separator();
194              
195             # header
196 18 100       66 push @ret, $self->{top_line} if $self->{border};
197 18         27 push @ret, $self->_generate_row_string($_) for @{$self->{header}};
  18         71  
198 18 100       62 push @ret, $self->{separator} if $self->{border};
199              
200             # body
201 18         22 my $row_length = scalar @{$self->{rows}};
  18         33  
202 18         42 for my $i (0..($row_length-1)) {
203 25         50 my $row = $self->{rows}->[$i];
204              
205 25 100       68 if (ref($row) eq 'ARRAY') {
    50          
206 22         74 push @ret, $self->_generate_row_string($row);
207             } elsif ( ref($row) eq 'Text::UnicodeTable::Simple::Line') {
208             # if last line is row_line, it is ignored.
209 3 100       15 push @ret, $self->{separator} if $i != $row_length-1;
210             }
211             }
212              
213 18 100       59 push @ret, $self->{bottom_line} if $self->{border};
214              
215 18         51 my $str = join "\n", @ret;
216 18         126 return "$str\n";
217             }
218              
219             sub _generate_row_string {
220 44     44   68 my ($self, $row_ref) = @_;
221              
222 44 100       96 my $separator = $self->{border} ? '|' : '';
223 44         51 my $str = $separator;
224              
225 44         49 my $index = 0;
226 44         51 for my $row_elm (@{$row_ref}) {
  44         76  
227 84         162 $str .= $self->_format($row_elm, $self->_get_column_length($index));
228 84         123 $str .= $separator;
229 84         141 $index++;
230             }
231              
232 44 100       242 $str =~ s{(^\s|\s$)}{}g if $self->{border};
233              
234 44         142 return $str;
235             }
236              
237             sub _format {
238 84     84   108 my ($self, $cell, $width) = @_;
239              
240 84         147 my $str = $cell->text;
241 84         157 $str = " $str ";
242 84         146 my $len = $self->_str_width($str);
243              
244 84         98 my $retval;
245 84 100       160 if ($cell->alignment == ALIGN_RIGHT) {
246 30         60 $retval = (' ' x ($width - $len)) . $str;
247             } else {
248 54         111 $retval = $str . (' ' x ($width - $len));
249             }
250              
251 84         197 return $retval;
252             }
253              
254             sub _set_separator {
255 18     18   24 my $self = shift;
256              
257 18         27 my $each_row_width = $self->{column_length};
258 18         29 my $str = '+';
259 18         22 for my $width (@{$each_row_width}) {
  18         35  
260 32         85 $str .= ('-' x $width);
261 32         59 $str .= '+';
262             }
263              
264 18 100       86 $self->{separator} = $self->{border} ? $str : "";
265 18         172 ($self->{top_line} = $str) =~ s{^\+(.*?)\+$}{.$1.};
266 18         133 ($self->{bottom_line} = $str) =~ s{^\+(.*?)\+$}{'$1'};
267             }
268              
269             sub _get_column_length {
270 84     84   104 my ($self, $index) = @_;
271 84         235 return $self->{column_length}->[$index];
272             }
273              
274             sub _set_column_length {
275 18     18   24 my $self = shift;
276              
277 18         53 my @cols_length = $self->_column_length($self->{header});
278 18         54 my @rows_length = $self->_column_length($self->{rows});
279              
280             # add space before and after string
281 18         48 my @max = map { $_ + 2 } _select_max(\@cols_length, \@rows_length);
  32         65  
282              
283 18         115 $self->{column_length} = \@max;
284             }
285              
286             sub _column_length {
287 36     36   48 my ($self, $matrix_ref) = @_;
288              
289 36         56 my $width = $self->{width};
290 36         33 my $height = scalar @{$matrix_ref};
  36         63  
291              
292 36         42 my @each_cols_length;
293 36         130 for (my $i = 0; $i < $width; $i++) {
294 64         204 my $max = -1;
295 64         126 for (my $j = 0; $j < $height; $j++) {
296 90 100       222 next unless ref $matrix_ref->[$j] eq 'ARRAY';
297              
298 84         109 my $cell = $matrix_ref->[$j]->[$i];
299 84         174 my $len = $self->_str_width($cell->text);
300 84 100       304 $max = $len if $len > $max;
301             }
302              
303 64         169 $each_cols_length[$i] = $max;
304             }
305              
306 36         88 return @each_cols_length;
307             }
308              
309             sub _select_max {
310 19     19   484 my ($a, $b) = @_;
311              
312 19         37 my ($a_length, $b_length) = map { scalar @{$_} } ($a, $b);
  38         38  
  38         94  
313 19 50       51 if ( $a_length != $b_length) {
314 0         0 Carp::croak("Error: compare different length arrays");
315             }
316              
317 19         21 my @max;
318 19         49 for my $i (0..($a_length - 1)) {
319 35 100       108 push @max, $a->[$i] >= $b->[$i] ? $a->[$i] : $b->[$i];
320             }
321              
322 19         47 return @max;
323             }
324              
325             sub _str_width {
326 168     168   277 my ($self, $str) = @_;
327              
328 168 100       342 if ($self->{ansi_color}) {
329 8         24 $str = Term::ANSIColor::colorstrip($str);
330             }
331              
332 168         255 my $ret = 0;
333 7     7   7517 while ($str =~ /(?:(\p{InFullwidth}+)|(\p{InHalfwidth}+))/go) {
  7         71  
  7         98  
  168         900  
334 176 100       12158 $ret += ($1 ? length($1) * 2 : length($2));
335             }
336              
337 168         339 return $ret;
338             }
339              
340             # utility class
341             {
342             package # hide from pause
343             Text::UnicodeTable::Simple::Cell;
344              
345             sub new {
346 131     131   358 my ($class, %args) = @_;
347 131         846 bless {
348             text => $args{text},
349             alignment => $args{alignment},
350             }, $class;
351             }
352              
353             sub text {
354 201     201   1171 $_[0]->{text};
355             }
356              
357             sub alignment {
358 84     84   219 $_[0]->{alignment};
359             }
360             }
361              
362             1;
363              
364             __END__