Rename .exp to -exp.html in t/html

[html-element-library.git] / t / tables.t

#!/usr/bin/perl -T
use lib '.';
use t::lib tests => 9;

my $tree;
sub data () {
	[map { +{name => $_->[0], age => $_->[1], weight => $_->[2]} } (
		[qw/bob 99 99/],
		[qw/bill 12 52/],
		[qw/brian 44 80/],
		[qw/babette 52 124/],
		[qw/bobo 12 120/],
		[qw/bix 43 230/],
	)];
}

sub data2 () {
	{
		'3dig' => [
			['437', 'MS-DOS', 'United States',       '0', '1', '1', '1', '1'],
			['708', 'Arabic (ASMO 708)',             '0', '1', '0', '0', '1'],
			['709', 'Arabic (ASMO 449+ BCON V4)',    '0', '1', '0', '0', '1'],
			['710', 'Arabic (Transparent Arabic)',   '0', '1', '0', '0', '1'],
			['720', 'Arabic (Transparent ASMO)',     '0', '1', '0', '0', '1']],
		'4dig' => [
			['1200', 'Unicode (BMP of ISO 10646)',   '0', '0', '1', '1', '2'],
			['1250', 'Windows 3.1 Eastern European', '1', '0', '1', '1', '1'],
			['1251', 'Windows 3.1 Cyrillic',         '1', '0', '1', '1', '1'],
			['1252', 'Windows 3.1 US (ANSI)',        '1', '0', '1', '1', '1'],
			['1253', 'Windows 3.1 Greek',            '1', '0', '1', '1', '1'],
			['1254', 'Windows 3.1 Turkish',          '1', '0', '1', '1', '1'],
			['1255', 'Hebrew',                       '1', '0', '0', '0', '1'],
			['1256', 'Arabic',                       '1', '0', '0', '0', '1'],
			['1257', 'Baltic',                       '1', '0', '0', '0', '1'],
			['1361', 'Korean (Johab)',               '1', '0', '0', '3', '1']]
	};
}

$tree = mktree 't/html/table.html';

$tree->table(
	gi_table    => 'load_data',
	gi_tr       => 'data_row',
	table_data  => data,
	tr_data     => sub {
		my ($self, $data) = @_;
		shift(@{$data}) ;
	},
	td_data     => sub {
		my ($tr_node, $tr_data) = @_;
		$tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
	});

isxml $tree, 't/html/table-exp.html', 'table';

###

$tree = mktree 't/html/table-alt.html';

$tree->table(
	gi_table    => 'load_data',
	gi_tr       => ['iterate1', 'iterate2'],
	table_data  => data,
	tr_data     => sub {
		my ($self, $data) = @_;
		shift @{$data};
	},
	td_data     => sub {
		my ($tr_node, $tr_data) = @_;
		$tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
	});

isxml $tree, 't/html/table-alt-exp.html', 'table (alternating)';

###

my $d = data2;
$tree = mktree 't/html/table2.html';

for my $dataset (keys %$d) {
	my %tbody = ('4dig' => 0, '3dig' => 1);
	$tree->table2 (
		debug => $ENV{TEST_VERBOSE},
		table_data => $d->{$dataset},
		tr_base_id => $dataset,
		tr_ld => sub {
			my $t = shift;
			my $tbody = ($t->look_down('_tag' => 'tbody'))[$tbody{$dataset}];
			my @tbody_child = $tbody->content_list;
			$tbody_child[$_]->detach for (1 .. $#tbody_child) ;
			$tbody->content_list;
		},
		td_proc => sub {
			my ($tr, $data) = @_;
			my @td = $tr->look_down('_tag' => 'td');
			for my $i (0..$#td) {
				#	warn $i;
				$td[$i]->splice_content(0, 1, $data->[$i]);
			}
		}
	);
}

isxml $tree, 't/html/table2-exp.html', 'table2';

###

# a - default table_ld
$tree = mktree 't/html/table2.html';
my $table = HTML::Element::Library::ref_or_ld(
	$tree,
	['_tag' => 'table']
);
isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down default';

###

# b - arrayref table_ld
$table = HTML::Element::Library::ref_or_ld(
	$tree,
	[frame => 'hsides', rules => 'groups']
);
isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down arrayref';

# c - coderef table_ld
$table = HTML::Element::Library::ref_or_ld(
	$tree,
	sub {
		my ($t) = @_;
		my $caption = $t->look_down('_tag' => 'caption');
		$caption->parent;
	}
);
isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down coderef';

###

# a - default table_ld
my @tr = HTML::Element::Library::ref_or_ld(
	$tree,
	['_tag' => 'tr']
);
is (scalar @tr, 16, 'table2 tr look_down (default)');

# b - coderef tr_ld
# removes windows listings before returning @tr

HTML::Element::Library::ref_or_ld(
	$tree,
	sub {
		my ($t) = @_;
		my @trs = $t->look_down('_tag' => 'tr');
		my @keep;
		for my $tr (@trs) {

			my @td = $tr->look_down ('_tag' => 'td') ;
			my $detached;
			for my $td (@td) {
				if (grep { $_ =~ /Windows/ } $td->content_list) {
					$tr->detach;
					++$detached;
					last;
				}
			}
			push @keep, $tr unless $detached;
		}
		@keep;
	}
);
isxml $tree, 't/html/table2-tr_ld-coderef-exp.html', 'table2 tr look_down (coderef)';

# c - arrayref tr_ld

$tree = mktree 't/html/table2-tr_ld-arrayref.html';
my $tr = HTML::Element::Library::ref_or_ld(
	$tree,
	[class => 'findMe']
);
isxml $tr, 't/html/table2-tr_ld-arrayref-exp.html', 'table2 tr look_down (arrayref)';