t/tables.t

   1 #!/usr/bin/perl -T
   2 use lib '.';
   3 use t::lib tests => 9;
   4
   5 my $tree;
   6 sub data () {
   7         [map { +{name => $_->[0], age => $_->[1], weight => $_->[2]} } (
   8                 [qw/bob 99 99/],
   9                 [qw/bill 12 52/],
  10                 [qw/brian 44 80/],
  11                 [qw/babette 52 124/],
  12                 [qw/bobo 12 120/],
  13                 [qw/bix 43 230/],
  14         )];
  15 }
  16
  17 sub data2 () {
  18         {
  19                 '3dig' => [
  20                         ['437', 'MS-DOS', 'United States',       '0', '1', '1', '1', '1'],
  21                         ['708', 'Arabic (ASMO 708)',             '0', '1', '0', '0', '1'],
  22                         ['709', 'Arabic (ASMO 449+ BCON V4)',    '0', '1', '0', '0', '1'],
  23                         ['710', 'Arabic (Transparent Arabic)',   '0', '1', '0', '0', '1'],
  24                         ['720', 'Arabic (Transparent ASMO)',     '0', '1', '0', '0', '1']],
  25                 '4dig' => [
  26                         ['1200', 'Unicode (BMP of ISO 10646)',   '0', '0', '1', '1', '2'],
  27                         ['1250', 'Windows 3.1 Eastern European', '1', '0', '1', '1', '1'],
  28                         ['1251', 'Windows 3.1 Cyrillic',         '1', '0', '1', '1', '1'],
  29                         ['1252', 'Windows 3.1 US (ANSI)',        '1', '0', '1', '1', '1'],
  30                         ['1253', 'Windows 3.1 Greek',            '1', '0', '1', '1', '1'],
  31                         ['1254', 'Windows 3.1 Turkish',          '1', '0', '1', '1', '1'],
  32                         ['1255', 'Hebrew',                       '1', '0', '0', '0', '1'],
  33                         ['1256', 'Arabic',                       '1', '0', '0', '0', '1'],
  34                         ['1257', 'Baltic',                       '1', '0', '0', '0', '1'],
  35                         ['1361', 'Korean (Johab)',               '1', '0', '0', '3', '1']]
  36         };
  37 }
  38
  39 $tree = mktree 't/html/table.html';
  40
  41 $tree->table(
  42         gi_table    => 'load_data',
  43         gi_tr       => 'data_row',
  44         table_data  => data,
  45         tr_data     => sub {
  46                 my ($self, $data) = @_;
  47                 shift(@{$data}) ;
  48         },
  49         td_data     => sub {
  50                 my ($tr_node, $tr_data) = @_;
  51                 $tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
  52         });
  53
  54 isxml $tree, 't/html/table-exp.html', 'table';
  55
  56 ###
  57
  58 $tree = mktree 't/html/table-alt.html';
  59
  60 $tree->table(
  61         gi_table    => 'load_data',
  62         gi_tr       => ['iterate1', 'iterate2'],
  63         table_data  => data,
  64         tr_data     => sub {
  65                 my ($self, $data) = @_;
  66                 shift @{$data};
  67         },
  68         td_data     => sub {
  69                 my ($tr_node, $tr_data) = @_;
  70                 $tr_node->content_handler($_ => $tr_data->{$_}) for qw(name age weight)
  71         });
  72
  73 isxml $tree, 't/html/table-alt-exp.html', 'table (alternating)';
  74
  75 ###
  76
  77 my $d = data2;
  78 $tree = mktree 't/html/table2.html';
  79
  80 for my $dataset (keys %$d) {
  81         my %tbody = ('4dig' => 0, '3dig' => 1);
  82         $tree->table2 (
  83                 debug => $ENV{TEST_VERBOSE},
  84                 table_data => $d->{$dataset},
  85                 tr_base_id => $dataset,
  86                 tr_ld => sub {
  87                         my $t = shift;
  88                         my $tbody = ($t->look_down('_tag' => 'tbody'))[$tbody{$dataset}];
  89                         my @tbody_child = $tbody->content_list;
  90                         $tbody_child[$_]->detach for (1 .. $#tbody_child) ;
  91                         $tbody->content_list;
  92                 },
  93                 td_proc => sub {
  94                         my ($tr, $data) = @_;
  95                         my @td = $tr->look_down('_tag' => 'td');
  96                         for my $i (0..$#td) {
  97                                 #       warn $i;
  98                                 $td[$i]->splice_content(0, 1, $data->[$i]);
  99                         }
 100                 }
 101         );
 102 }
 103
 104 isxml $tree, 't/html/table2-exp.html', 'table2';
 105
 106 ###
 107
 108 # a - default table_ld
 109 $tree = mktree 't/html/table2.html';
 110 my $table = HTML::Element::Library::ref_or_ld(
 111         $tree,
 112         ['_tag' => 'table']
 113 );
 114 isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down default';
 115
 116 ###
 117
 118 # b - arrayref table_ld
 119 $table = HTML::Element::Library::ref_or_ld(
 120         $tree,
 121         [frame => 'hsides', rules => 'groups']
 122 );
 123 isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down arrayref';
 124
 125 # c - coderef table_ld
 126 $table = HTML::Element::Library::ref_or_ld(
 127         $tree,
 128         sub {
 129                 my ($t) = @_;
 130                 my $caption = $t->look_down('_tag' => 'caption');
 131                 $caption->parent;
 132         }
 133 );
 134 isxml $table, 't/html/table2-table_ld-exp.html', 'table2 look_down coderef';
 135
 136 ###
 137
 138 # a - default table_ld
 139 my @tr = HTML::Element::Library::ref_or_ld(
 140         $tree,
 141         ['_tag' => 'tr']
 142 );
 143 is (scalar @tr, 16, 'table2 tr look_down (default)');
 144
 145 # b - coderef tr_ld
 146 # removes windows listings before returning @tr
 147
 148 HTML::Element::Library::ref_or_ld(
 149         $tree,
 150         sub {
 151                 my ($t) = @_;
 152                 my @trs = $t->look_down('_tag' => 'tr');
 153                 my @keep;
 154                 for my $tr (@trs) {
 155
 156                         my @td = $tr->look_down ('_tag' => 'td') ;
 157                         my $detached;
 158                         for my $td (@td) {
 159                                 if (grep { $_ =~ /Windows/ } $td->content_list) {
 160                                         $tr->detach;
 161                                         ++$detached;
 162                                         last;
 163                                 }
 164                         }
 165                         push @keep, $tr unless $detached;
 166                 }
 167                 @keep;
 168         }
 169 );
 170 isxml $tree, 't/html/table2-tr_ld-coderef-exp.html', 'table2 tr look_down (coderef)';
 171
 172 # c - arrayref tr_ld
 173
 174 $tree = mktree 't/html/table2-tr_ld-arrayref.html';
 175 my $tr = HTML::Element::Library::ref_or_ld(
 176         $tree,
 177         [class => 'findMe']
 178 );
 179 isxml $tr, 't/html/table2-tr_ld-arrayref-exp.html', 'table2 tr look_down (arrayref)';