1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
|
# ----------------------------------------------------------------
# this test script is written in utf8 but does not "use utf8" for 5.005-compatibility
# ----------------------------------------------------------------
use strict;
use Test::More;
# ----------------------------------------------------------------
{
plan tests => 33;
use_ok('XML::TreePP');
&test_main();
}
# ----------------------------------------------------------------
sub test_main {
my $src = {};
$src->{Plain} = <<"EOT";
<root>
<a>AA</a>
<z>zz</z>
<c>©©</c>
<e>ëë</e>
<n>んん</n>
<k>漢漢</k>
</root>
EOT
$src->{XMLref} = <<"EOT";
<root>
<a>AA</a>
<z>zz</z>
<c>©©</c>
<e>ëë</e>
<n>んん</n>
<k>漢漢</k>
</root>
EOT
$src->{Mixed} = <<"EOT";
<root>
<a>AA</a>
<z>zz</z>
<c>©©</c>
<e>ëë</e>
<n>んん</n>
<k>漢漢</k>
</root>
EOT
foreach my $key ( keys %$src ) {
phase2( "$key octets", $src->{$key} );
}
}
# ----------------------------------------------------------------
sub phase2 {
my $subject = shift;
my $srcxml = shift;
my $srcref = ( $srcxml =~ /&#\w+;/ );
foreach my $xml_deref ( 0, 1 ) {
my $subj3 = $subject .( $xml_deref ? ' xml_deref' : '' );
my $opt = {
xml_deref => $xml_deref,
};
my $tpp = XML::TreePP->new( %$opt );
my $tree = $tpp->parse( $srcxml );
if ( $xml_deref ) {
check_octets( $subj3, $tree );
} else {
if ( $srcref ) {
check_has_ref( $subj3, $tree );
} else {
check_no_ref( $subj3, $tree );
}
}
}
}
# ----------------------------------------------------------------
sub check_has_ref {
my $subject = shift;
my $tree = shift;
my $root = $tree->{root};
my $HAS_REF = qr/&#\w+;/;
# \x00-\x7F is always dereferenced.
# like( $root->{a}, $HAS_REF, "$subject has_ref: a" );
# like( $root->{z}, $HAS_REF, "$subject has_ref: z" );
like( $root->{c}, $HAS_REF, "$subject has_ref: c" );
like( $root->{e}, $HAS_REF, "$subject has_ref: e" );
like( $root->{n}, $HAS_REF, "$subject has_ref: n" );
like( $root->{k}, $HAS_REF, "$subject has_ref: k" );
}
# ----------------------------------------------------------------
sub check_no_ref {
my $subject = shift;
my $tree = shift;
my $root = $tree->{root};
my $HAS_REF = qr/&#\w+;/;
unlike( $root->{a}, $HAS_REF, "$subject no_ref: a" );
unlike( $root->{z}, $HAS_REF, "$subject no_ref: z" );
unlike( $root->{c}, $HAS_REF, "$subject no_ref: c" );
unlike( $root->{e}, $HAS_REF, "$subject no_ref: e" );
unlike( $root->{n}, $HAS_REF, "$subject no_ref: n" );
unlike( $root->{k}, $HAS_REF, "$subject no_ref: k" );
}
# ----------------------------------------------------------------
sub check_octets {
my $subject = shift;
my $tree = shift;
my $root = $tree->{root};
is( $root->{a}, 'AA', "$subject ok: a" );
is( $root->{z}, 'zz', "$subject ok: z" );
is( $root->{c}, '©©', "$subject ok: c" );
is( $root->{e}, 'ëë', "$subject ok: e" );
is( $root->{n}, 'んん', "$subject ok: n" );
is( $root->{k}, '漢漢', "$subject ok: k" );
}
# ----------------------------------------------------------------
;1;
# ----------------------------------------------------------------
|
