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