Bug #61610 for Text-Table: [PATCH] Add callback-based variable rules

As we discussed on IRC here is a patch to vary the rules based on the position and other factors. What I decided to do give an option to pass two callbacks. I've also set up a github repository for Text-Table here which you can pull from if it would be more convenient for you, but I'm happy giving patches: http://github.com/shlomif/Text-Table Regards, -- Shlomi Fish

diff --git a/Text-Table/Changes b/Text-Table/Changes index c659e14..17caa1c 100644 --- a/Text-Table/Changes +++ b/Text-Table/Changes @@ -49,3 +49,6 @@ Revision history for Perl extension Text::Table. 1.116 Sa 28 Aug 2010 22:00:56 CEST - added color support + +- add the callback ("sub { ... }")-based ->rule() method to render each +section in a rule differently. diff --git a/Text-Table/MANIFEST b/Text-Table/MANIFEST index 3e96908..8330a7d 100644 --- a/Text-Table/MANIFEST +++ b/Text-Table/MANIFEST @@ -7,4 +7,4 @@ README lib/Text/Table.pm t/01_ini.t t/10_Table.t -META.yml Module meta-data (added by MakeMaker) +t/11_Variable_Rule.t diff --git a/Text-Table/lib/Text/Table.pm b/Text-Table/lib/Text/Table.pm index b723a1c..0763a3a 100644 --- a/Text-Table/lib/Text/Table.pm +++ b/Text-Table/lib/Text/Table.pm @@ -398,15 +398,53 @@ sub _rule { my $in_body = shift; return '' unless $tb->width; # this builds the cache, hence $tb->{ blank} my $rule = $tb->_assemble_line( $in_body, $tb->{ blank}); - my ( $char, $alt) = map /(.)/, @_; - ( defined $char and length $char) or $char = ' '; - # replace blanks with $char. If $alt is given, replace nonblanks with $alt - if ( defined $alt ) { - $rule =~ s/(.)/$1 eq ' ' ? $char : $alt/ge; - } else { - $rule =~ s/ /$char/g if $char ne ' '; + + if (ref($_[0]) eq "CODE") + { + my ($char_cb, $alt_cb) = @_; + + my %callbacks = + ( + 'char' => { cb => $char_cb, idx => 0 }, + 'alt' => { cb => $alt_cb, idx => 0 }, + ); + + my $calc_substitution = sub { + my $s = shift; + + my $len = length($s); + + my $which = substr($s, 0, 1) eq ' ' ? 'char' : 'alt'; + my $rec = $callbacks{$which}; + + my $replacement = $rec->{cb}->( + $rec->{idx}++, + $len, + ); + + $replacement = substr($replacement, 0, $len); + $replacement .= ' ' x ($len - length($replacement)); + + return $replacement; + }; + + $rule =~ s/((.)\2*)/$calc_substitution->($1)/ge; + + return $rule; + } + else + { + my ( $char, $alt) = map /(.)/, @_; + ( defined $char and length $char) or $char = ' '; + # replace blanks with $char. If $alt is given, replace nonblanks + # with $alt + if ( defined $alt ) { + $rule =~ s/(.)/$1 eq ' ' ? $char : $alt/ge; + } else { + $rule =~ s/ /$char/g if $char ne ' '; + } + return $rule; } - $rule; } sub rule { @@ -941,6 +979,9 @@ line. Parameters and response to context are as with C<table()>. $tb->rule; $tb->rule( $char); $tb->rule( $char, $char1); + $tb->rule( sub { my ($index, $len) = @_; }, + sub { my ($index, $len) = @_; }, + ); Returns a rule for the table. @@ -960,6 +1001,12 @@ popular representation of line crossings. C<rule()> uses the column separators for the title section if there is a difference. +If callbacks are specified instead of the characters, then they receive the +index of the section of the rule they need to render and its desired length in +characters, and should return the string to put there. The indexes given +are 0 based (where 0 is either the left column separator or the leftmost +cell) and the strings will be trimmed or extended in the replacement. + =item body_rule() C<body_rule()> works like <rule()>, except the rule is generated using diff --git a/Text-Table/t/11_Variable_Rule.t b/Text-Table/t/11_Variable_Rule.t new file mode 100644 index 0000000..3f28dc9 --- /dev/null +++ b/Text-Table/t/11_Variable_Rule.t @@ -0,0 +1,28 @@ +use strict; +use warnings; + +use Test::More tests => 1; + +use Text::Table; + +### separators and rules +my $tb = Text::Table->new( \'||', 'aaa', \'|', 'bbb', \'|', 'ccc', \'||'); + +# TEST +is ($tb->rule( + sub { + my ($i, $len) = @_; + + return (($i == 0) ? ("X" x $len) : ($i == 2) ? ("Y" x $len) : + ("A" x $len)) + ; + }, + sub { + my ($i, $len) = @_; + return (($i == 0) ? "|=" : ($i == 3) ? "=|" : "+"); + }, + ), + "|=XXX+AAA+YYY=|\n", + "Create a variable rule based on callbacks.", +); +