]>
Commit | Line | Data |
---|---|---|
67e78ff2 | 1 | # This might look like shell script, but it's actually -*- perl -*- |
2 | use strict; | |
67e78ff2 | 3 | |
4 | use File::Slurp; | |
5 | use Test::More qw(no_plan); | |
6 | ||
67e78ff2 | 7 | use HTML::TreeBuilder; |
8 | use HTML::Element::Library; | |
d4b9a41a | 9 | use Test::XML; |
67e78ff2 | 10 | |
11 | sub replace_age { | |
12 | my $branch = shift; | |
13 | my $age = shift; | |
14 | $branch->look_down(id => 'age')->replace_content($age); | |
15 | } | |
16 | ||
17 | ||
18 | sub tage { | |
19 | my $age = shift; | |
20 | my $tree = HTML::TreeBuilder->new_from_file('t/html/highlander2.html'); | |
21 | my $if_then = $tree->look_down(id => 'age_dialog'); | |
22 | ||
23 | $if_then->highlander2( | |
24 | cond => [ | |
25 | under10 => [ | |
26 | sub { $_[0] < 10} , | |
27 | \&replace_age | |
28 | ], | |
29 | under18 => [ | |
30 | sub { $_[0] < 18} , | |
31 | \&replace_age | |
32 | ], | |
33 | welcome => [ | |
34 | sub { 1 }, | |
35 | \&replace_age | |
36 | ] | |
37 | ], | |
38 | cond_arg => [ $age ] | |
39 | ); | |
40 | ||
41 | my $root = "t/html/highlander2-$age"; | |
42 | ||
d4b9a41a MG |
43 | local $_; # XML::Parser does not like read-only $_ (RT #101129) |
44 | is_xml ($tree->as_XML, scalar File::Slurp::read_file("$root.exp"), "HTML for $age"); | |
67e78ff2 | 45 | } |
46 | ||
47 | ||
48 | tage($_) for qw(5 15 27); |