Turns
header1 | header2 |
tr 1, td 1 |
tr 1, td 2 |
tr 3, td 1 00 | 0 | Yes, a Lone Table Cell |
|
tr2 td2 |
into
.=------------------------------------------=.
| header1 | header2 |
|-==========================================-|
| tr 1, td 1 | tr 1, td 2 |
|=-----------------------------*------------=|
| tr 3, td 1 | tr2 td2 |
| .=------------------------=. | |
| | 00 | | |
| | | | |
| | Yes, a Lone Table Cell | | |
| '=------------------------=' | |
'=------------------------------------------='
.=------------------------=.
| 00 |
| |
| Yes, a Lone Table Cell |
'=------------------------='
caveats: doesn't handle multiple rows with TH tags (just uses the last TH tags seen).
Text::ASCIITable doesn't like incomplete rows (row has set 4 columns, but 2 were added, so the row doesn't get added)
which I consider a bug (filed as such).
FIXED in Text-ASCIITable-0.14
Doesn't handle colspan/rowspan.
#!/usr/bin/perl
use strict;
use HTML::TreeBuilder;
use Text::ASCIITable;
use List::Util qw(max);
my $html = q~
<table border=1>
<tr><th>header1</th><th>header2</th></tr>
<tr>
<Td> tr 1, td 1 </td>
<td> tr 1, td 2</td>
</tr>
<tr>
<td> tr 3, td 1 <table border=0><tr><td>00</td></tr><tr><td>0</td></tr
+><tr><td> Yes, a Lone Table Cell</td></tr></table>
</td>
<td> tr2 td2 </td>
</tr>
</table>~;
my $t = HTML::TreeBuilder->new();
$t->parse($html);
$t->eof;
print DumpTable( $_ ), $/, $/
for $t->find_by_tag_name('table') ;
sub DumpTable {
my $ht = shift;
die "$ht is not a table" unless $ht->tag eq 'table';
my $tt = Text::ASCIITable::->new;
my @co;
my @da;
my $da = [];
for my $ro ( @{ $ht->content() } ) {
if( $ro->tag eq 'tr' ) {
push @da, $da if @$da;
$da = [];
for my $ce ( @{ $ro->content() } ) {
if( $ce->tag eq 'td' ) {
if( $ce->look_down( '_tag', 'table' ) ) {
my $string = '';
for my $i ( @{ $ce->content() } ) {
if( not ref $i ) {
$string .= $i;
}
elsif( $i->tag eq 'table' ) {
$string .= "\n";
$string .= DumpTable($i);
$string .= "\n";
}
else {
$string .= $i->as_text;
}
}
push @$da, $string;
}
else {
push @$da, $ce->as_text;
}
}
elsif( $ce->tag eq 'th' ) {
push @co, $ce->as_text;
}
}
}
}
push @da, $da if @$da;
if(@co) {
$tt->setCols(@co);
}
else {
use List::Util qw(max);
my $max = 1 + max( 0, map { $#$_ } @da );
$tt->setCols( (' ') x $max );
$tt->setOptions( hide_HeadRow => 1 );
$tt->setOptions( hide_HeadLine => 1 );
}
$tt->addRow($_) for @da;
$tt->setOptions( 'drawRowLine', 1) if $ht->attr('border');
# return $tt->draw();
return $tt->draw(
[ '.=', '=.', '-', '-' ], # .=-----------=.
[ '|', '|', '|' ], # | info | info |
[ '|-', '-|', '=', '=' ], # |-===========-|
[ '|', '|', '|' ], # | info | info |
[ "'=", "='", '-', '-' ], # '=-----------='
[ '|=', '=|', '-', '*' ] # rowseperator
);
}
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.