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
|
# This is a bug fix for:
# https://rt.cpan.org/Ticket/Display.html?id=70321
#
# When the match callback returns 1 and the open callback returns undef, then the
# read callback (inside the XS code) warnings about:
# "Use of uninitialized value in subroutine entry at".
#
# This is due to the value returned being undef and processed by SvPV.
use strict;
use warnings;
use lib './t/lib';
use Test::More;
use File::Spec;
BEGIN
{
# Part of the fix for https://rt.cpan.org/Ticket/Display.html?id=86665
delete $ENV{'XML_CATALOG_FILES'};
}
use XML::LibXML;
if (! eval { require URI::file; } )
{
plan skip_all => "URI::file is not available.";
}
elsif ( URI->VERSION() < 1.35 )
{
plan skip_all => "URI >= 1.35 is not available (".URI->VERSION.").";
}
else
{
plan tests => 1;
}
sub _escape_html
{
my $string = shift;
$string =~ s{&}{&}gso;
$string =~ s{<}{<}gso;
$string =~ s{>}{>}gso;
$string =~ s{"}{"}gso;
return $string;
}
my $uri = URI::file->new(
File::Spec->rel2abs(
File::Spec->catfile(
File::Spec->curdir(), "t", "data", "callbacks_returning_undef.xml"
)
)
);
my $esc_path = _escape_html("$uri");
my $string = <<"EOF";
<?xml version="1.0" encoding="us-ascii"?>
<!DOCTYPE foo [
<!ENTITY foo SYSTEM "${esc_path}">
]>
<methodCall>
<methodName>metaWeblog.newPost</methodName>
<params>
<param>
<value><string>Entity test: &foo;</string></value>
</param>
</params>
</methodCall>
EOF
my $icb = XML::LibXML::InputCallback->new();
my $match_ret = 1;
$icb->register_callbacks( [
sub {
my $uri = shift;
# skip for XML catalogs in /etc/xml/
return 0 if $uri =~ m{^file:///etc/xml/};
my $to_ret = $match_ret; $match_ret = 0; return $to_ret;
},
sub { return undef; },
undef,
undef
]
);
my $parser = XML::LibXML->new();
$parser->input_callbacks($icb);
my $num_warnings = 0;
{
local $^W = 1;
local $SIG{__WARN__} = sub {
$num_warnings++;
};
my $doc = $parser->parse_string($string);
}
# TEST
is ($num_warnings, 0, "No warnings were recorded.");
|
