]>
iEval git - html-element-library.git/blob - t/misc.t
3 use t
::lib tests
=> 27;
5 ##################################################
6 # Short tests based on mklol
9 HTML
::Element
->new_from_lol(
12 [ 'title', 'I like stuff!' ]],
13 ['body', {id
=> 'corpus'}, {'lang', 'en-JP'},
15 ['p', 'um, p < 4!', {'class' => 'par123'}],
16 ['div', {foo
=> 'bar'}, '123'],
17 ['div', {jack
=> 'olantern'}, '456']]]);
20 my $tree_replaced = \'<html
><head
><title
>I like stuff
!</title></head
><body id
="corpus" lang
="en-JP">all gone
!</body></html
>';
24 $tree->content_handler(corpus => 'all gone
!');
25 isxml $tree, $tree_replaced, 'content_handler
';
28 $tree->set_child_content(id => 'corpus
', 'all gone
!');
29 isxml $tree, $tree_replaced, 'set_child_content
';
32 $tree->look_down('_tag
' => 'body
')->replace_content('all gone
!');
33 isxml $tree, $tree_replaced, 'replace_content
';
36 my $p = $tree->look_down('_tag
' => 'body
')->look_down(_tag => 'p
');
37 is $p->sibdex, 1, 'p tag has
1 as its
index';
40 my $div = $tree->look_down('_tag
' => 'body
')->look_down(_tag => 'p
');
41 my @sibs = $div->siblings;
42 is $sibs[0], 'stuff
', "first sibling is simple text";
43 is $sibs[2]->tag, 'div
', "3rd tag is a div tag";
44 is scalar @sibs, 4, "4 siblings total";
47 my $bold = HTML::Element->new('b
', id => 'wrapper
');
48 my $w = $tree->look_down(_tag => 'p
');
49 $w->wrap_content($bold);
50 isxml $w, \'<p class="par123"><b id="wrapper">um, p < 4!</b></p>', 'wrap_content';
52 ##################################################
55 $tree = mktree
't/html/crunch.html';
56 $tree->crunch(look_down
=> [ class => 'imageElement' ], leave
=> 1);
57 isxml
$tree, 't/html/crunch-exp.html', 'crunch';
59 $tree = mktree
't/html/defmap.html';
60 $tree->defmap(smap
=> {pause
=> 'arsenal rules'}, $ENV{TEST_VERBOSE
});
61 isxml
$tree, 't/html/defmap-exp.html', 'defmap';
63 $tree = mktree
't/html/fillinform.html';
64 isxml \
($tree->fillinform({state => 'catatonic'})), 't/html/fillinform-exp.html', 'fillinform';
66 $tree = mktree
't/html/hashmap.html';
68 hash
=> {people_id
=> 888, phone
=> '444-4444', email
=> 'm@xml.com'},
70 excluding
=> ['email']
72 isxml
$tree, 't/html/hashmap-exp.html', 'hash_map';
74 $tree = mktree
't/html/iter.html';
75 my $li = $tree->look_down(class => 'store_items');
76 $tree->iter($li, qw
/bread butter vodka/);
77 isxml
$tree, 't/html/iter-exp.html', 'iter';
79 my @list = map { [item
=> $_] } qw
/bread butter beans/;
80 my $initial_lol = [ note
=> [ list
=> [ item
=> 'sample' ] ] ];
81 my ($new_lol) = HTML
::Element
::newchild
($initial_lol, list
=> @list);
82 my $expected = [note
=> [list
=> [item
=> 'bread'], [item
=> 'butter'], [item
=> 'beans']]];
83 is_deeply
$new_lol, $expected, 'newchild unrolling';
85 $tree = mktree
't/html/highlander2.html';
86 $tree->passover('under18');
87 isxml
$tree, 't/html/highlander2-passover-exp.html', 'passover';
89 $tree = mktree
't/html/position.html';
90 my $found = $tree->look_down(id
=> 'findme');
91 my $pos = join ' ', $found->position;
92 is
$pos, '-1 1 0 1 2', 'position';
94 $tree = mktree
't/html/prune.html';
96 isxml
$tree, 't/html/prune-exp.html', 'prune';
98 ##################################################
101 $tree = mktree
't/html/dual_iter.html';
105 ['the pros' => 'never have to worry about service again'],
106 ['the cons' => 'upfront extra charge on purchase'],
107 ['our choice' => 'go with the extended service plan']
109 wrapper_proc
=> sub {
110 my ($container) = @_;
111 # only keep the last 2 dts and dds
112 my @content_list = $container->content_list;
113 $container->splice_content(0, @content_list - 2);
116 my ($container, @item_elems) = @_;
117 $container->unshift_content(@item_elems);
119 debug
=> $ENV{TEST_VERBOSE
},
122 isxml
$tree, 't/html/dual_iter-exp.html', 'dual_iter';
127 my ($data, $tr) = @_;
128 $tr->look_down(class => 'first')->replace_content($data->{first
});
129 $tr->look_down(class => 'last')->replace_content($data->{last});
130 $tr->look_down(class => 'option')->replace_content($data->{option
});
134 {first
=> 'Foo', last => 'Bar', option
=> 2},
135 {first
=> 'Bar', last => 'Bar', option
=> 3},
136 {first
=> 'Baz', last => 'Bar', option
=> 4},
139 $tree = mktree
't/html/itercb.html';
140 $tree->find('table')->find('tbody')->find('tr')->itercb(\
@cbdata, \
&cb
);
141 isxml
$tree, 't/html/itercb-exp.html', 'itercb';
145 for my $age (qw
/5 15 50/) {
146 $tree = mktree
't/html/highlander.html';
149 under10
=> sub { $_[0] < 10 },
150 under18
=> sub { $_[0] < 18 },
155 isxml
$tree, "t/html/highlander-$age-exp.html", "highlander for $age";
161 my ($branch, $age) = @_;
162 $branch->look_down(id
=> 'age')->replace_content($age);
165 for my $age (qw
/5 15 27/) {
166 $tree = mktree
't/html/highlander2.html';
167 my $if_then = $tree->look_down(id
=> 'age_dialog')->highlander2(
169 under10
=> [ sub { $_[0] < 10 }, \
&replace_age
],
170 under18
=> [ sub { $_[0] < 18 }, \
&replace_age
],
171 welcome
=> [ sub { 1 }, \
&replace_age
]
176 isxml
($tree, "t/html/highlander2-$age-exp.html", "highlander2 for age $age");
181 $tree = mktree
't/html/iter2.html';
184 # default wrapper_ld ok
186 [ Programmer
=> 'one who likes Perl and Seamstress' ],
187 [ DBA
=> 'one who does business as' ],
188 [ Admin
=> 'one who plays Tetris all day' ]
190 wrapper_proc
=> sub {
191 my ($container) = @_;
193 # only keep the last 2 dts and dds
194 my @content_list = $container->content_list;
195 $container->splice_content(0, @content_list - 2);
197 # default item_ld is k00l
198 # default item_data is phrEsh
199 # default item_proc will do w0rk
201 my ($container, @item_elems) = @_;
202 $container->unshift_content(@item_elems);
205 debug
=> $ENV{TEST_VERBOSE
},
208 isxml
$tree, 't/html/iter2-exp.html', 'iter2';
213 { clan_name
=> 'janglers', clan_id
=> 12, selected
=> 1 },
214 { clan_name
=> 'thugknights', clan_id
=> 14 },
215 { clan_name
=> 'cavaliers' , clan_id
=> 13 }
217 $tree = mktree
't/html/unroll_select.html';
219 $tree->unroll_select(
220 select_label
=> 'clan_list',
221 option_value
=> sub { my $row = shift; $row->{clan_id
} },
222 option_content
=> sub { my $row = shift; $row->{clan_name
} },
223 option_selected
=> sub { my $row = shift; $row->{selected
} },
225 data_iter
=> sub { my $data = shift; shift @
$data });
227 isxml
$tree, 't/html/unroll_select-exp.html', 'unroll_select';
This page took 0.067008 seconds and 4 git commands to generate.