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 & mid & last 37 </nest> 38 </root> 39}; 40 41our $xml3 = q{ 42 <root at="key"> 43 <nest> 44 first & <v>x</v> & 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>тест☢</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>����0</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>����☢\""</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>����☢</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>����«</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