#!/usr/bin/perl
use strict;
use warnings;
use Test::More tests => 52;
use HTML::TableExtract;
my $te = HTML::TableExtract->new(
);
my $html = do{ local $/ = undef; <DATA> };
ok($te->parse($html), "parse_file");
my @t = $te->tables;
is(@t, 2, "extract count");
{
my $ts = $t[1];
ok($ts, "===outer table===");
is(join(',',$ts->coords),'0,0','coords');
my @rows = $ts->rows;
my $R = scalar @rows;
is($R,5,'rows');
my $C = scalar @{$rows[0]};
is($C,3,'cols');
foreach my $r ( 0 .. 3 ){
is( $ts->cell_attr($r)->{foo}, "row$r", "($r) attribs" );
foreach my $c ( 0 .. 2 ){
is( $ts->cell($r,$c), "cell$r-$c", "($r,$c) contents" );
is( $ts->cell_attr($r,$c)->{foo}, "cell$r,$c", "($r,$c) attribs" );
}
}
}
{
my $ts = $t[0];
ok($ts, "===inner table===");
is(join(',',$ts->coords),'1,0','coords');
my @rows = $ts->rows;
my $R = scalar @rows;
is($R,2,'rows');
my $C = scalar @{$rows[0]};
is($C,3,'cols');
foreach my $r ( 0 .. 1 ){
is( $ts->cell_attr($r)->{foo}, "t2row$r", "t2($r) attribs" );
foreach my $c ( 0 .. 2 ){
is( $ts->cell($r,$c), "t2cell$r-$c", "t2($r,$c) contents" );
is( $ts->cell_attr($r,$c)->{foo}, "t2cell$r,$c", "t2($r,$c) attribs" );
}
}
}
__DATA__
<html>
<head><title>TableExtract Test HTML</title></head>
<body>
<table>
<tr foo="row0">
<th foo="cell0,0">cell0-0</th>
<th foo="cell0,1">cell0-1</th>
<th foo="cell0,2">cell0-2</th>
</tr>
<tr foo="row1">
<td foo="cell1,0">cell1-0</td>
<td foo="cell1,1">cell1-1</td>
<td foo="cell1,2">cell1-2</td>
</tr>
<tr foo="row2">
<td foo="cell2,0">cell2-0</td>
<td foo="cell2,1">cell2-1</td>
<td foo="cell2,2">cell2-2</td>
</tr>
<tr foo="row3">
<td foo="cell3,0">cell3-0</td>
<td foo="cell3,1">cell3-1</td>
<td foo="cell3,2">cell3-2</td>
</tr>
<tr foo="row4">
<td foo="cell4,0" colspan=3>
<table>
<tr foo="t2row0">
<th foo="t2cell0,0">t2cell0-0</th>
<th foo="t2cell0,1">t2cell0-1</th>
<th foo="t2cell0,2">t2cell0-2</th>
</tr>
<tr foo="t2row1">
<td foo="t2cell1,0">t2cell1-0</td>
<td foo="t2cell1,1">t2cell1-1</td>
<td foo="t2cell1,2">t2cell1-2</td>
</tr>
</table>
</td>
</tr>
</table>
</body>
</html>
