File Coverage

blib/lib/Text/ASCIITable.pm
Criterion Covered Total %
statement 339 446 76.0
branch 146 250 58.4
condition 60 124 48.3
subroutine 35 41 85.3
pod 11 28 39.2
total 591 889 66.4


line stmt bran cond sub pod time code
1             package Text::ASCIITable;
2             # by Håkon Nessjøen
3              
4             @ISA=qw(Exporter);
5             @EXPORT = qw();
6             @EXPORT_OK = qw();
7             $VERSION = '0.22';
8 13     13   9968 use Exporter;
  13         17  
  13         435  
9 13     13   43 use strict;
  13         8  
  13         183  
10 13     13   31 use Carp;
  13         15  
  13         741  
11 13     13   4644 use Text::ASCIITable::Wrap qw{ wrap };
  13         18  
  13         640  
12 13     13   11959 use overload '@{}' => 'addrow_overload', '""' => 'drawit';
  13         10660  
  13         68  
13 13     13   6655 use utf8;
  13         97  
  13         53  
14 13     13   389 use List::Util qw(reduce max sum);
  13         13  
  13         51069  
15              
16             =encoding utf8
17              
18             =head1 NAME
19              
20             Text::ASCIITable - Create a nice formatted table using ASCII characters.
21              
22             =head1 SHORT DESCRIPTION
23              
24             Pretty nifty if you want to output dynamic text to your console or other
25             fixed-size-font displays, and at the same time it will display it in a
26             nice human-readable, or "cool" way.
27              
28             =head1 SYNOPSIS
29              
30             use Text::ASCIITable;
31             $t = Text::ASCIITable->new({ headingText => 'Basket' });
32            
33             $t->setCols('Id','Name','Price');
34             $t->addRow(1,'Dummy product 1',24.4);
35             $t->addRow(2,'Dummy product 2',21.2);
36             $t->addRow(3,'Dummy product 3',12.3);
37             $t->addRowLine();
38             $t->addRow('','Total',57.9);
39             print $t;
40            
41             # Result:
42             .------------------------------.
43             | Basket |
44             +----+-----------------+-------+
45             | Id | Name | Price |
46             +----+-----------------+-------+
47             | 1 | Dummy product 1 | 24.4 |
48             | 2 | Dummy product 2 | 21.2 |
49             | 3 | Dummy product 3 | 12.3 |
50             +----+-----------------+-------+
51             | | Total | 57.9 |
52             '----+-----------------+-------'
53              
54             =head1 FUNCTIONS
55              
56             =head2 new(options)
57              
58             Initialize a new table. You can specify output-options. For more options, check out the usage for setOptions()
59              
60             Usage:
61             $t = Text::ASCIITable->new();
62              
63             Or with options:
64             $t = Text::ASCIITable->new({ hide_Lastline => 1, reportErrors => 0});
65              
66             =cut
67              
68             sub new {
69 14   100 14 1 3676 my $self = {
70             tbl_cols => [],
71             tbl_rows => [],
72             tbl_cuts => [],
73             tbl_align => {},
74             tbl_lines => {},
75              
76             des_top => ['.','.','-','-'],
77             des_middle => ['+','+','-','+'],
78             des_bottom => ["'","'",'-','+'],
79             des_rowline => ['+','+','-','+'],
80              
81             des_toprow => ['|','|','|'],
82             des_middlerow => ['|','|','|'],
83              
84             cache_width => {},
85              
86             options => $_[1] || { }
87             };
88              
89 14 50       57 $self->{options}{reportErrors} = defined($self->{options}{reportErrors}) ? $self->{options}{reportErrors} : 1; # default setting
90 14   100     80 $self->{options}{alignHeadRow} = $self->{options}{alignHeadRow} || 'auto'; # default setting
91 14   50     79 $self->{options}{undef_as} = $self->{options}{undef_as} || ''; # default setting
92 14   100     61 $self->{options}{chaining} = $self->{options}{chaining} || 0; # default setting
93              
94 14         19 bless $self;
95              
96 14         36 return $self;
97             }
98              
99             =head2 setCols(@cols)
100              
101             Define the columns for the table(compare with in HTML). For example C.
102             B that you cannot add Cols after you have added a row. Multiline columnnames are allowed.
103              
104             =cut
105              
106             sub setCols {
107 13     13 1 72 my $self = shift;
108 13 0       37 do { $self->reperror("setCols needs an array"); return $self->{options}{chaining} ? $self : 1; } unless defined($_[0]);
  0 50       0  
  0         0  
109 13 100       51 @_ = @{$_[0]} if (ref($_[0]) eq 'ARRAY');
  10         35  
110 13 0       38 do { $self->reperror("setCols needs an array"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@_) != 0;
  0 50       0  
  0         0  
111 13 0       36 do { $self->reperror("Cannot edit cols at this state"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) == 0;
  13 50       419  
  0         0  
  0         0  
112              
113 13         25 my @lines = map { [ split(/\n/,$_) ] } @_;
  39         114  
114              
115             # Multiline support
116 13         22 my $max=0;
117 13         16 my @out;
118 13 100       144 grep {$max = scalar(@{$_}) if scalar(@{$_}) > $max} @lines;
  39         57  
  14         44  
  39         111  
119 13         45 foreach my $num (0..($max-1)) {
120 14   66     122 my @tmp = map defined $$_[$num] && $$_[$num], @lines;
121 14         56 push @out, \@tmp;
122             }
123              
124 13         24 @{$self->{tbl_cols}} = @_;
  13         37  
125 13 50       35 @{$self->{tbl_multilinecols}} = @out if ($max);
  13         33  
126 13         25 $self->{tbl_colsismultiline} = $max;
127              
128 13 100       96 return $self->{options}{chaining} ? $self : undef;
129             }
130              
131             =head2 addRow(@collist)
132              
133             Adds one row to the table. This must be an array of strings. If you defined 3 columns. This array must
134             have 3 items in it. And so on. Should be self explanatory. The strings can contain newlines.
135              
136             Note: It does not require argument to be an array, thus;
137             $t->addRow(['id','name']) and $t->addRow('id','name') does the same thing.
138              
139             This module is also overloaded to accept push. To construct a table with the use of overloading you might do the following:
140              
141             $t = Text::ASCIITable->new();
142             $t->setCols('one','two','three','four');
143             push @$t, ( "one\ntwo" ) x 4; # Replaces $t->addrow();
144             print $t; # Replaces print $t->draw();
145            
146             Which would construct:
147             .-----+-----+-------+------.
148             | one | two | three | four |
149             |=----+-----+-------+-----=|
150             | one | one | one | one | # Note that theese two lines
151             | two | two | two | two | # with text are one singe row.
152             '-----+-----+-------+------'
153              
154             There is also possible to give this function an array of arrayrefs and hence support the output from
155             DBI::selectall_arrayref($sql) without changes.
156              
157             Example of multiple-rows pushing:
158             $t->addRow([
159             [ 1, 2, 3 ],
160             [ 4, 5, 6 ],
161             [ 7, 8, 9 ],
162             ]);
163              
164             =cut
165              
166             sub addRow {
167 42     42 1 81 my $self = shift;
168 42 100       95 @_ = @{$_[0]} if (ref($_[0]) eq 'ARRAY');
  4         5  
169 42 0 33     52 do { $self->reperror("Received too many columns"); return $self->{options}{chaining} ? $self : 1; } if scalar(@_) > scalar(@{$self->{tbl_cols}}) && ref($_[0]) ne 'ARRAY';
  42 50       126  
  0         0  
  0         0  
170 42         40 my (@in,@out,@lines,$max);
171              
172 42 100 66     182 if (scalar(@_) > 0 && ref($_[0]) eq 'ARRAY') {
173 1         1 foreach my $row (@_) {
174 3         10 $self->addRow($row);
175             }
176 1 50       10 return $self->{options}{chaining} ? $self : undef;
177             }
178              
179             # Fill out row, if columns are missing (requested) Mar 21 2004 by a anonymous person
180 41         47 while (scalar(@_) < scalar(@{$self->{tbl_cols}})) {
  41         99  
181 0         0 push @_, ' ';
182             }
183              
184             # Word wrapping & undef-replacing
185 41         86 foreach my $c (0..$#_) {
186 121 50       180 $_[$c] = $self->{options}{undef_as} unless defined $_[$c]; # requested by david@landgren.net/dland@cpan.org - https://rt.cpan.org/NoAuth/Bugs.html?Dist=Text-ASCIITable
187 121         120 my $colname = $self->{tbl_cols}[$c];
188 121   100     323 my $width = $self->{tbl_width}{$colname} || 0;
189 121 100       153 if ($width > 0) {
190 4         16 $in[$c] = wrap($_[$c],$width);
191             } else {
192 117         177 $in[$c] = $_[$c];
193             }
194             }
195              
196             # Multiline support:
197 41         56 @lines = map { [ split /\n/ ] } @in;
  121         277  
198 41         66 $max = max map {scalar @$_} @lines;
  121         198  
199 41         79 foreach my $num (0..($max-1)) {
200 57 100 66     52 my @tmp = map { defined(@{$_}[$num]) && $self->count(@{$_}[$num]) ? @{$_}[$num] : '' } @lines;
  157         107  
  140         227  
201 57         145 push @out, [ @tmp ];
202             }
203              
204             # Add row(s)
205 41         38 push @{$self->{tbl_rows}}, @out;
  41         66  
206              
207             # Rowlinesupport:
208 41         49 $self->{tbl_rowline}{scalar(@{$self->{tbl_rows}})} = 1;
  41         77  
209              
210 41 100       144 return $self->{options}{chaining} ? $self : undef;
211             }
212              
213             sub addrow_overload {
214 3     3 0 16 my $self = shift;
215 3         2 my @arr;
216 3         12 tie @arr, $self;
217 3         11 return \@arr;
218             }
219              
220             =head2 addRowLine([$row])
221              
222             Will add a line after the current row. As an argument, you may specify after which row you want a line (first row is 1)
223             or an array of row numbers. (HINT: If you want a line after every row, read about the drawRowLine option in setOptions())
224              
225             Example without arguments:
226             $t->addRow('one','two','three');
227             $t->addRowLine();
228             $t->addRow('one','two','three');
229              
230             Example with argument:
231             $t->addRow('one','two','three');
232             $t->addRow('one','two','three');
233             $t->addRow('one','two','three');
234             $t->addRow('one','two','three');
235             $t->addRowLine(1); # or multiple: $t->addRowLine([2,3]);
236              
237             =cut
238              
239             sub addRowLine {
240 1     1 1 1 my ($self,$row) = @_;
241 1 0       1 do { $self->reperror("rows not added yet"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) > 0;
  1 50       4  
  0         0  
  0         0  
242              
243 1 50 33     3 if (defined($row) && ref($row) eq 'ARRAY') {
    50          
244 0         0 foreach (@$row) {
245 0         0 $_=int($_);
246 0         0 $self->{tbl_lines}{$_} = 1;
247             }
248             }
249             elsif (defined($row)) {
250 0         0 $row = int($row);
251 0 0 0     0 do { $self->reperror("$row is higher than number of rows added"); return $self->{options}{chaining} ? $self : 1; } if ($row < 0 || $row > scalar(@{$self->{tbl_rows}}));
  0 0       0  
  0         0  
  0         0  
252 0         0 $self->{tbl_lines}{$row} = 1;
253             } else {
254 1         2 $self->{tbl_lines}{scalar(@{$self->{tbl_rows}})} = 1;
  1         2  
255             }
256              
257 1 50       2 return $self->{options}{chaining} ? $self : undef;
258             }
259              
260             # backwardscompatibility, deprecated
261             sub alignColRight {
262 4     4 0 7 my ($self,$col) = @_;
263 4 0       9 do { $self->reperror("alignColRight is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col);
  0 50       0  
  0         0  
264 4         30 return $self->alignCol($col,'right');
265             }
266              
267             =head2 alignCol($col,$direction) or alignCol({col1 => direction1, col2 => direction2, ... })
268              
269             Given a columnname, it aligns all data to the given direction in the table. This looks nice on numerical displays
270             in a column. The column names in the table will be unaffected by the alignment. Possible directions is: left,
271             center, right, justify, auto or your own subroutine. (Hint: Using auto(default), aligns numbers right and text left)
272              
273             =cut
274              
275             sub alignCol {
276 5     5 1 8 my ($self,$col,$direction) = @_;
277 5 0 33     31 do { $self->reperror("alignCol is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($direction) || (defined($col) && ref($col) eq 'HASH');
  0 0 0     0  
  0   33     0  
278 5 0 0     13 do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols})) || (defined($col) && ref($col) eq 'HASH');
  0 0 33     0  
  0         0  
279              
280 5 50       17 if (ref($col) eq 'HASH') {
281 0         0 for (keys %{$col}) {
  0         0  
282 0 0       0 do { $self->reperror("Could not find '$_' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($_,$self->{tbl_cols}));
  0 0       0  
  0         0  
283 0         0 $self->{tbl_align}{$_} = $col->{$_};
284             }
285             } else {
286 5         18 $self->{tbl_align}{$col} = $direction;
287             }
288 5 50       21 return $self->{options}{chaining} ? $self : undef;
289             }
290              
291             =head2 alignColName($col,$direction)
292              
293             Given a columnname, it aligns the columnname in the row explaining columnnames, to the given direction. (auto,left,right,center,justify
294             or a subroutine) (Hint: Overrides the 'alignHeadRow' option for the specified column.)
295              
296             =cut
297              
298             sub alignColName {
299 0     0 1 0 my ($self,$col,$direction) = @_;
300 0 0 0     0 do { $self->reperror("alignColName is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($direction);
  0 0       0  
  0         0  
301 0 0       0 do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols}));
  0 0       0  
  0         0  
302              
303 0         0 $self->{tbl_colalign}{$col} = $direction;
304 0 0       0 return $self->{options}{chaining} ? $self : undef;
305             }
306              
307             =head2 setColWidth($col,$width,$strict)
308              
309             Wordwrapping/strict size. Set a max-width(in chars) for a column.
310             If last parameter is 1, the column will be set to the specified width, even if no text is that long.
311              
312             Usage:
313             $t->setColWidth('Description',30);
314              
315             =cut
316              
317             sub setColWidth {
318 1     1 1 3 my ($self,$col,$width,$strict) = @_;
319 1 0 33     6 do { $self->reperror("setColWidth is missing parameter(s)"); return $self->{options}{chaining} ? $self : 1; } unless defined($col) && defined($width);
  0 50       0  
  0         0  
320 1 0       4 do { $self->reperror("Could not find '$col' in columnlist"); return $self->{options}{chaining} ? $self : 1; } unless defined(&find($col,$self->{tbl_cols}));
  0 50       0  
  0         0  
321 1 0       1 do { $self->reperror("Cannot change width at this state"); return $self->{options}{chaining} ? $self : 1; } unless scalar(@{$self->{tbl_rows}}) == 0;
  1 50       8  
  0         0  
  0         0  
322              
323 1         7 $self->{tbl_width}{$col} = int($width);
324 1 50       3 $self->{tbl_width_strict}{$col} = $strict ? 1 : 0;
325              
326 1 50       4 return $self->{options}{chaining} ? $self : undef;
327             }
328              
329             sub headingWidth {
330 6     6 0 7 my $self = shift;
331 6         10 my $title = $self->{options}{headingText};
332 6         32 return max map {$self->count($_)} split /\r?\n/, $self->{options}{headingText};
  10         25  
333             }
334              
335             # drawing etc, below
336             sub getColWidth {
337 458     458 0 377 my ($self,$colname) = @_;
338 458 50       547 $self->reperror("Could not find '$colname' in columnlist") unless defined find($colname, $self->{tbl_cols});
339              
340 458         731 return $self->{cache_width}{$colname};
341             }
342              
343             # Width-calculating functions rewritten for more speed by Alexey Sheynuk
344             # Thanks :)
345             sub calculateColWidths {
346 30     30 0 32 my ($self) = @_;
347 30         48 $self->{cache_width} = undef;
348 30         65 my $cols = $self->{tbl_cols};
349 30         34 foreach my $c (0..$#{$cols}) {
  30         70  
350 92         86 my $colname = $cols->[$c];
351 92 50 66     254 if (defined($self->{tbl_width_strict}{$colname}) && ($self->{tbl_width_strict}{$colname} == 1) && int($self->{tbl_width}{$colname}) > 0) {
      33        
352             # maxsize plus the spaces on each side
353 0         0 $self->{cache_width}{$colname} = $self->{tbl_width}{$colname} + 2;
354             } else {
355 92         149 my $colwidth = max((map {$self->count($_)} split(/\n/,$colname)), (map {$self->count($_->[$c])} @{$self->{tbl_rows}}));
  94         122  
  346         377  
  92         129  
356 92         241 $self->{cache_width}{$colname} = $colwidth + 2;
357             }
358             }
359 30         101 $self->addExtraHeadingWidth;
360             }
361              
362             sub addExtraHeadingWidth {
363 30     30 0 35 my ($self) = @_;
364 30 100       90 return unless defined $self->{options}{headingText};
365 6         7 my $tablewidth = -3 + sum map {$_ + 1} values %{$self->{cache_width}};
  16         35  
  6         19  
366 6         18 my $headingwidth = $self->headingWidth();
367 6 100       17 if ($headingwidth > $tablewidth) {
368 4         6 my $extra = $headingwidth - $tablewidth;
369 4         3 my $cols = scalar(@{$self->{tbl_cols}});
  4         9  
370 4         9 my $extra_for_all = int($extra/$cols);
371 4         6 my $extrasome = $extra % $cols;
372 4         4 my $antall = 0;
373 4         4 foreach my $col (@{$self->{tbl_cols}}) {
  4         13  
374 12         7 my $extrawidth = $extra_for_all;
375 12 100       50 if ($antall < $extrasome) {
376 2         3 $antall++;
377 2         2 $extrawidth++;
378             }
379 12         29 $self->{cache_width}{$col} += $extrawidth;
380             }
381             }
382             }
383              
384             =head2 getTableWidth()
385              
386             If you need to know how wide your table will be before you draw it. Use this function.
387              
388             =cut
389              
390             sub getTableWidth {
391 38     38 1 1596 my $self = shift;
392 38         42 my $totalsize = 1;
393 38 100       81 if (!defined($self->{cache_TableWidth})) {
394 12         33 $self->calculateColWidths;
395 12         15 grep {$totalsize += $self->getColWidth($_,undef) + 1} @{$self->{tbl_cols}};
  35         67  
  12         27  
396 12         29 $self->{cache_TableWidth} = $totalsize;
397             }
398 38         55 return $self->{cache_TableWidth};
399             }
400              
401             sub drawLine {
402 55     55 0 74 my ($self,$start,$stop,$line,$delim) = @_;
403 55 50       115 do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($stop);
  0         0  
  0         0  
404 55 50       80 $line = defined($line) ? $line : '-';
405 55 50       70 $delim = defined($delim) ? $delim : '+';
406              
407 55         37 my $contents;
408              
409 55         63 $contents = $start;
410              
411 55         61 for (my $i=0;$i < scalar(@{$self->{tbl_cols}});$i++) {
  228         394  
412 173         119 my $offset = 0;
413 173 100       255 $offset = $self->count($start) - 1 if ($i == 0);
414 173 100       114 $offset = $self->count($stop) - 1 if ($i == scalar(@{$self->{tbl_cols}}) -1);
  173         313  
415              
416 173         142 $contents .= $line x ($self->getColWidth(@{$self->{tbl_cols}}[$i]) - $offset);
  173         283  
417              
418 173 100       124 $contents .= $delim if ($i != scalar(@{$self->{tbl_cols}}) - 1);
  173         339  
419             }
420 55         179 return $contents.$stop."\n";
421             }
422              
423             =head2 setOptions(name,value) or setOptions({ option1 => value1, option2 => value2, ... })
424              
425             Use this to set options like: hide_FirstLine,reportErrors, etc.
426              
427             Usage:
428             $t->setOptions('hide_HeadLine',1);
429            
430             Or set more than one option on the fly:
431             $t->setOptions({ hide_HeadLine => 1, hide_HeadRow => 1 });
432              
433             B
434              
435             =over 4
436              
437             =item hide_HeadRow
438              
439             Hides output of the columnlisting. Together with hide_HeadLine, this makes a table only show the rows. (However, even though
440             the column-names will not be shown, they will affect the output if they have for example ridiculoustly long
441             names, and the rows contains small amount of info. You would end up with a lot of whitespace)
442              
443             =item reportErrors
444              
445             Set to 0 to disable error reporting. Though if a function encounters an error, it will still return the value 1, to
446             tell you that things didn't go exactly as they should.
447              
448             =item allowHTML
449              
450             If you are going to use Text::ASCIITable to be shown on HTML pages, you should set this option to 1 when you are going
451             to use HTML tags to for example color the text inside the rows, and you want the browser to handle the table correct.
452              
453             =item allowANSI
454              
455             If you use ANSI codes like [1mHi this is bold[m or similar. This option will make the table to be
456             displayed correct when showed in a ANSI compliant terminal. Set this to 1 to enable. There is an example of ANSI support
457             in this package, named ansi-example.pl.
458              
459             =item alignHeadRow
460              
461             Set wich direction the Column-names(in the headrow) are supposed to point. Must be left, right, center, justify, auto or a user-defined subroutine.
462              
463             =item hide_FirstLine, hide_HeadLine, hide_LastLine
464              
465             Speaks for it self?
466              
467             =item drawRowLine
468              
469             Set this to 1 to print a line between each row. You can also define the outputstyle
470             of this line in the draw() function.
471              
472             =item headingText
473              
474             Add a heading above the columnnames/rows wich uses the whole width of the table to output
475             a heading/title to the table. The heading-part of the table is automatically shown when
476             the headingText option contains text. B If this text is so long that it makes the
477             table wider, it will not hesitate to change width of columns that have "strict width".
478              
479             It supports multiline, and with Text::ASCIITable::Wrap you may wrap your text before entering
480             it, to prevent the title from expanding the table. Internal wrapping-support for headingText
481             might come in the future.
482              
483             =item headingAlign
484              
485             Align the heading(as mentioned above) to left, right, center, auto or using a subroutine.
486              
487             =item headingStartChar, headingStopChar
488              
489             Choose the startingchar and endingchar of the row where the title is. The default is
490             '|' on both. If you didn't understand this, try reading about the draw() function.
491              
492             =item cb_count
493              
494             Set the callback subroutine to use when counting characters inside the table. This is useful
495             to make support for having characters or codes inside the table that are not shown on the
496             screen to the user, so the table should not count these characters. This could be for example
497             HTML tags, or ANSI codes. Though those two examples are alredy supported internally with the
498             allowHTML and allowANSI, options. This option expects a CODE reference. (\&callback_function)
499              
500             =item undef_as
501              
502             Sets the replacing string that replaces an undef value sent to addRow() (or even the overloaded
503             push version of addRow()). The default value is an empty string ''. An example of use would be
504             to set it to '(undef)', to show that the input really was undefined.
505              
506              
507             =item chaining
508              
509             Set this to 1 to support chainging of methods. The default is 0, where the methods return 1 if
510             they come upon an error as mentioned in the reportErrors option description.
511              
512             Usage example:
513             print Text::ASCIITable->new({ chaining => 1 })
514             ->setCols('One','Two','Three')
515             ->addRow([
516             [ 1, 2, 3 ],
517             [ 4, 5, 6 ],
518             [ 7, 8, 9 ],
519             ])
520             ->draw();
521              
522             Note that ->draw() can be omitted, since Text::ASCIITable is overloaded to print the table by default.
523              
524             =back
525              
526             =cut
527              
528             sub setOptions {
529 5     5 1 174 my ($self,$name,$value) = @_;
530 5         6 my $old;
531 5 50       17 if (ref($name) eq 'HASH') {
532 0         0 for (keys %{$name}) {
  0         0  
533 0         0 $self->{options}{$_} = $name->{$_};
534             }
535             } else {
536 5   100     72 $old = $self->{options}{$name} || undef;
537 5         12 $self->{options}{$name} = $value;
538             }
539 5         10 return $old;
540             }
541              
542             # Thanks to Khemir Nadim ibn Hamouda
543             # Original code from Spreadsheet::Perl::ASCIITable
544             sub prepareParts {
545 1     1 0 2 my ($self)=@_;
546 1         1 my $running_width = 1 ;
547              
548 1         1 $self->{tbl_cuts} = [];
549 1         1 foreach my $column (@{$self->{tbl_cols}}) {
  1         3  
550 3         4 my $column_width = $self->getColWidth($column,undef);
551 3 100       8 if ($running_width + $column_width >= $self->{options}{outputWidth}) {
552 1         1 push @{$self->{tbl_cuts}}, $running_width;
  1         2  
553 1         1 $running_width = $column_width + 2;
554             } else {
555 2         3 $running_width += $column_width + 1 ;
556             }
557             }
558 1         1 push @{$self->{tbl_cuts}}, $self->getTableWidth() ;
  1         2  
559             }
560              
561             sub pageCount {
562 2     2 0 29 my $self = shift;
563 2 50       5 do { $self->reperror("Table has no max output-width set"); return 1; } unless defined($self->{options}{outputWidth});
  0         0  
  0         0  
564              
565 2 50       4 return 1 if ($self->getTableWidth() < $self->{options}{outputWidth});
566 2 100       5 $self->prepareParts() if (scalar(@{$self->{tbl_cuts}}) < 1);
  2         6  
567              
568 2         2 return scalar(@{$self->{tbl_cuts}});
  2         5  
569             }
570              
571             sub drawSingleColumnRow {
572 5     5 0 9 my ($self,$text,$start,$stop,$align,$opt) = @_;
573 5 50       14 do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($text);
  0         0  
  0         0  
574              
575 5         6 my $contents = $start;
576 5         6 my $width = 0;
577 5         11 my $tablewidth = $self->getTableWidth();
578             # ok this is a bad shortcut, but 'till i get up with a better one, I use this.
579 5 50 33     10 if (($tablewidth - 4) < $self->count($text) && $opt eq 'title') {
580 0         0 $width = $self->count($text);
581             }
582             else {
583 5         10 $width = $tablewidth - 4;
584             }
585             $contents .= ' '.$self->align(
586             $text,
587             $align || 'left',
588             $width,
589 5 50 50     48 ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count} ?0:1)
      33        
590             ).' ';
591 5         21 return $contents.$stop."\n";
592             }
593              
594             sub drawRow {
595 85     85 0 114 my ($self,$row,$isheader,$start,$stop,$delim) = @_;
596 85 50       137 do { $self->reperror("Missing reqired parameters"); return 1; } unless defined($row);
  0         0  
  0         0  
597 85   100     212 $isheader = $isheader || 0;
598 85   50     134 $delim = $delim || '|';
599              
600 85         71 my $contents = $start;
601 85         82 for (my $i=0;$i
  332         493  
602 247         231 my $colwidth = $self->getColWidth(@{$self->{tbl_cols}}[$i]);
  247         409  
603 247         212 my $text = @{$row}[$i];
  247         235  
604              
605 247 100 100     499 if ($isheader != 1 && defined($self->{tbl_align}{@{$self->{tbl_cols}}[$i]})) {
  190 100       507  
606             $contents .= ' '.$self->align(
607             $text,
608             $self->{tbl_align}{@{$self->{tbl_cols}}[$i]} || 'auto',
609             $colwidth-2,
610 29 50 50     32 ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1)
      33        
611             ).' ';
612             } elsif ($isheader == 1) {
613              
614             $contents .= ' '.$self->align(
615             $text,
616             $self->{tbl_colalign}{@{$self->{tbl_cols}}[$i]} || $self->{options}{alignHeadRow} || 'left',
617             $colwidth-2,
618 57 100 50     93 ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1)
      66        
619             ).' ';
620             } else {
621             $contents .= ' '.$self->align(
622             $text,
623             'auto',
624             $colwidth-2,
625 161 100 66     624 ($self->{options}{allowHTML} || $self->{options}{allowANSI} || $self->{options}{cb_count}?0:1)
626             ).' ';
627             }
628 247 100       203 $contents .= $delim if ($i != scalar(@{$row}) - 1);
  247         468  
629             }
630 85         193 return $contents.$stop."\n";
631             }
632              
633             =head2 draw([@topdesign,@toprow,@middle,@middlerow,@bottom,@rowline])
634              
635             All the arrays containing the layout is optional. If you want to make your own "design" to the table, you
636             can do that by giving this method these arrays containing information about which characters to use
637             where.
638              
639             B
640              
641             The draw method takes C<6> arrays of strings to define the layout. The first, third, fifth and sixth is B
642             layout and the second and fourth is B layout. The C parameter is repeated for each row in the table.
643             The sixth parameter is only used if drawRowLine is enabled.
644              
645             $t->draw(,,,,,[])
646              
647             =over 4
648              
649             =item LINE
650              
651             Takes an array of C<4> strings. For example C<['|','|','-','+']>
652              
653             =over 4
654              
655             =item *
656              
657             LEFT - Defines the left chars. May be more than one char.
658              
659             =item *
660              
661             RIGHT - Defines the right chars. May be more then one char.
662              
663             =item *
664              
665             LINE - Defines the char used for the line. B.
666              
667             =item *
668              
669             DELIMETER - Defines the char used for the delimeters. B.
670              
671             =back
672              
673             =item ROW
674              
675             Takes an array of C<3> strings. You should not give more than one char to any of these parameters,
676             if you do.. it will probably destroy the output.. Unless you do it with the knowledge
677             of how it will end up. An example: C<['|','|','+']>
678              
679             =over 4
680              
681             =item *
682              
683             LEFT - Define the char used for the left side of the table.
684              
685             =item *
686              
687             RIGHT - Define the char used for the right side of the table.
688              
689             =item *
690              
691             DELIMETER - Defines the char used for the delimeters.
692              
693             =back
694              
695             =back
696              
697             Examples:
698              
699             The easiest way:
700              
701             print $t;
702              
703             Explanatory example:
704              
705             print $t->draw( ['L','R','l','D'], # LllllllDllllllR
706             ['L','R','D'], # L info D info R
707             ['L','R','l','D'], # LllllllDllllllR
708             ['L','R','D'], # L info D info R
709             ['L','R','l','D'] # LllllllDllllllR
710             );
711              
712             Nice example:
713              
714             print $t->draw( ['.','.','-','-'], # .-------------.
715             ['|','|','|'], # | info | info |
716             ['|','|','-','-'], # |-------------|
717             ['|','|','|'], # | info | info |
718             [' \\','/ ','_','|'] # \_____|_____/
719             );
720              
721             Nice example2:
722              
723             print $t->draw( ['.=','=.','-','-'], # .=-----------=.
724             ['|','|','|'], # | info | info |
725             ['|=','=|','-','+'], # |=-----+-----=|
726             ['|','|','|'], # | info | info |
727             ["'=","='",'-','-'] # '=-----------='
728             );
729              
730             With Options:
731              
732             $t->setOptions('drawRowLine',1);
733             print $t->draw( ['.=','=.','-','-'], # .=-----------=.
734             ['|','|','|'], # | info | info |
735             ['|-','-|','=','='], # |-===========-|
736             ['|','|','|'], # | info | info |
737             ["'=","='",'-','-'], # '=-----------='
738             ['|=','=|','-','+'] # rowseperator
739             );
740             Which makes this output:
741             .=-----------=.
742             | col1 | col2 |
743             |-===========-|
744             | info | info |
745             |=-----+-----=| <-- rowseperator between each row
746             | info | info |
747             '=-----------='
748              
749             A tips is to enable allowANSI, and use the extra charset in your terminal to create
750             a beautiful table. But don't expect to get good results if you use ANSI-formatted table
751             with $t->drawPage.
752              
753             B
754              
755             If you want to format your text more throughoutly than "auto", or think you
756             have a better way of aligning text; you can make your own subroutine.
757              
758             Here's a exampleroutine that aligns the text to the right.
759            
760             sub myownalign_cb {
761             my ($text,$length,$count,$strict) = @_;
762             $text = (" " x ($length - $count)) . $text;
763             return substr($text,0,$length) if ($strict);
764             return $text;
765             }
766              
767             $t->alignCol('Info',\&myownalign_cb);
768              
769             B
770              
771             This is a feature to use if you are not happy with the internal allowHTML or allowANSI
772             support. Given is an example of how you make a count-callback that makes ASCIITable support
773             ANSI codes inside the table. (would make the same result as setting allowANSI to 1)
774              
775             $t->setOptions('cb_count',\&myallowansi_cb);
776             sub myallowansi_cb {
777             $_=shift;
778             s/\33\[(\d+(;\d+)?)?[musfwhojBCDHRJK]//g;
779             return length($_);
780             }
781              
782             =cut
783              
784 6     6 0 21 sub drawit {scalar shift()->draw()}
785              
786             =head2 drawPage($page,@topdesign,@toprow,@middle,@middlerow,@bottom,@rowline)
787              
788             If you don't want your table to be wider than your screen you can use this
789             with $t->setOptions('outputWidth',40) to set the max size of the output.
790              
791             Example:
792              
793             $t->setOptions('outputWidth',80);
794             for my $page (1..$t->pageCount()) {
795             print $t->drawPage($page)."\n";
796             print "continued..\n\n";
797             }
798              
799             =cut
800              
801             sub drawPage {
802 2     2 1 6 my $self = shift;
803 2         3 my ($pagenum,$top,$toprow,$middle,$middlerow,$bottom,$rowline) = @_;
804 2         7 return $self->draw($top,$toprow,$middle,$middlerow,$bottom,$rowline,$pagenum);
805             }
806              
807             # Thanks to Khemir Nadim ibn Hamouda for code and idea.
808             sub getPart {
809 145     145 0 145 my ($self,$page,$text) = @_;
810 145         99 my $offset=0;
811              
812 145 100       357 return $text unless $page > 0;
813 14         26 $text =~ s/\n$//;
814              
815 14 50       7 $self->prepareParts() if (scalar(@{$self->{tbl_cuts}}) < 1);
  14         24  
816 14         23 $offset += (@{$self->{tbl_cuts}}[$_] - 1) for(0..$page-2);
  7         12  
817              
818 14         8 return substr($text, $offset, @{$self->{tbl_cuts}}[$page-1]) . "\n" ;
  14         36  
819             }
820              
821             sub draw {
822 18     18 1 28 my $self = shift;
823 18         24 my ($top,$toprow,$middle,$middlerow,$bottom,$rowline,$page) = @_;
824 18 100       47 my ($tstart,$tstop,$tline,$tdelim) = defined($top) ? @{$top} : @{$self->{des_top}};
  1         1  
  17         39  
825 18 100       46 my ($trstart,$trstop,$trdelim) = defined($toprow) ? @{$toprow} : @{$self->{des_toprow}};
  1         2  
  17         36  
826 18 100       54 my ($mstart,$mstop,$mline,$mdelim) = defined($middle) ? @{$middle} : @{$self->{des_middle}};
  1         2  
  17         29  
827 18 100       45 my ($mrstart,$mrstop,$mrdelim) = defined($middlerow) ? @{$middlerow} : @{$self->{des_middlerow}};
  1         1  
  17         31  
828 18 100       39 my ($bstart,$bstop,$bline,$bdelim) = defined($bottom) ? @{$bottom} : @{$self->{des_bottom}};
  1         2  
  17         30  
829 18 50       38 my ($rstart,$rstop,$rline,$rdelim) = defined($rowline) ? @{$rowline} : @{$self->{des_rowline}};
  0         0  
  18         36  
830 18 100       22 my $contents=""; $page = defined($page) ? $page : 0;
  18         41  
831              
832 18         25 delete $self->{cache_TableWidth}; # Clear cache
833 18         57 $self->calculateColWidths;
834              
835 18 100       77 $contents .= $self->getPart($page,$self->drawLine($tstart,$tstop,$tline,$tdelim)) unless $self->{options}{hide_FirstLine};
836 18 100       49 if (defined($self->{options}{headingText})) {
837 3         7 my $title = $self->{options}{headingText};
838 3 100       11 if ($title =~ m/\n/) { # Multiline title-support
839 2         13 my @lines = split(/\r?\n/,$title);
840 2         4 foreach my $line (@lines) {
841 4   50     56 $contents .= $self->getPart($page,$self->drawSingleColumnRow($line,$self->{options}{headingStartChar} || '|',$self->{options}{headingStopChar} || '|',$self->{options}{headingAlign} || 'center','title'));
      50        
      100        
842             }
843             } else {
844 1   50     24 $contents .= $self->getPart($page,$self->drawSingleColumnRow($self->{options}{headingText},$self->{options}{headingStartChar} || '|',$self->{options}{headingStopChar} || '|',$self->{options}{headingAlign} || 'center','title'));
      50        
      50        
845             }
846 3 50       19 $contents .= $self->getPart($page,$self->drawLine($mstart,$mstop,$mline,$mdelim)) unless $self->{options}{hide_HeadLine};
847             }
848              
849 18 100       50 unless ($self->{options}{hide_HeadRow}) {
850             # multiline-column-support
851 17         19 foreach my $row (@{$self->{tbl_multilinecols}}) {
  17         44  
852 18         77 $contents .= $self->getPart($page,$self->drawRow($row,1,$trstart,$trstop,$trdelim));
853             }
854             }
855 18 100       88 $contents .= $self->getPart($page,$self->drawLine($mstart,$mstop,$mline,$mdelim)) unless $self->{options}{hide_HeadLine};
856 18         26 my $i=0;
857 18         21 for (@{$self->{tbl_rows}}) {
  18         48  
858 67         61 $i++;
859 67         109 $contents .= $self->getPart($page,$self->drawRow($_,0,$mrstart,$mrstop,$mrdelim));
860 67 50 33     334 if (($self->{options}{drawRowLine} && $self->{tbl_rowline}{$i} && ($i != scalar(@{$self->{tbl_rows}}))) ||
  0   0     0  
      66        
      33        
      33        
      33        
861 1         5 (defined($self->{tbl_lines}{$i}) && $self->{tbl_lines}{$i} && ($i != scalar(@{$self->{tbl_rows}})) && ($i != scalar(@{$self->{tbl_rows}})))) {
  1         4  
862 1         2 $contents .= $self->getPart($page,$self->drawLine($rstart,$rstop,$rline,$rdelim))
863             }
864             }
865 18 100       92 $contents .= $self->getPart($page,$self->drawLine($bstart,$bstop,$bline,$bdelim)) unless $self->{options}{hide_LastLine};
866              
867 18         91 return $contents;
868             }
869              
870             # nifty subs
871              
872             # Replaces length() because of optional HTML and ANSI stripping
873             sub count {
874 993     993 0 848 my ($self,$str) = @_;
875              
876 993 50 33     3287 if (defined($self->{options}{cb_count}) && ref($self->{options}{cb_count}) eq 'CODE') {
    50 33        
877 0         0 my $ret = eval { return &{$self->{options}{cb_count}}($str); };
  0         0  
  0         0  
878 0 0       0 return $ret if (!$@);
879 0 0       0 do { $self->reperror("Error: 'cb_count' callback returned error, ".$@); return 1; } if ($@);
  0         0  
  0         0  
880             }
881             elsif (defined($self->{options}{cb_count}) && ref($self->{options}{cb_count}) ne 'CODE') {
882 0         0 $self->reperror("Error: 'cb_count' set but no valid callback found, found ".ref($self->{options}{cb_count}));
883 0         0 return length($str);
884             }
885 993 100       1563 $str =~ s/<.+?>//g if $self->{options}{allowHTML};
886 993 100       1219 $str =~ s/\33\[(\d+(;\d+)?)?[musfwhojBCDHRJK]//g if $self->{options}{allowANSI}; # maybe i should only have allowed ESC[#;#m and not things not related to
887 993 100       1219 $str =~ s/\33\([0B]//g if $self->{options}{allowANSI}; # color/bold/underline.. But I want to give people as much room as they need.
888              
889 993         1313 return length($str);
890             }
891              
892             sub align {
893              
894 288     288 0 336 my ($self,$text,$dir,$length,$strict) = @_;
895              
896 288 100       703 if ($dir =~ /auto/i) {
897 215 100       472 if ($text =~ /^-?\d+([.,]\d+)*[%\w]?$/) {
898 35         48 $dir = 'right';
899             } else {
900 180         173 $dir = 'left';
901             }
902             }
903 288 50       735 if (ref($dir) eq 'CODE') {
    100          
    100          
    50          
    50          
904 0         0 my $ret = eval { return &{$dir}($text,$length,$self->count($text),$strict); };
  0         0  
  0         0  
905 0 0       0 return 'CB-ERR' if ($@);
906             # Removed in v0.14 # return 'CB-LEN-ERR' if ($self->count($ret) != $length);
907 0         0 return $ret;
908             } elsif ($dir =~ /right/i) {
909 79         133 my $visuallen = $self->count($text);
910 79         72 my $reallen = length($text);
911 79 100       137 if ($length - $visuallen > 0) {
912 72         130 $text = (" " x ($length - $visuallen)).$text;
913             }
914 79 100       236 return substr($text,0,$length - ($visuallen-$reallen)) if ($strict);
915 16         41 return $text;
916             } elsif ($dir =~ /left/i) {
917 192         259 my $visuallen = $self->count($text);
918 192         149 my $reallen = length($text);
919 192 100       290 if ($length - $visuallen > 0) {
920 116         175 $text = $text.(" " x ($length - $visuallen));
921             }
922 192 100       504 return substr($text,0,$length - ($visuallen-$reallen)) if ($strict);
923 28         69 return $text;
924             } elsif ($dir =~ /justify/i) {
925 0         0 my $visuallen = $self->count($text);
926 0         0 my $reallen = length($text);
927 0 0       0 $text = substr($text,0,$length - ($visuallen-$reallen)) if ($strict);
928 0 0       0 if ($self->count($text) < $length - ($visuallen-$reallen)) {
929 0         0 $text =~ s/^\s+//; # trailing whitespace
930 0         0 $text =~ s/\s+$//; # tailing whitespace
931              
932 0         0 my @tmp = split(/\s+/,$text); # split them words
933              
934 0 0       0 if (scalar(@tmp)) {
935 0         0 my $extra = $length - $self->count(join('',@tmp)); # Length of text without spaces
936              
937 0         0 my $modulus = $extra % (scalar(@tmp)); # modulus
938 0         0 $extra = int($extra / (scalar(@tmp))); # for each word
939              
940 0         0 $text = '';
941 0         0 foreach my $word (@tmp) {
942 0         0 $text .= $word . (' ' x $extra); # each word
943 0 0       0 if ($modulus) {
944 0         0 $modulus--;
945 0         0 $text .= ' '; # the first $modulus words, to even out
946             }
947             }
948             }
949             }
950 0         0 return $text; # either way, output text
951             } elsif ($dir =~ /center/i) {
952 17         28 my $visuallen = $self->count($text);
953 17         14 my $reallen = length($text);
954 17         24 my $left = ( $length - $visuallen ) / 2;
955             # Someone tell me if this is matematecally totally wrong. :P
956 17 100 100     62 $left = int($left) + 1 if ($left != int($left) && $left > 0.4);
957 17         21 my $right = int(( $length - $visuallen ) / 2);
958 17 100       53 $text = ($left > 0 ? " " x $left : '').$text.($right > 0 ? " " x $right : '');
    100          
959 17 100       45 return substr($text,0,$length) if ($strict);
960 10         31 return $text;
961             } else {
962 0         0 return $self->align($text,'auto',$length,$strict);
963             }
964             }
965              
966             sub TIEARRAY {
967 3     3   3 my $self = shift;
968              
969 3         9 return bless { workaround => $self } , ref $self;
970             }
971             sub FETCH {
972 0     0   0 shift->{workaround}->reperror('usage: push @$t,qw{ one more row };');
973 0         0 return undef;
974             }
975             sub STORE {
976 0     0   0 my $self = shift->{workaround};
977 0         0 my ($index, $value) = @_;
978              
979 0         0 $self->reperror('usage: push @$t,qw{ one more row };');
980             }
981 0     0   0 sub FETCHSIZE {return 0;}
982 0     0   0 sub STORESIZE {return;}
983              
984             # PodMaster should be really happy now, since this was in his wishlist. (ref: http://perlmonks.thepen.com/338456.html)
985             sub PUSH {
986 3     3   4 my $self = shift->{workaround};
987 3         4 my @list = @_;
988              
989 3 50       2 if (scalar(@list) > scalar(@{$self->{tbl_cols}})) {
  3         7  
990 0         0 $self->reperror("too many elements added");
991 0         0 return;
992             }
993              
994 3         5 $self->addRow(@list);
995             }
996              
997             sub reperror {
998 0     0 0 0 my $self = shift;
999 0 0       0 print STDERR Carp::shortmess(shift) if $self->{options}{reportErrors};
1000             }
1001              
1002             # Best way I could think of, to search the array.. Please tell me if you got a better way.
1003             sub find {
1004 464 50   464 0 594 return undef unless defined $_[1];
1005 464 100       334 grep {return $_ if @{$_[1]}[$_] eq $_[0];} (0..scalar(@{$_[1]})-1);
  946         580  
  946         2111  
  464         561  
1006 0           return undef;
1007             }
1008              
1009             1;
1010              
1011             __END__