Text-FormatTable-1.03/0000755000076600001200000000000011232427622014651 5ustar treyadmin00000000000000Text-FormatTable-1.03/Changes0000644000076600001200000000131411232427512016141 0ustar treyadmin00000000000000Revision history for Perl extension Text::FormatTable. 2009-07-24 (1.03) * Fix for rt34546, uninitialized warning generated with a zero-length column 2009-07-23 (1.02) * Added support for ASCII color sequences. The escape codes are no longer included when calculating column widths. (Trey Harris) * Trey Harris takes over maintainership. 2004-06-10 (1.01) * Fixed column width and bottom alignment (Veselin Slavov) 2003-01-28 * add Text::ASCIITable to SEE ALSO 2002-11-05 * nicely format space rules 2002-11-05 * released 1.00 (code seems to be stable, no problems since 1.5 years) * small documentation fix 2001-08-22 * first version (0.01) Text-FormatTable-1.03/example.pl0000644000076600001200000000044011232131675016637 0ustar treyadmin00000000000000use lib 'lib'; use Text::FormatTable; my $table = Text::FormatTable->new('r|l'); $table->head('a', 'b'); $table->rule('='); $table->row('this a test, a nice test', 'a test!'); $table->rule; $table->row('you mean it\'s really a test?', 'yep'); $table->rule('='); print $table->render(20); Text-FormatTable-1.03/lib/0000755000076600001200000000000011232427622015417 5ustar treyadmin00000000000000Text-FormatTable-1.03/lib/Text/0000755000076600001200000000000011232427622016343 5ustar treyadmin00000000000000Text-FormatTable-1.03/lib/Text/FormatTable.pm0000644000076600001200000003200011232427347021100 0ustar treyadmin00000000000000package Text::FormatTable; use Carp; use strict; use warnings; use vars qw($VERSION); $VERSION = '1.03'; =head1 NAME Text::FormatTable - Format text tables =head1 SYNOPSIS my $table = Text::FormatTable->new('r|l'); $table->head('a', 'b'); $table->rule('='); $table->row('c', 'd'); print $table->render(20); =head1 DESCRIPTION Text::FormatTable renders simple tables as text. You pass to the constructor (I) a table format specification similar to LaTeX (e.g. C) and you call methods to fill the table data and insert rules. After the data is filled, you call the I method and the table gets formatted as text. Methods: =over 4 =cut # Remove ANSI color sequences when calculating length sub _uncolorized_length($) { my $str = shift; $str =~ s/\e \[ [^m]* m//xmsg; return length $str; } # minimal width of $1 if word-wrapped sub _min_width($) { my $str = shift; my $min; for my $s (split(/\s+/,$str)) { my $l = _uncolorized_length $s; $min = $l if not defined $min or $l > $min; } return $min ? $min : 1; } # width of $1 if not word-wrapped sub _max_width($) { my $str = shift; my $len = _uncolorized_length $str; return $len ? $len : 1; } sub _max($$) { my ($a,$b) = @_; return $a if defined $a and (not defined $b or $a >= $b); return $b; } # word-wrap multi-line $2 with width $1 sub _wrap($$) { my ($width, $text) = @_; my @lines = split(/\n/, $text); my @w = (); for my $l (@lines) { push @w, @{_wrap_line($width, $l)}; } return \@w; } sub _wrap_line($$) { my ($width, $text) = @_; my $width_m1 = $width-1; my @t = ($text); while(1) { my $t = pop @t; my $l = _uncolorized_length $t; if($l <= $width){ # last line is ok => done push @t, $t; return \@t; } elsif($t =~ /^(.{0,$width_m1}\S)\s+(\S.*?)$/) { # farest space < width push @t, $1; push @t, $2; } elsif($t =~ /(.{$width,}?\S)\s+(\S.*?)$/) { # nearest space > width if ( _uncolorized_length $1 > $width_m1 ) { # hard hyphanation my $left = substr($1,0,$width); my $right= substr($1,$width); push @t, $left; push @t, $right; push @t, $2; } else { push @t, $1; push @t, $2; } } else { # hard hyphanation my $left = substr($t,0,$width); my $right= substr($t,$width); push @t, $left; push @t, $right; return \@t; } } return \@t; } # render left-box $2 with width $1 sub _l_box($$) { my ($width, $text) = @_; my $lines = _wrap($width, $text); map { $_ .= ' 'x($width-_uncolorized_length($_)) } @$lines; return $lines; } # render right-box $2 with width $1 sub _r_box($$) { my ($width, $text) = @_; my $lines = _wrap($width, $text); map { $_ = (' 'x($width-_uncolorized_length($_)).$_) } @$lines; return $lines; } # Algorithm of: # http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/eng/STORY.html sub _distribution_f($) { my $max_width = shift; return log($max_width); } sub _calculate_widths($$) { my ($self, $width) = @_; my @widths = (); # calculate min and max widths for each column for my $r (@{$self->{data}}) { $r->[0] eq 'data' or $r->[0] eq 'head' or next; my $cn=0; my ($max, $min) = (0,0); for my $c (@{$r->[1]}) { if ( $self->{fixed_widths}[$cn] ) { # fixed width $widths[$cn][0] = $self->{fixed_widths}[$cn]; $widths[$cn][1] = $self->{fixed_widths}[$cn]; } else { $widths[$cn][0] = _max($widths[$cn][0], _min_width $c); $widths[$cn][1] = _max($widths[$cn][1], _max_width $c); } $cn++; } } # calculate total min and max width my ($total_min, $total_max) = (0,0); for my $c (@widths) { $total_min += $c->[0]; $total_max += $c->[1]; } # extra space my $extra_width += scalar grep {$_->[0] eq '|' or $_->[0] eq ' '} (@{$self->{format}}); $total_min += $extra_width; $total_max += $extra_width; # if total_max <= screen width => use max as width if($total_max <= $width) { my $cn = 0; for my $c (@widths) { $self->{widths}[$cn]=$c->[1]; $cn++; } $self->{total_width} = $total_max; } else { my @dist_width; ITERATION: while(1) { my $total_f = 0.0; my $fixed_width = 0; my $remaining=0; for my $c (@widths) { if(defined $c->[2]) { $fixed_width += $c->[2]; } else { $total_f += _distribution_f($c->[1]); $remaining++; } } my $available_width = $width-$extra_width-$fixed_width; # enlarge width if it isn't enough if($available_width < $remaining*5) { $available_width = $remaining*5; $width = $extra_width+$fixed_width+$available_width; } my $cn=-1; COLUMN: for my $c (@widths) { $cn++; next COLUMN if defined $c->[2]; # skip fixed-widths my $w = _distribution_f($c->[1]) * $available_width / $total_f; if($c->[0] > $w) { $c->[2] = $c->[0]; next ITERATION; } if($c->[1] < $w) { $c->[2] = $c->[1]; next ITERATION; } $dist_width[$cn] = int($w); } last; } my $cn = 0; for my $c (@widths) { $self->{widths}[$cn]=defined $c->[2] ? $c->[2] : $dist_width[$cn]; $cn++; } } } sub _render_rule($$) { my ($self, $char) = @_; my $out = ''; my ($col,$data_col) = (0,0); for my $c (@{$self->{format}}) { if($c->[0] eq '|') { if ($char eq '-') { $out .= '+' } elsif($char eq ' ') { $out .= '|' } else { $out .= $char } } elsif($c->[0] eq ' ') { $out .= $char; } elsif( $c->[0] eq 'l' or $c->[0] eq 'L' or $c->[0] eq 'r' or $c->[0] eq 'R' ) { $out .= ($char)x($self->{widths}[$data_col]); $data_col++; } $col++; } return $out."\n"; } sub _render_data($$) { my ($self,$data) = @_; my @rdata; # rendered data # render every column and find out number of lines my ($col, $data_col) = (0,0); my $lines=0; my @rows_in_column; for my $c (@{$self->{format}}) { if( ($c->[0] eq 'l') or ($c->[0] eq 'L') ) { my $lb = _l_box($self->{widths}[$data_col], $data->[$data_col]); $rdata[$data_col] = $lb; my $l = scalar @$lb ; $lines = $l if $lines < $l; $rows_in_column[$data_col] = $l; $data_col++; } elsif( ($c->[0] eq 'r') or ($c->[0] eq 'R' ) ) { my $rb = _r_box($self->{widths}[$data_col], $data->[$data_col]); $rdata[$data_col] = $rb; my $l = scalar @$rb ; $lines = $l if $lines < $l; $rows_in_column[$data_col] = $l ; $data_col++; } $col++; } # render each line my $out = ''; for my $l (0..($lines-1)) { my ($col, $data_col) = (0,0); for my $c (@{$self->{format}}) { if($c->[0] eq '|') { $out .= '|'; } elsif($c->[0] eq ' ') { $out .= ' '; } elsif( $c->[0] eq 'L' or $c->[0] eq 'R') { # bottom align my $start_print = $lines - $rows_in_column[$data_col]; if ( defined $rdata[$data_col][$l-$start_print] and $l >= $start_print ) { $out .= $rdata[$data_col][$l-$start_print]; } else { $out .= ' 'x($self->{widths}[$data_col]); } $data_col++; } elsif($c->[0] eq 'l' or $c->[0] eq 'r') { # top align if(defined $rdata[$data_col][$l]) { $out .= $rdata[$data_col][$l]; } else { $out .= ' 'x($self->{widths}[$data_col]); } $data_col++; } $col++; } $out .= "\n"; } return $out; } sub _parse_format($$) { my ($self, $format) = @_; my @f = split(//, $format); my @format = (); my @width = (); my ($col,$data_col) = (0,0); my $wid; for my $f (@f) { if ( $f =~ /(\d+)/) { $wid .= $f; next; } if($f eq 'l' or $f eq 'L' or $f eq 'r' or $f eq 'R') { $format[$col] = [$f, $data_col]; $width[$data_col] = $wid; $wid = undef; $data_col++; } elsif($f eq '|' or $f eq ' ') { $format[$col] = [$f]; } else { croak "unknown column format: $f"; } $col++; } $self->{format}=\@format; $self->{fixed_widths}=\@width; $self->{col}=$col; $self->{data_col}=$data_col; } =item B(I<$format>) Create a Text::FormatTable object, the format of each column is specified as a character of the $format string. The following formats are defined: =over 4 =item l Left-justified top aligned word-wrapped text. =item L Left-justified bottom aligned word-wrapped text. =item r Right-justified top aligned word-wrapped text. =item R Right-justified bottom aligned word-wrapped text. =item 10R, 20r, 15L, 12l, Number is fixed width of the column. Justified and aligned word-wrapped text (see above). =item ' ' A space. =item | Column separator. =back =cut sub new($$) { my ($class, $format) = @_; croak "new() requires one argument: format" unless defined $format; my $self = { col => '0', row => '0', data => [] }; bless $self, $class; $self->_parse_format($format); return $self; } # remove head and trail space sub _preprocess_row_data($$) { my ($self,$data) = @_; my $cn = 0; for my $c (0..($#$data)) { $data->[$c] =~ s/^\s+//m; $data->[$c] =~ s/\s+$//m; } } =item B(I<$col1>, I<$col2>, ...) Add a header row using $col1, $col2, etc. as cell contents. Note that, at the moment, header rows are treated like normal rows. =cut sub head($@) { my ($self, @data) = @_; scalar @data == $self->{data_col} or croak "number of columns must be $self->{data_col}"; $self->_preprocess_row_data(\@data); $self->{data}[$self->{row}++] = ['head', \@data]; } =item B(I<$col1>, I<$col2>, ...) Add a row with $col1, $col2, etc. as cell contents. =cut sub row($@) { my ($self, @data) = @_; scalar @data == $self->{data_col} or croak "number of columns must be $self->{data_col}"; $self->_preprocess_row_data(\@data); $self->{data}[$self->{row}++] = ['data', \@data]; } =item B([I<$char>]) Add an horizontal rule. If $char is specified it will be used as character to draw the rule, otherwise '-' will be used. =cut sub rule($$) { my ($self, $char) = @_; $char = '-' unless defined $char; $self->{data}[$self->{row}++] = ['rule', $char]; } =item B([I<$screen_width>]) Return the rendered table formatted with $screen_width or 79 if it is not specified. =cut sub render($$) { my ($self, $width) = @_; $width = 79 unless defined $width; $self->_calculate_widths($width); my $out = ''; for my $r (@{$self->{data}}) { if($r->[0] eq 'rule') { $out .= $self->_render_rule($r->[1]); } elsif($r->[0] eq 'head') { $out .= $self->_render_data($r->[1]); } elsif($r->[0] eq 'data') { $out .= $self->_render_data($r->[1]); } } return $out; } 1; =back =head1 SEE ALSO Text::ASCIITable =head1 COPYRIGHT Copyright (c) 2001-2004 Swiss Federal Institute of Technology, Zurich. (c) 2009 Trey Harris All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 CODE REPOSITORY Git - http://github.com/treyharris/Text-FormatTable/tree/master =head1 AUTHOR S> Maintained by S> Fixed column width and bottom alignment written by S> =cut # vi: et sw=4 Text-FormatTable-1.03/Makefile.PL0000644000076600001200000000105511232136131016614 0ustar treyadmin00000000000000use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Text::FormatTable', 'VERSION_FROM' => 'lib/Text/FormatTable.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ($] >= 5.005 ? ## Add these new keywords supported since 5.005 (ABSTRACT_FROM => 'lib/Text/FormatTable.pm', # retrieve abstract from module AUTHOR => 'Trey Harris ', LICENSE => 'perl') : ()), ); Text-FormatTable-1.03/MANIFEST0000644000076600001200000000015511232140735016000 0ustar treyadmin00000000000000Changes example.pl lib/Text/FormatTable.pm Makefile.PL MANIFEST This list of files META.yml README test.pl Text-FormatTable-1.03/META.yml0000644000076600001200000000062111232427622016121 0ustar treyadmin00000000000000--- #YAML:1.0 name: Text-FormatTable version: 1.03 abstract: Format text tables license: perl author: - Trey Harris generated_by: ExtUtils::MakeMaker version 6.42 distribution_type: module requires: meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.3.html version: 1.3 Text-FormatTable-1.03/README0000644000076600001200000000155311232131675015535 0ustar treyadmin00000000000000Text::FormatTable ================= DESCRIPTION Text::FormatTable renders simple tables as text. You pass to the constructor a table format specification similar to LaTeX (e.g. "r|l|l") and you call methods to fill the table data and insert rules. After the data is filled, you render the table as text. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DOCUMENTATION The documentation is embedded in the module itself. Type 'perldoc lib/Text/FormatTable.pm' (or 'man Text::FormatTable' if the man-page was installed) to see it. COPYRIGHT AND LICENCE Copyright (c) 2001, Swiss Federal Institute of Technology, Zurich. (c) 2009 Trey Harris All Rights Reserved. This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Text-FormatTable-1.03/test.pl0000644000076600001200000000344411232427242016170 0ustar treyadmin00000000000000use Test; BEGIN { plan tests => 5 }; use Text::FormatTable; ok(1); # If we made it this far, we're ok. use strict; use warnings; { my $table = Text::FormatTable->new('r| l l'); $table->head('a', 'b', 'c'); $table->rule('='); $table->row('this a test, a nice test', 'oh, cool, a test!', 'yep'); $table->rule; $table->row('you mean it\'s really a test?', 'yes, it is.', 'z'); $table->rule('='); my $is = $table->render(15); my $shouldbe = <<'END'; a| b c ================= this a| oh, yep test,| cool, a nice| a test| test! ------+---------- you| yes, z mean| it it's| is. really| a| test?| ================= END ok($is, $shouldbe); } # Test behavior with ANSI-colored header { my $colortable = Text::FormatTable->new('l l l'); my $RED = "\e[31m"; my $RESET = "\e[0m"; $colortable->head('foo', $RED . 'bar' . $RESET, 'bat'); $colortable->rule('='); $colortable->row(qw(a b c)); my $output = $colortable->render(); my ($rule) = ($output =~ /(=+)/); ok(length($rule), length("foo bar bat")); } # Test behavior with ANSI-colored row data { my $colortable = Text::FormatTable->new('l l l'); my $RED = "\e[31m"; my $RESET = "\e[0m"; $colortable->head('foo', 'bar', 'bat'); $colortable->rule('='); $colortable->row('a', $RED . 'b' . $RESET, 'c'); my $output = $colortable->render(); my ($rule) = ($output =~ /(=+)/); ok(length($rule), length("foo bar bat")); } # rt34546, warnings when column has zero length { my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; my $table = Text::FormatTable->new('l l'); $table->head('foo', q{}); my $output = $table->render(); ok(not defined $warning); }