1#!/use/bin/perl -w
2
3use strict;
4use Test::More;
5BEGIN {
6	my $add = 0;
7	eval {require Test::NoWarnings;Test::NoWarnings->import; ++$add; 1 }
8		or diag "Test::NoWarnings missed, skipping no warnings test";
9	plan tests => 27 + $add;
10	eval {require Data::Dumper;Data::Dumper::Dumper(1)}
11		and *dd = sub ($) { Data::Dumper->new([$_[0]])->Indent(0)->Terse(1)->Quotekeys(0)->Useqq(1)->Purity(1)->Dump }
12		or  *dd = \&explain;
13}
14
15use XML::Fast 'xml2hash';
16
17# Parsing
18
19our $xml1 = q{
20	<root at="key">
21		<!-- test -->
22		<nest>
23			<![CDATA[first]]>
24			<v>a</v>
25			mid
26			<v at="a">b</v>
27			<vv></vv>
28			last
29		</nest>
30	</root>
31};
32
33our $xml2 = q{
34	<root at="key">
35		<nest>
36			first &amp; mid &amp; last
37		</nest>
38	</root>
39};
40
41our $xml3 = q{
42	<root at="key">
43		<nest>
44			first &amp; <v>x</v> &amp; last
45		</nest>
46	</root>
47};
48
49
50our $data;
51{
52	is_deeply
53		$data = xml2hash($xml1),
54		{root => {'-at' => 'key',nest => {'#text' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
55		'default (1)'
56	or diag dd($data),"\n";
57}
58{
59	is_deeply
60		$data = xml2hash($xml1, cdata => '#cdata'),
61		{root => {'-at' => 'key',nest => {'#cdata' => 'first','#text' => 'midlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
62		'default (1)'
63	or diag dd($data),"\n";
64}
65{
66	is_deeply
67		$data = xml2hash($xml2),
68		{root => {'-at' => 'key',nest => 'first & mid & last'}},
69		'default (2)'
70	or diag dd($data),"\n";
71}
72{
73	is_deeply
74		$data = xml2hash($xml3),
75		{root => {'-at' => 'key',nest => {'#text' => 'first && last',v => 'x'}}},
76		'default (3)'
77	or diag dd($data),"\n";
78}
79{
80	is_deeply
81		$data = xml2hash($xml2, join => '+'),
82		{root => {'-at' => 'key',nest => 'first & mid & last'}},
83		'join => + (2)'
84	or diag dd($data),"\n";
85}
86{
87	is_deeply
88		$data = xml2hash($xml3, join => '+'),
89		{root => {'-at' => 'key',nest => { '#text' => 'first &+& last', v => 'x' } }},
90		'join => + (3)'
91	or diag dd($data),"\n";
92}
93{
94	is_deeply
95		$data = xml2hash($xml1, array => ['root']),
96		{root => [{'-at' => 'key',nest => {'#text' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}]},
97		'array => root (1)',
98	or diag dd($data),"\n";
99}
100{
101	is_deeply
102		$data = xml2hash($xml1, array => ['nest']),
103		{root => {'-at' => 'key',nest => [{'#text' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}]}},
104		'array => nest (1)',
105	or diag dd($data),"\n";
106}
107{
108	is_deeply
109		$data = xml2hash($xml1, array => 1),
110		{root => [{'-at' => 'key',nest => [{'#text' => 'firstmidlast',vv => [''],v => ['a',{'-at' => 'a','#text' => 'b'}]}]}]},
111		'array => 1 (1)',
112	or diag dd($data),"\n";
113}
114{
115	no utf8;
116	use bytes;
117	is_deeply
118		$data = xml2hash("<?xml encoding='UtF-8'?><text>тест&#x2622;</text>"),
119		{text => "\x{442}\x{435}\x{441}\x{442}\x{2622}"},
120		'utf8.1',
121	or diag explain($data),"\n";
122	ok utf8::is_utf8($data->{text}), "utf flag ok";
123
124	is_deeply
125		$data = xml2hash("<?xml encoding='UtF-8'?><text>тест</text>", bytes => 1),
126		{text => "тест"},
127		'utf8.2',
128	or diag explain($data),"\n";
129	ok !utf8::is_utf8($data->{text}), "utf flag not set";
130
131	is_deeply
132		$data = xml2hash("<?xml encoding='windows-1251'?><text>����</text>", bytes => 1),
133		{text => "����"},
134		'utf8.3',
135	or diag explain($data),"\n";
136	ok !utf8::is_utf8($data->{text}), "utf flag not set";
137
138	is_deeply
139		$data = xml2hash("<?xml encoding='windows-1251'?><text>����</text>"),
140		{text => "\x{442}\x{435}\x{441}\x{442}"},
141		'utf8.4',
142	or diag explain($data),"\n";
143	ok utf8::is_utf8($data->{text}), "utf flag set";
144
145	is_deeply
146		$data = xml2hash("<?xml encoding='windows-1251'?><text>����&#x30;</text>"),
147		{text => "\x{442}\x{435}\x{441}\x{442}0"},
148		'1251 + low entity',
149	or diag explain($data),"\n";
150	ok utf8::is_utf8($data->{text}), "utf flag set";
151
152	{
153		is_deeply
154			$data = xml2hash("<?xml encoding='windows-1251'?><text>����&#x2622;\"&quot;</text>"),
155			{text => "\x{442}\x{435}\x{441}\x{442}\x{2622}\"\""},
156			'1251 + high entity (char mode)',
157		or diag explain($data),"\n";
158		ok utf8::is_utf8($data->{text}), "utf flag set";
159	}
160
161	{
162		is_deeply
163			$data = xml2hash("<?xml encoding='windows-1251'?><text>����&#x2622;</text>", bytes => 1, nowarn => 1),
164			{text => "����?"},
165			'1251 + high entity (bytes mode)',
166		or diag explain($data),"\n";
167		ok !utf8::is_utf8($data->{text}), "utf flag not set";
168	}
169	{
170		is_deeply
171			$data = xml2hash("<?xml encoding='windows-1251'?><text>����&#xAB;</text>", bytes => 1),
172			{text => "����"},
173			'1251 + high entity (bytes mode), fits to charset',
174		or diag explain($data),"\n";
175		ok !utf8::is_utf8($data->{text}), "utf flag not set";
176	}
177}
178{
179	is_deeply
180		$data = xml2hash($xml1, array => 1),
181		{root => [{'-at' => 'key',nest => [{'#text' => 'firstmidlast',vv => [''],v => ['a',{'-at' => 'a','#text' => 'b'}]}]}]},
182		'array => 1 (1)',
183	or diag explain($data),"\n";
184}
185
186{
187	is_deeply
188		$data = xml2hash("<handshake/>"),
189		{ handshake => '' },
190		'empty root',
191	or diag explain($data),"\n";
192}
193__END__
194
195=for rem hash casting is useless and not implemented
196{
197	is_deeply
198		$data = xml2hash($xml1, hash => ['vv']  ),
199		{root => {'-at' => 'key',nest => {'#text' => 'firstmidlast',vv => {'#text' => ''},v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
200		'hash => vv (1)',
201	or diag dd($data),"\n";
202}
203{
204	is_deeply
205		$data = xml2hash($xml1, hash => 1),
206		{root => {'-at' => 'key',nest => {'#text' => 'firstmidlast',vv => {'#text' => ''},v => [{ '#text' => 'a'},{'-at' => 'a','#text' => 'b'}]}}},
207		'hash => 1 (1)',
208	or diag dd($data),"\n";
209}
210=cut
211{
212	is_deeply
213		$data = xml2hash($xml1, attr => '+'),
214		{root => {'+at' => 'key',nest => {'#text' => 'firstmidlast',vv => '',v => ['a',{'+at' => 'a','#text' => 'b'}]}}},
215		'attr => + (1)'
216	or diag dd($data),"\n";
217}
218{
219	local $X2H{attr} = '+';
220	is_deeply
221		$data = xml2hash($xml1),
222		{root => {'+at' => 'key',nest => {'#text' => 'firstmidlast',vv => '',v => ['a',{'+at' => 'a','#text' => 'b'}]}}},
223		'X2H.attr = + (1)'
224	or diag dd($data),"\n";
225}
226{
227	is_deeply
228		$data = xml2hash($xml1, text => ''),
229		{root => {'-at' => 'key',nest => {'' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','' => 'b'}]}}},
230		'text => "" (1)'
231	or diag dd($data),"\n";
232}
233{
234	local $X2H{text} = '';
235	is_deeply
236		$data = xml2hash($xml1),
237		{root => {'-at' => 'key',nest => {'' => 'firstmidlast',vv => '',v => ['a',{'-at' => 'a','' => 'b'}]}}},
238		'X2H.text = "" (1)'
239	or diag dd($data),"\n";
240}
241{
242	is_deeply
243		$data = xml2hash($xml1, join => ' '),
244		{root => {'-at' => 'key',nest => {'#text' => 'first mid last',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
245		'join => " " (1)'
246	or diag dd($data),"\n";
247}
248{
249	local $X2H{join} = ' ';
250	is_deeply
251		$data = xml2hash($xml1),
252		{root => {'-at' => 'key',nest => {'#text' => 'first mid last',vv => '',v => ['a',{'-at' => 'a','#text' => 'b'}]}}},
253		'X2H.join = " " (1)'
254	or diag dd($data),"\n";
255}
256{
257	is_deeply
258		$data = xml2hash(q{<root><!--test--></root>}, comm => '#comment'),
259		{root => {'#comment' => 'test'}},
260		'comment node'
261	or diag dd($data),"\n";
262}
263{
264	is_deeply
265		$data = xml2hash(q{<root x="1">test</root>}, text => '#textnode'),
266		{root => { -x => 1, '#textnode' => 'test' }},
267		'text node'
268	or diag dd($data),"\n";
269}
270{
271	is_deeply
272		$data = xml2hash(q{<root x="1"><![CDATA[test]]></root>}, cdata => '#cdata'),
273		{root => { -x => 1, '#cdata' => 'test' }},
274		'cdata node'
275	or diag dd($data),"\n";
276}
277
278
279# Composing
280# Due to unpredictable order of hash keys
281#   { node => { a => 1, b => 2 } }
282# could be one of:
283#   <node><a>1</a><b>2</b></node>
284#   <node><b>2</b><a>1</a></node>
285# So, in tests used more complex form with predictable order:
286#   { node => [ { a => 1 }, { b => 2 } ] }
287# which produce always
288#   <node><a>1</a><b>2</b></node>
289
290our $xml = qq{<?xml version="1.0" encoding="utf-8"?>\n};
291
292{
293	is
294		$data = hash2xml( { node => [ { -attr => "test" }, { sub => 'test' }, { tx => { '#text' => ' zzzz ' } } ] } ),
295		qq{$xml<node attr="test"><sub>test</sub><tx>zzzz</tx></node>\n},
296		'default 1',
297	;
298}
299{
300	is
301		$data = hash2xml( { node => [ { _attr => "test" }, { sub => 'test' }, { tx => { '#text' => 'zzzz' } } ] }, attr => '_' ),
302		qq{$xml<node attr="test"><sub>test</sub><tx>zzzz</tx></node>\n},
303		'attr _',
304	;
305}
306{
307	is
308		$data = hash2xml( { node => [ { -attr => "test" }, { sub => 'test' }, { tx => { '~' => 'zzzz' } } ] }, text => '~' ),
309		qq{$xml<node attr="test"><sub>test</sub><tx>zzzz</tx></node>\n},
310		'text ~',
311	;
312}
313{
314	is
315		$data = hash2xml( { node => { sub => [ " \t\n", 'test' ] } }, trim => 1 ),
316		qq{$xml<node><sub>test</sub></node>\n},
317		'trim 0',
318	;
319	is
320		$data = hash2xml( { node => { sub => [ " \t\n", 'test' ] } }, trim => 0 ),
321		qq{$xml<node><sub> \t\ntest</sub></node>\n},
322		'trim 1',
323	;
324}
325{
326	is
327		$data = hash2xml( { node => { sub => { '@' => 'test' } } }, cdata => '@' ),
328		qq{$xml<node><sub><![CDATA[test]]></sub></node>\n},
329		'cdata @',
330	;
331}
332{
333	is
334		$data = hash2xml( { node => { sub => { '/' => 'test' } } },comm => '/' ),
335		qq{$xml<node><sub><!--test--></sub></node>\n},
336		'comm /',
337	;
338}
339