diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Template/Plugin/ASCIITable.pm | 634 |
1 files changed, 634 insertions, 0 deletions
diff --git a/lib/Template/Plugin/ASCIITable.pm b/lib/Template/Plugin/ASCIITable.pm new file mode 100644 index 0000000..b29dafc --- /dev/null +++ b/lib/Template/Plugin/ASCIITable.pm @@ -0,0 +1,634 @@ +package Template::Plugin::ASCIITable; +use base 'Template::Plugin'; +use Text::ASCIITable; +use vars qw($VERSION $AUTOLOAD); + +$VERSION='0.2'; + +=head1 NAME + +Template::Plugin::ASCIITable + +=head1 SYNOPSIS + + [% USE ASCIITable %] + blah + [% ASCIITable.cols('a', 'b', 'c'); + ASCIITable.rows([1,2,3],['one','two','three']); + ASCIITable.draw() %] + +=head1 DESCRIPTION + +This module allows you to use L<Text::ASCIITable> in your templates. + +A plugin object will be instantiated with the directive: + + [% USE ASCIITable %] + +You can pass a number of parameters to the constructor, for example: + + [% USE ASCIITable(cols => ['a','b','c'], show=>'rowline') %] + +See L</Parameters> for details. + +To obtain the table, you invoke the C<draw> method, to which you can +pass the same parameters: + + [% ASCIITable.draw(rows=>[[1,2,3],['one','two','three']]) %] + +=head1 METHODS + +=head2 C<new> + +This is the plugin construtor. You should never call it directly: use +the C<USE> directive. + +=cut + +sub new { + my ($class,$context,$params)=@_; + my $self=bless {hide=>{rowline=>1}},$class; + $self->handleParms(%$params) if $params; + return $self; +} + +=head2 C<draw> + +This method invokes L<Text::ASCIITable> to obtain the textual +representation of the table, and returns it. + +You can pass various parameters to it, see L</Parameters>. + +=cut + +sub draw { + my ($self,@rest)=@_; + $self->handleParms(@rest) if @rest; + my $t=Text::ASCIITable->new({$self->_globals()}); + $t->setCols($self->_colnames()); + for my $c ($self->_colprops()) { + $t->alignCol($c->{name},$c->{align}) if $c->{align}; + $t->alignColName($c->{name},$c->{nalign}) if $c->{nalign}; + $t->setColWidth($c->{name},$c->{width},$c->{widen}) if ($c->{width}||-1)>0; + } + for my $r ($self->_rows()) { + $t->addRow($r) + } + my $ret=$t->draw($self->_style()); + my ($l,$r)=$self->_squeeze(); + $ret=~s/^.{$l}//mg if $l; + $ret=~s/.{$r}$//mg if $r; + + $ret=~s/\n$//; + return $ret; +} + +my %paramSubs=( + hide => \&hide, + show => \&show, + cols => \&cols, + errors => \&errors, + reporterrors => \&errors, + allow => \&allow, + deny => \&deny, + alignheadrow => \&alignHeadRow, + rows => \&rows, + style => \&style, +); + +=head1 Parameters + +These parameters can be set in three ways: + +=over 4 + +=item * + +passing them to the constructor + +=item * + +passing them to the C<draw> call + +=item * + +setting them with individual method calls + +=back + +All three forms are case-insensitive: you can do + + [% USE t=ASCIITable(allow=>'HTML') %] + [% t.Allow('html') %] + [% t.draw(ALLOW=>'HtMl') %] + +=cut + +sub handleParms { + my ($self,%params)=@_; + for my $k (keys %params) { + if (exists $paramSubs{lc($k)}) { + $paramSubs{lc($k)}->($self,$params{$k}); + } else { + _die("no such parameter $k"); + } + } + return; +} + +=head2 C<hide> + +This parameter accepts a list of names of features to hide. The +recognized names are: + +=over 4 + +=item C<firstline> + +The very first decoration line of the table, before the column names. + +=item C<headrow> + +The line containing the names of the columns. + +=item C<headline> + +The decoration line separating the column names from the data lines. + +=item C<rowline> + +The decoration line separating one data line from the next. I<Hidden +by default>. + +=item C<lastline> + +The very last decoration line, after all the data. + +=back + +Note: C<t.hide('headrow');t.hide('headline')> will cause I<both> +features to be hidden. See L</show>. + +=cut + +sub hide { + my ($self,@what)=@_; + if (@what==1 and ref($what[0]) eq 'ARRAY') { + @what=@{$what[0]}; + } + @{$self->{hide}}{grep {m{(headrow)|((head|first|last|row)line)}} map {lc $_} @what}=(); + return; +} + +=head2 C<show> + +This parameter does the opposite of C<hide>: sets the given features +to be shown. + +Note: C<t.show('headrow');t.show('headline')> will cause I<both> +features to be shown. See L</hide>. + +=cut + +sub show { + my ($self,@what)=@_; + if (@what==1 and ref($what[0]) eq 'ARRAY') { + @what=@{$what[0]}; + } + delete @{$self->{hide}}{grep {m{(head(row|line))|((first|last|row)line)}} map {lc $_} @what}; + return; +} + +=head2 C<errors> + +Setting this to a true value will set the C<reportErrors> option (see +L<Text::ASCIITable>). + +=cut + +sub errors { + my ($self,$val)=@_; + $self->{errors}=$val; + return; +} + +=head2 C<allow> + +This parameter accepts a list of markup names to allow inside the +cells. This in needed to let C<Text::ASCIITable> calculate the correct +column widths. The recognized markups are: + +=over 4 + +=item C<ansi> + +This will allow you to use ANSI escape sequences for things like +colors or baldface. This usually works only if you output to a +compliant terminal. + +=item C<html> + +This will allow you to use HTML tags. No check is performed on the +well-formedness of any such tag. + +=back + +Note: C<t.allow('html');t.allow('ansi')> will cause I<both> +markups to be recognized. See L</deny>. + +=cut + +sub allow { + my ($self,@what)=@_; + if (@what==1 and ref($what[0]) eq 'ARRAY') { + @what=@{$what[0]}; + } + @{$self->{allow}}{grep {m{ansi|html}} map {lc $_} @what}=(); + return; +} + +=head2 C<deny> + +This parameter does the opposite of C<allow>: ignores the given +markups inside cells, counting them as data. + +Note: C<t.deny('html');t.deny('ansi')> will cause I<both> +markups to be ignored. See L</allow>. + +=cut + +sub deny { + my ($self,@what)=@_; + if (@what==1 and ref($what[0]) eq 'ARRAY') { + @what=@{$what[0]}; + } + delete @{$self->{allow}}{grep {m{ansi|html}} map {lc $_} @what}; + return; +} + +=head2 C<alignHeadRow> + +Sets the alignment for the column names. Can be one of: + +=over 4 + +=item * + +left + +=item * + +right + +=item * + +center + +=item * + +auto + +=back + +=cut + +sub alignHeadRow { + my ($self,$val)=@_; + $self->{headrow}=$val; + return; +} + +sub _handleCols { + my ($self,@colspec)=@_; + if (@colspec==1 and ref($colspec[0]) eq 'ARRAY') { + @colspec=@{$colspec[0]}; + } + my %colpos=(); + my @cols=(); + for (@colspec) { + if (ref $_) { + push @cols,{name=>$_->[0], + align=>$_->[1], + width=>$_->[2], + widen=>$_->[3], + nalign=>$_->[4], + }; + $colpos{$_->[0]}=$#cols; + } else { + push @cols,{name=>$_}; + $colpos{$_}=$#cols; + } + } + return (\@cols,\%colpos) +} + +=head2 C<cols> + +This parameter sets the names, and optionally some properties, of all +the columns in the table. To add columns to an existing table, use +the L</addCols> parameter (usually as a method). + +This parameter accepts a list of column specifications. Each +specification can be: + +=over 4 + +=item a single string + +that becomes the name of the column, and width and alignment default +to 'auto' + +=item an array reference + +that contains, in order: + +=over 8 + +=item * + +the name + +=item * + +the alignment for the data, one of 'left', 'right', 'center', 'auto' (see +L<Text::ASCIITable/alignCol>) + +=item * + +the maximum width of the column, in characters (see +L<Text::ASCIITable/setColWidth>) + +=item * + +whether to force the width of the column, a boolean (see +L<Text::ASCIITable/setColWidth>, the last parameter) + +=item * + +the name alignment (see L<Text::ASCIITable/alignColName>) + +=back + +=back + +Note: this sets I<all of the columns>. C<t.cols('a','b');t.cols('c')> +will result in a table with I<only 1> column. See L</addCols>. + +=cut + +sub cols { + my $self=shift; + ($self->{cols},$self->{colpos})=$self->_handleCols(@_); + return; +} + +=head2 C<addCols> + +This parameter works like C<cols>, but adds the given columns to the +existing ones, instead of replacing them. So +C<t.cols('a','b');t.addCols('c')> will result in a table with 3 columns. + +=cut + +sub addCols { + my $self=shift; + my ($cols,$colpos)=$self->_handleCols(@_); + push @{$self->{cols}},@$cols; + @{$self->{colpos}}{keys %$colpos}=values %$colpos; + return; +} + +=head2 C<rows> + +This parameter accepts a list of array references, one per row. Each +row must have one scalar element per each column that will be +produced. + +Note that, because of the way this plugin works, you can do something +like: + + [% USE t=ASCIITable(cols=>['a','b']); + t.rows([1,2,3],[4,5,6]); + t.addCols('c'); + t.draw() %] + +And it will print a 3x2 table. + +Note: this sets I<all of the rows>. +C<t.rows([1,2,3],[4,5,6]);t.rows([7,8,9])> +will result in a table with I<only 1> row. See L</addRows>. + +=cut + +sub rows { + my ($self,@rows)=@_; + if (@rows==1 and ref($rows[0]) eq 'ARRAY') { + @rows=@{$rows[0]}; + } + $self->{rows}=[@rows]; + return; +} + +=head2 C<addRows> + +This parameter works like C<rows>, but adds the given rows to the +existing ones, instead of replacing them. So +C<t.rows([1,2,3],[4,5,6]);t.addRows([7,8,9])> +will result in a table with 3 rows. + +=cut + +sub addRows { + my ($self,@row)=@_; + if (@row==1 and ref($row[0]) eq 'ARRAY') { + @row=@{$row[0]}; + } + push @{$self->{rows}},[@row]; + return; +} + +my %styles=( + 'default'=> + {lines=>undef, + globals=>{hide=>'rowline'}, + }, + 'rest-simple'=> + {lines=>[ + ['<','>','=',' '], + ['<','>',' '], + ['<','>','=',' '], + ['<','>',' '], + ['<','>','=',' '], + ['<','>','-',' '], + 1,1, + ], + globals=>{hide=>'rowline'}, + }, + 'rest-grid'=> + {lines=>[ + ['+','+','-','+'], + ['|','|','|'], + ['+','+','=','+'], + ['|','|','|'], + ['+','+','-','+'], + ['+','+','-','+'], + 0,0, + ], + globals=>{show=>'rowline'}, + }, + ); + +=head2 C<style> + +This parameter sets the draw style for the table. You can set it to a +list of array references, or to a style name. + +If you pass it a list, it can have 5, 6, or 8 elements. The first 6 +elements are interpreted in the same way as the parameters of +C<Text::ASCIITable::draw> (see L<Text::ASCIITable/Custom tables>). The +last two, which default to 0, are the number of columns to remove on +the left- and right-hand side of the generated table; this is used to +have tables without vertical borders. + +If you pass it a style name, it must be one of the following: + +=over 4 + +=item C<default> + +this is the default C<Text::ASCIITable> style: + + .--------------------------. + | one | two | three | four | + +-----+-----+-------+------+ + | one | one | one | one | + | two | two | two | two | + '-----+-----+-------+------' + +=item C<rest-simple> + +this is the "simple table" style as used in reStructuredText: + + ===== ===== ======= ====== + one two three four + ===== ===== ======= ====== + one one one one + two two two two + ===== ===== ======= ====== + +If you give C<show('rowline')> you get: + + ===== ===== ======= ====== + one two three four + ===== ===== ======= ====== + one one one one + ----- ----- ------- ------ + two two two two + ===== ===== ======= ====== + +Note that there is no blank space on either side. + +=item C<rest-grid> + +this is the "grid table" style as used in reStructuredText: + + +-----+-----+-------+------+ + | one | two | three | four | + +=====+=====+=======+======+ + | one | one | one | one | + +-----+-----+-------+------+ + | two | two | two | two | + +-----+-----+-------+------+ + +=back + +=cut + +sub style { + my ($self,$style)=@_; + if (ref $style eq 'ARRAY') { + if (@$style==6) { + $self->{style}=[@$style,0,0] + } elsif (@$style==5) { + $self->{style}=[@$style,[],0,0] + } elsif (@$style==8) { + $self->{style}=[@$style] + } else { + _die('Wrong style specification') + } + } elsif (exists $styles{lc $style}) { + $self->{style}=$styles{lc $style}->{lines}; + $self->handleParms(%{$styles{lc $style}->{globals}}); + } else { + _die("No such style $style"); + } +} + +sub AUTOLOAD { + return if $AUTOLOAD=~/:?DESTROY$/; + if (exists $paramSubs{lc($AUTOLOAD)}) { + goto &{$paramSubs{lc($AUTOLOAD)}}; + } else { + _die("no such method $AUTOLOAD") + } +} + +sub _globals { + my ($self)=@_; + my @ret=(); + push @ret,'hide_HeadRow',1 if exists $self->{hide}{headrow}; + push @ret,'hide_HeadLine',1 if exists $self->{hide}{headline}; + push @ret,'hide_FirstLine',1 if exists $self->{hide}{firstline}; + push @ret,'hide_LastLine',1 if exists $self->{hide}{lastline}; + push @ret,'allowANSI',1 if exists $self->{allow}{ansi}; + push @ret,'allowHTML',1 if exists $self->{allow}{html}; + push @ret,'reportErrors',$self->{errors} if $self->{errors}; + push @ret,'alignHeadRow',$self->{headrow} if $self->{headrow}; + push @ret,'drawRowLine',1 unless exists $self->{hide}{rowline}; + return @ret; +} + +sub _colprops { + my ($self)=@_; + return @{$self->{cols}}; +} +sub _colnames { + my ($self)=@_; + return map {$_->{name}} @{$self->{cols}}; +} +sub _rows { + my ($self)=@_; + return ($self->{rows}?@{$self->{rows}}:()); +} + +sub _style { + my ($self)=@_; + return ($self->{style}?@{$self->{style}}[0..5]:()); +} +sub _squeeze { + my ($self)=@_; + return ($self->{style}?@{$self->{style}}[6,7]:(0,0)); +} + +sub _die { + die (Template::Exception->new('ASCIITable',$_[0])) +} + +=head1 TODO + +Better tests? + +=head1 BUGS + +None known so far. If you find any, please report them using +rt.cpan.org or e-mail. It would be great if you could provide a simple +test case that exercises the bug. + +=head1 COPYRIGHT AND LICENSE + +Copyright (C) 2005 dakkar <dakkar@thenautilus.net> + +This program is free software; you can redistribute it and/or modify it +under the same terms as Perl itself. + +1; |