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
|
package main;
use strict;
use warnings;
use Test::More tests => 6;
use Data::Dumper;
$Data::Dumper::Indent = 0;
$Data::Dumper::Sortkeys = 1;
use XML::Hash::XS 'xml2hash';
$XML::Hash::XS::keep_root = 0;
our $xml_decl_utf8 = qq{<?xml version="1.0" encoding="utf-8"?>};
{
is
Dumper(xml2hash('t/test.xml', keep_root => 1)),
Dumper({
root => {
attr1 => '1',
attr2 => '2',
item => ['1', '2', '3'],
node1 => 'value1',
node2 => {
attr1 => '1',
content => 'value2',
}
}
}),
'read from file',
;
}
{
use utf8;
is
xml2hash('<root>Привет!</root>', buf_size => 2),
"Привет!",
'read from string with buf_size=2',
;
}
{
use utf8;
is
xml2hash('<?xml version="1.0" encoding="utf-8"?><root>Привет!</root>', buf_size => 2),
"Привет!",
'read from string with buf_size=2 and xml decl',
;
}
{
use utf8;
## no critic (InputOutput::ProhibitBarewordFileHandles)
open(DATA, '<:encoding(UTF-8)', 't/test_utf8.xml') or die "Can't open file 't/test_utf8.xml'";
## use critic
is
xml2hash(*DATA),
"Привет!",
'read from file handle',
;
close DATA;
}
{
tie *DATA, 'MyReader', '<?xml version="1.0" encoding="utf-8"?><root>Привет!</root>';
use utf8;
is
xml2hash(*DATA, buf_size => 2),
"Привет!",
'read from tied handle',
;
untie *DATA;
}
{
eval { xml2hash('t/test_null_terminated.xml') };
ok(!$@, 'read from the null-terminated file');
}
package MyReader;
use base 'Tie::Handle';
sub TIEHANDLE {
my ($class, $str) = @_;
bless {str => $str, pos => 0, len => length($str)}, $class;
}
sub READ {
my $bufref = \$_[1];
my ($self, undef, $len, $offset) = @_;
$offset ||= 0;
if (($self->{pos} + $len) > $self->{len}) {
$len = $self->{len} - $self->{pos};
}
if ($len > 0) {
$$bufref = substr($$bufref, 0, $offset) . substr($self->{str}, $self->{pos}, $len);
$self->{pos} += $len;
}
return $len;
}
sub WRITE {}
sub PRINT {}
|
