]> iEval git - html-element-library.git/blob - t/tables.t
Remove use v5.14; from t/perlcritic.t
[html-element-library.git] / 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)';
This page took 0.061268 seconds and 4 git commands to generate.