1#!/bin/env perl 2 3BEGIN { 4 unless(grep /blib/, @INC) { 5 chdir 't' if -d 't'; 6 unshift @INC, '../lib' if -d '../lib'; 7 } 8} 9 10use strict; 11use Test; 12 13BEGIN { plan tests => 131 } 14 15use SOAP::Lite; 16$SIG{__WARN__} = sub { ; }; # turn off deprecation warnings 17 18my($a, $s, $r, $serialized, $deserialized); 19 20{ # check root, mustUnderstand 21 print "root and mustUnderstand attributes with SOAP::Data test(s)...\n"; 22 23 $serialized = SOAP::Serializer->serialize(SOAP::Data->root(1 => 1)->name('rootandunderstand')->mustUnderstand(1)); 24 25 ok($serialized =~ m!<rootandunderstand( xsi:type="xsd:int"| soap:mustUnderstand="1"| soapenc:root="1"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){7}>1</rootandunderstand>!); 26} 27 28{ # check deserialization of envelope with result 29 print "Deserialization of envelope with result test(s)...\n"; 30 31 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 32<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 33 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 34 xmlns:xsd="http://www.w3.org/2001/XMLSchema" 35 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 36 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 37<soap:Body> 38<m:doublerResponse xmlns:m="http://simon.fell.com/calc"> 39<nums xsi:type="soapenc:Array" soapenc:arrayType="xsd:int[5]"> 40<item xsi:type="xsd:int">20</item> 41<item xsi:type="xsd:int">40</item> 42<item xsi:type="xsd:int">60</item> 43<item xsi:type="xsd:int">100</item> 44<item xsi:type="xsd:int">200</item> 45</nums> 46</m:doublerResponse> 47</soap:Body> 48</soap:Envelope> 49'); 50 51 ok($deserialized->result->[2] == 60); 52 ok((my @array = $deserialized->paramsall) == 1); 53 ok(ref $deserialized->body eq 'HASH'); # not blessed anymore since 0.51 54} 55 56{ # check deserialization of envelope with fault 57 print "Deserialization of envelope with fault test(s)...\n"; 58 59 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 60<soap:Envelope xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"> 61<soap:Body> 62<soap:Fault><faultcode>soap:Client</faultcode><faultstring>Application Error</faultstring><detail>Invalid Password</detail></soap:Fault></soap:Body></soap:Envelope> 63'); 64 65 ok($deserialized->faultcode eq 'soap:Client'); 66 ok($deserialized->faultstring eq 'Application Error'); 67 ok($deserialized->faultdetail eq 'Invalid Password'); 68} 69 70{ # check deserialization of circular references 71 print "Deserialization of circular references test(s)...\n"; 72 73 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 74<Struct prefix:id="123" xmlns:prefix="aaa" id="ref-0xb61350"><a id="ref-0xb61374"><b href="#ref-0xb61350"/></a></Struct> 75'); 76 77 ok(ref $deserialized->valueof('/Struct') eq ref $deserialized->valueof('//b')); 78 79 ok($deserialized->dataof('/Struct')->attr->{'{aaa}id'} == 123); 80 ok(exists $deserialized->dataof('/Struct')->attr->{'id'}); 81} 82 83{ # check SOAP::SOM 84 print "SOM test(s)...\n"; 85 86 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 87<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 88 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 89 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 90 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 91 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 92<soap:Body> 93<m:doublerResponse xmlns:m="http://simon.fell.com/calc"> 94<nums> 95<item1 xsi:type="xsd:int">20</item1> 96<item1 xsi:type="xsd:int">40</item1> 97<item2 xsi:type="xsd:int">60</item2> 98<item2 xsi:type="xsd:int">100</item2> 99<item3 xsi:type="xsd:int">200</item3> 100</nums> 101</m:doublerResponse> 102</soap:Body> 103</soap:Envelope> 104'); 105 106 # should return STRING '/Envelope/Body/[1]/[1]' 107 my $result = SOAP::SOM::result; 108 ok($deserialized->valueof("$result/[1]") == 20); 109 ok($deserialized->valueof("$result/[3]") == 60); 110 ok($deserialized->valueof("$result/[5]") == 200); 111 112 # match should return true/false in boolean context (and object ref otherwise) 113 ok($deserialized->match('aaa') ? 0 : 1); 114 115 # should return same string as above 116 ok($deserialized->match(SOAP::SOM->result)); 117 118 ok($deserialized->valueof('[1]') == 20); 119 ok($deserialized->valueof('[3]') == 60); 120 ok($deserialized->valueof('[5]') == 200); 121 122 $deserialized->match('//Body/[1]/[1]'); # match path and change current node on success 123 ok($deserialized->valueof('[1]') == 20); 124 ok($deserialized->valueof('[3]') == 60); 125 ok($deserialized->valueof('[5]') == 200); 126} 127 128{ # check output parameters 129 print "Output parameters test(s)...\n"; 130 131 $deserialized = SOAP::Deserializer->deserialize(' 132<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 133 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 134 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 135 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 136 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 137<soap:Body> 138 <mehodResponse> 139 <res1>name1</res1> 140 <res2>name2</res2> 141 <res3>name3</res3> 142 </mehodResponse> 143</soap:Body> 144</soap:Envelope> 145'); 146 my @paramsout = $deserialized->paramsout; 147 148 ok($paramsout[0] eq 'name2' && $paramsout[1] eq 'name3'); 149} 150 151{ # check nonqualified namespace 152 print "Nonqualified namespace test(s)...\n"; 153 154 $deserialized = SOAP::Deserializer->deserialize(' 155<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 156 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 157 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 158 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 159 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 160<soap:Body> 161<doublerResponse xmlns="http://simon.fell.com/calc"> 162<nums xsi:type="soapenc:Array" soapenc:arrayType="xsd:int[5]"> 163<item xsi:type="xsd:int">20</item> 164<item xsi:type="xsd:int">40</item> 165<item xsi:type="xsd:int">60</item> 166<item xsi:type="xsd:int">100</item> 167<item xsi:type="xsd:int">200</item> 168</nums> 169</doublerResponse> 170</soap:Body> 171</soap:Envelope> 172'); 173 174 ok($deserialized->namespaceuriof(SOAP::SOM::method) eq 'http://simon.fell.com/calc'); 175 ok($deserialized->namespaceuriof('//doublerResponse') eq 'http://simon.fell.com/calc'); 176} 177 178{ # check for Array of Array serialization 179 print "Array of Array serialization test(s)...\n"; 180 181 $serialized = SOAP::Serializer 182 ->readable(1) 183 ->method('mymethod' => [[1, 2], [3, 4]]); 184 ok($serialized =~ m!soapenc:arrayType="soapenc:Array\[2\]"!); 185} 186 187{ # check for serialization with SOAPStruct 188 print "Serialization w/out SOAPStruct test(s)...\n"; 189 $a = { a => 1 }; 190 $serialized = SOAP::Serializer->namespaces({})->serialize($a); 191 ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:int">1</a></c-gensym\1>!); 192} 193 194{ # check header/envelope serialization/deserialization 195 print "Header/Envelope serialization/deserialization test(s)...\n"; 196 197 $serialized = SOAP::Serializer->method( # same as ->envelope(method => 198 'mymethod', 1, 2, 3, 199 SOAP::Header->name(t1 => 5)->mustUnderstand(1)->uri('http://namespaces.soaplite.com/headers'), 200 SOAP::Header->name(t2 => 7)->mustUnderstand(2), 201 ); 202 $deserialized = SOAP::Deserializer->deserialize($serialized); 203 204 my $t1 = $deserialized->match(SOAP::SOM::header)->headerof('t1'); 205 my $t2 = $deserialized->dataof('t2'); 206 my $t3 = eval { $deserialized->headerof(SOAP::SOM::header . '/{http://namespaces.soaplite.com/headers}t3'); }; 207 208 ok(!$@ && !defined $t3); 209 210 my @paramsin = $deserialized->paramsin; 211 my @paramsall = $deserialized->paramsall; 212 213 ok($t2->type =~ /^int$/); 214 ok($t2->mustUnderstand == 1); 215 ok(@paramsin == 3); 216 ok(@paramsall == 3); 217 218 eval { $deserialized->result(1) }; 219 ok($@ =~ /Method 'result' is readonly/); 220 221 $serialized = SOAP::Serializer->method( # same as ->envelope(method => 222 SOAP::Data->name('mymethod')->attr({something => 'value'}), 1, 2, 3, 223 ); 224 ok($serialized =~ /<mymethod something="value">/); 225 226 $serialized = SOAP::Serializer 227 -> envprefix('') 228 -> method('mymethod'); 229 230 ok($serialized =~ m!<Envelope(?: xmlns:namesp\d+="http://schemas.xmlsoap.org/soap/envelope/"| namesp\d+:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){5}><Body><mymethod xsi:nil="true" /></Body></Envelope>!); 231 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/2001/XMLSchema"><soap:Body><getStateName><c-gensym5 xsi:type="xsd:int">1</c-gensym5></getStateName></soap:Body></soap:Envelope>'); 232 ok(! defined $deserialized->namespaceuriof('//getStateName')); 233 234 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0" encoding="UTF-8"?><soap:Envelope xmlns="a" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" xmlns:xsd="http://www.w3.org/1999/XMLSchema"><soap:Body><getStateName><c-gensym5 xsi:type="xsd:int">1</c-gensym5></getStateName></soap:Body></soap:Envelope>'); 235 ok($deserialized->namespaceuriof('//getStateName') eq 'a'); 236} 237 238{ # Map type serialization/deserialization 239 print "Map type serialization/deserialization test(s)...\n"; 240 241 my $key = "\0\1"; 242 $serialized = SOAP::Serializer->method(aa => SOAP::Data->type(map => {a => 123, $key => 456})->name('maaap')); 243 244 { local $^W; # disable warning on implicit map encoding 245 my $implicit = SOAP::Serializer->method(aa => SOAP::Data->name(maaap => {a => 123, $key => 456})); 246 ok($implicit eq $serialized); 247 } 248 ok($serialized =~ /apachens:Map/); 249 ok($serialized =~ m!xmlns:apachens="http://xml.apache.org/xml-soap"!); 250 251 $deserialized = SOAP::Deserializer->deserialize($serialized); 252 $a = $deserialized->valueof('//maaap'); 253 ok(UNIVERSAL::isa($a => 'HASH')); 254 ok(ref $a && $a->{$key} == 456); 255} 256 257{ # Stringified type serialization 258 print "Stringified type serialization test(s)...\n"; 259 260 $serialized = SOAP::Serializer->serialize(bless { a => 1, _current => [] } => 'SOAP::SOM'); 261 262 my $test = $serialized; 263 ok $test =~s{ 264 <\?xml \s version="1.0" \s encoding="UTF-8"\?> 265 <SOAP__SOM 266 (?: 267 \sxsi:type="namesp(\d+):SOAP__SOM" 268 | \sxmlns:namesp\d+="http://namespaces.soaplite.com/perl" 269 | \sxmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 270 | \sxmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 271 | \sxmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 272 | \sxmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}> 273 }{}xms; 274 275 ok $test =~s{ 276 </SOAP__SOM> \z 277 }{}xms; 278 279 ok $test =~s{ <a \s xsi:type="xsd:int">1</a> }{}xms; 280 ok $test =~s{ <_current (:? 281 \s soapenc:arrayType="xsd:anyType\[0\]" 282 | \s xsi:type="soapenc:Array" ){2} 283 \s/> 284 }{}xms; 285 286 ok length $test == 0; 287 288 # Replaced complex regex by several simpler (see above). 289 290 # ok($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}><a xsi:type="xsd:int">1</a><_current(?: soapenc:arrayType="xsd:anyType\[0\]"| xsi:type="soapenc:Array"){2} /></SOAP__SOM>!); 291 # ok( ($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}><a xsi:type="xsd:int">1</a><_current(?: soapenc:arrayType="xsd:anyType\[0\]"| xsi:type="soapenc:Array"){2}/></SOAP__SOM>!) 292 # || ($serialized =~ m!<SOAP__SOM(?: xsi:type="namesp(\d+):SOAP__SOM"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){6}><_current(?: soapenc:arrayType="xsd:anyType\[0\]"| xsi:type="soapenc:Array"){2}/><a xsi:type="xsd:int">1</a></SOAP__SOM>!)); 293 #print $serialized; 294 # exit; 295 296 $serialized =~ s/__/./g; # check for SOAP.SOM instead of SOAP__SOM 297 ok(ref SOAP::Deserializer->deserialize($serialized)->root eq 'SOAP::SOM'); 298} 299 300{ # Serialization of non-allowed element 301 print "Serialization of non-allowed element test(s)...\n"; 302 303 eval { $serialized = SOAP::Serializer->serialize(SOAP::Data->name('---' => 'aaa')) }; 304 305 ok($@ =~ /^Element/); 306} 307 308{ # Custom serialization of blessed reference 309 print "Custom serialization of blessed reference test(s)...\n"; 310 311 eval q! 312 sub SOAP::Serializer::as_My__Own__Class { 313 my $self = shift; 314 my($value, $name, $type, $attr) = @_; 315 return [$name, {%{$attr || {}}, 'xsi:type' => 'xsd:string'}, join ', ', map {"$_ => $value->{$_}"} sort keys %$value]; 316 } 317 1; 318 ! or die; 319 320 $serialized = SOAP::Serializer->serialize(bless {a => 1, b => 2} => 'My::Own::Class'); 321 ok($serialized =~ m!<My__Own__Class( xsi:type="xsd:string"| xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"| xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"| xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"| xmlns:xsd="http://www.w3.org/2001/XMLSchema"){5}>a => 1, b => 2</My__Own__Class>!); 322} 323 324{ # Multirefs serialization 325 print "Multirefs serialization test(s)...\n"; 326 327 my $b = { b => 2 }; 328 my $a = { a => $b }; 329 my $c = { c1 => $a, c2 => $a }; 330 331 $serialized = SOAP::Serializer->autotype(0)->method(a => $c); 332 ok($serialized =~ m!<soap:Body><a><c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></soap:Body>! || 333 $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></soap:Body>! || 334 $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></soap:Body>! || 335 $serialized =~ m!<soap:Body><a><c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /></c-gensym\1></a><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></soap:Body>!); 336 337 $serialized = SOAP::Serializer->autotype(0)->namespaces({})->serialize($c); 338 ok($serialized =~ m!<c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></c-gensym\1>! || 339 $serialized =~ m!<c-gensym(\d+)><c1 href="#ref-(\d+)" /><c2 href="#ref-\2" /><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></c-gensym\1>! || 340 $serialized =~ m!<c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /><c-gensym(\d+) id="ref-(\d+)"><b>2</b></c-gensym\3><c-gensym(\d+) id="ref-\2"><a href="#ref-\4" /></c-gensym\5></c-gensym\1>! || 341 $serialized =~ m!<c-gensym(\d+)><c2 href="#ref-(\d+)" /><c1 href="#ref-\2" /><c-gensym(\d+) id="ref-\2"><a href="#ref-(\d+)" /></c-gensym\3><c-gensym(\d+) id="ref-\4"><b>2</b></c-gensym\5></c-gensym\1>!); 342 343 my $root = SOAP::Deserializer->deserialize($serialized)->root; 344 345 ok($root->{c1}->{a}->{b} == 2); 346 ok($root->{c2}->{a}->{b} == 2); 347} 348 349{ # Serialization of multirefs shared between Header and Body 350 print "Serialization of multirefs shared between Header and Body test(s)...\n"; 351 352 $a = { b => 2 }; 353 354 print $serialized = SOAP::Serializer->autotype(0)->method(a => SOAP::Header->value($a), $a); 355 print "\n"; 356 print '<soap:Header><c-gensym\d+ href="#ref-(\d+)" /></soap:Header><soap:Body><a><c-gensym\d+ href="#ref-\1" /></a><c-gensym(\d+) id="ref-\1"><b>2</b></c-gensym\2></soap:Body>', "\n"; 357 ok($serialized =~ m!<soap:Header><c-gensym\d+ href="#ref-(\d+)" /></soap:Header><soap:Body><a><c-gensym\d+ href="#ref-\1" /></a><c-gensym(\d+) id="ref-\1"><b>2</b></c-gensym\2></soap:Body>!); 358} 359 360{ # Deserialization with typecast 361 print "Deserialization with typecast test(s)...\n"; 362 363 my $desc = 0; 364 my $typecasts = 0; 365 eval { 366 package MyDeserializer; 367 @MyDeserializer::ISA = 'SOAP::Deserializer'; 368 sub typecast; 369 *typecast = sub { shift; 370 my($value, $name, $attrs, $children, $type) = @_; 371 $desc = "$name @{[scalar @$children]}" if $name eq 'a'; 372 $typecasts++; 373 return; 374 }; 375 1; 376 } or die; 377 378 $deserialized = MyDeserializer->deserialize('<a><b>1</b><c>2</c></a>'); 379 ok($desc eq 'a 2'); #! fix "if $name eq 'a'", because $name is QName now ('{}a') 380 ok($typecasts == 5); 381} 382 383{ # Deserialization with wrong encodingStyle 384 print "Deserialization with wrong encodingStyle test(s)...\n"; 385 386 eval { $deserialized = SOAP::Deserializer->deserialize( 387'<a 388 soap:encodingStyle="http://schemas.microsoft.com/soap/encoding/clr/1.0 http://schemas.xmlsoap.org/soap/encoding/" 389 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 390>1</a>') }; 391 ok(!$@ && $deserialized); 392 393 eval { $deserialized = SOAP::Deserializer->deserialize( 394'<a 395 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" 396 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 397>1</a>') }; 398 ok(!$@ && $deserialized); 399 400 eval { $deserialized = SOAP::Deserializer->deserialize( 401'<a 402 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/something" 403 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 404>1</a>') }; 405 ok(!$@ && $deserialized); 406 407 eval { $deserialized = SOAP::Deserializer->deserialize( 408'<a>1</a>') }; 409 ok(!$@ && $deserialized); 410 411 eval { $deserialized = SOAP::Deserializer->deserialize( 412'<a 413 soap:encodingStyle="" 414 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 415>1</a>') }; 416 ok(!$@ && $deserialized); 417} 418 419{ # Deserialization with root attribute 420 print "Deserialization with root attribute test(s)...\n"; 421 422 # root="0", should skip 423 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 424<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 425 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 426 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 427 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 428 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 429<soap:Body> 430<m:doublerResponse1 soapenc:root="0" xmlns:m="http://soaplite.com/"> 431<nums>1</nums> 432</m:doublerResponse1> 433<m:doublerResponse2 xmlns:m="http://soaplite.com/"> 434<nums>2</nums> 435</m:doublerResponse2> 436</soap:Body> 437</soap:Envelope> 438'); 439 440 ok($deserialized->result == 2); 441 442 # root="0", but in wrong namespace 443 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 444<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 445 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 446 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 447 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 448 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 449<soap:Body> 450<m:doublerResponse1 root="0" xmlns:m="http://soaplite.com/"> 451<nums>1</nums> 452</m:doublerResponse1> 453<m:doublerResponse2 xmlns:m="http://soaplite.com/"> 454<nums>2</nums> 455</m:doublerResponse2> 456</soap:Body> 457</soap:Envelope> 458'); 459 460 ok($deserialized->result == 1); 461 462 # root="1" 463 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 464<soap:Envelope xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 465 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 466 xmlns:xsd="http://www.w3.org/1999/XMLSchema" 467 xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" 468 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"> 469<soap:Body> 470<m:doublerResponse1 soapenc:root="1" xmlns:m="http://soaplite.com/"> 471<nums>1</nums> 472</m:doublerResponse1> 473<m:doublerResponse2 xmlns:m="http://www.soaplite.com/2"> 474<nums>2</nums> 475</m:doublerResponse2> 476<m:doublerResponse2 xmlns:m="http://www.soaplite.com/3"> 477<nums>3</nums> 478</m:doublerResponse2> 479<doublerResponse2 xmlns=""> 480<nums>4</nums> 481</doublerResponse2> 482</soap:Body> 483</soap:Envelope> 484'); 485 486 ok($deserialized->result == 1); 487 ok($deserialized->valueof('//{http://www.soaplite.com/2}doublerResponse2/nums') == 2); 488 ok($deserialized->valueof('//{http://www.soaplite.com/3}doublerResponse2/nums') == 3); 489 ok($deserialized->valueof('//{}doublerResponse2/nums') == 4); 490 my @nums = $deserialized->valueof('//doublerResponse2/nums'); 491 ok(@nums == 3); 492 ok($nums[0] == 2 && $nums[1] == 3); 493 my $body = $deserialized->body; 494 ok(ref $body->{doublerResponse1} && ref $body->{doublerResponse2}); 495} 496 497{ 498 print "Deserialization with null elements test(s)...\n"; 499 500 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 501<soap:Envelope xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"> 502<soap:Body> 503<namesp23:object_infoResponse xmlns:namesp23="http://localhost/Test"> 504<soapenc:Array xsi:type="soapenc:Array" soapenc:arrayType="xsd:integer[]"> 505<item xsi:type="xsd:string">1</item> 506<item xsi:type="xsd:string">2</item> 507<item xsi:null="1"/> 508<item xsi:null="1"/> 509<item xsi:type="xsd:string">5</item> 510<item xsi:type="xsd:string"/> 511<item xsi:type="xsd:string">7</item> 512</soapenc:Array> 513</namesp23:object_infoResponse> 514</soap:Body> 515</soap:Envelope> 516')->result; 517 518 ok(scalar @$deserialized == 7); 519 ok(! defined $deserialized->[2]); 520 ok(! defined $deserialized->[3]); 521 ok($deserialized->[5] eq ''); 522} 523 524{ 525 print "Serialization of list with undef elements test(s)...\n"; 526 527 $serialized = SOAP::Serializer->method(a => undef, 1, undef, 2); 528 my(@r) = SOAP::Deserializer->deserialize($serialized)->paramsall; 529 530 ok(2 == grep {!defined} @r); 531} 532 533{ 534 print "Deserialization with xsi:type='string' test(s)...\n"; 535 536 $a = 'SOAP::Lite'; 537 $deserialized = SOAP::Deserializer->deserialize(qq!<inputString xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xsi:type="string" xmlns="http://schemas.xmlsoap.org/soap/encoding/">$a</inputString>!)->root; 538 539 ok($deserialized eq $a); 540} 541 542{ 543 print "Deserialization with typing inherited from Array element test(s)...\n"; 544 545 $deserialized = SOAP::Deserializer->deserialize('<?xml version="1.0"?> 546<soapenc:Array xsi:type="soapenc:Array" soapenc:arrayType="soapenc:base64[]" xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance" xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" xmlns:xsd="http://www.w3.org/1999/XMLSchema" soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"> 547<item xsi:type="xsd:string">MTIz</item> 548<item>MTIz</item> 549<item xsi:type="xsd:string"/> 550</soapenc:Array>')->root; 551 552 ok(scalar @$deserialized == 3); 553 ok($deserialized->[0] eq 'MTIz'); 554 ok($deserialized->[1] eq 123); 555 ok($deserialized->[2] eq ''); 556} 557 558{ 559 print "Serialization with explicit typing test(s)...\n"; 560 561 $serialized = SOAP::Serializer 562 ->method(a => SOAP::Data->name('return')->type(int => 1)); 563 ok($serialized =~ /xsd:int/); 564 565 eval { 566 $serialized = SOAP::Serializer 567 ->method(a => SOAP::Data->name('return')->type(noint => 1)); 568 }; 569 ok($@ =~ /for type 'noint' is not specified/); 570} 571{ 572 print "Serialization w/out explicit typing test(s)...\n"; 573 574 $a = { a => 'false' }; 575 $serialized = SOAP::Serializer->namespaces({})->serialize($a); 576 577 ### 'false' evaluated as a boolean should still be false after the evaluation. 578 ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:boolean">false</a></c-gensym\1>!); 579 580 $a = { a => 'true' }; 581 $serialized = SOAP::Serializer->namespaces({})->serialize($a); 582 583 ### 'false' evaluated as a boolean should still be false after the evaluation. 584 ok($serialized =~ m!<c-gensym(\d+)><a xsi:type="xsd:boolean">true</a></c-gensym\1>!); 585 586} 587{ 588 print "Serialization with explicit namespaces test(s)...\n"; 589 590 $serialized = SOAP::Serializer->serialize(SOAP::Data->name('b' => 1)); 591 ok($serialized =~ m!<b !); 592 593 $serialized = SOAP::Serializer->serialize(SOAP::Data->name('c:b' => 1)); 594 ok($serialized =~ m!<c:b !); 595 596 $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{a}b' => 1)); 597 ok($serialized =~ m!<namesp\d+:b ! && $serialized =~ m!xmlns:namesp\d+="a"!); 598 599 $serialized = SOAP::Serializer->serialize(SOAP::Data->name('{}b' => 1)); 600 ok($serialized =~ m!<b ! && $serialized =~ m!xmlns=""!); 601 602 my @prefix_uri_tests = ( 603 # prefix, uri, test 604 [ undef, undef, '<b>1</b>' ], 605 [ undef, '', '<b xmlns="">1</b>' ], 606 [ undef, 'a', '<(namesp\d+):b xmlns:\1="a">1</\1:b>' ], 607 [ '', undef, '<b>1</b>' ], 608 [ '', '', '<b xmlns="">1</b>' ], 609 [ '', 'a', '<b xmlns="a">1</b>' ], 610 [ 'c', undef, '<c:b>1</c:b>' ], 611 [ 'c', '', '<b xmlns="">1</b>' ], 612 [ 'c', 'a', '<c:b xmlns:c="a">1</c:b>' ], 613 ); 614 615 my $serializer = SOAP::Serializer->autotype(0)->namespaces({}); 616 my $deserializer = SOAP::Deserializer->new; 617 my $testnum = 0; 618 foreach (@prefix_uri_tests) { 619 $testnum++; 620 my($prefix, $uri, $test) = @$_; 621 my $res = $serializer->serialize( 622 SOAP::Data->name('b')->prefix($prefix)->uri($uri)->value(1) 623 ); 624 ok($res =~ /$test/); 625 next unless $testnum =~ /^([4569])$/; 626 627 my $data = $deserializer->deserialize($res)->dataof(SOAP::SOM::root); 628 ok(defined $prefix ? defined $data->prefix && $data->prefix eq $prefix 629 : !defined $data->prefix); 630 ok(defined $uri ? defined $data->uri && $data->uri eq $uri 631 : !defined $data->uri); 632 } 633} 634 635{ 636 print "Deserialization for different SOAP versions test(s)...\n"; 637 638 my $version = SOAP::Lite->soapversion; 639 640 $a = q!<?xml version="1.0" encoding="UTF-8"?> 641<soap:Envelope 642 xmlns:soapenc="http://www.w3.org/2003/05/soap-encoding" 643 soap:encodingStyle="http://www.w3.org/2003/05/soap-encoding" 644 xmlns:soap="http://www.w3.org/2003/05/soap-envelope" 645 xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" 646 xmlns:xsd="http://www.w3.org/2001/XMLSchema"> 647<soap:Body> 648<namesp9:echoIntegerArray xmlns:namesp9="http://soapinterop.org/"> 649<inputIntegerArray soapenc:arrayType="xsd:int[3]" xsi:type="soapenc:Array"> 650<item xsi:type="xsd:int">1</item> 651<item xsi:type="xsd:int">3</item> 652<item xsi:type="xsd:int">5</item> 653</inputIntegerArray> 654</namesp9:echoIntegerArray> 655</soap:Body> 656</soap:Envelope>!; 657 658 SOAP::Lite->soapversion(1.1); 659 $deserialized = SOAP::Deserializer->deserialize($a); 660 ok(ref $deserialized->result eq 'ARRAY'); 661 662 SOAP::Lite->soapversion(1.2); 663 $deserialized = SOAP::Deserializer->deserialize($a); 664 ok(ref $deserialized->result eq 'ARRAY'); 665 666 SOAP::Lite->soapversion($version); 667} 668 669{ 670 print "Deserialization of multidimensional array of array test(s)...\n"; 671 672 $a = q!<?xml version="1.0" encoding="UTF-8"?> 673<S:Envelope S:encodingStyle='http://schemas.xmlsoap.org/soap/encoding/' 674 xmlns:S='http://schemas.xmlsoap.org/soap/envelope/' 675 xmlns:E='http://schemas.xmlsoap.org/soap/encoding/' 676 xmlns:a='http://foo.bar.org/' 677 xmlns:b='http://www.w3.org/2001/XMLSchema' 678 xmlns:c='http://www.w3.org/2001/XMLSchema-instance'> 679<S:Body><a:SomeMethod> 680<nums E:arrayType='b:anyType[2,2]'> 681<i E:arrayType='b:anyType[3]'> 682<i c:type='b:short'>1</i><i c:type='b:short'>2</i><i c:type='b:short'>3</i> 683</i> 684<i E:arrayType='b:anyType[3]'> 685<i c:type='b:short'>4</i><i c:type='b:short'>5</i><i c:type='b:short'>6</i> 686</i> 687<i E:arrayType='b:anyType[3]'> 688<i c:type='b:short'>7</i><i c:type='b:short'>8</i><i c:type='b:short'>9</i> 689</i> 690<i E:arrayType='b:anyType[3]'> 691<i c:type='b:short'>10</i><i c:type='b:short'>11</i><i c:type='b:short'>12</i> 692</i> 693</nums></a:SomeMethod></S:Body></S:Envelope>!; 694 695 $deserialized = SOAP::Deserializer->deserialize($a)->result; 696 697 # [ 698 # [ 699 # ['1', '2', '3'], 700 # ['4', '5', '6'] 701 # ], 702 # [ 703 # ['7', '8', '9'], 704 # ['10', '11', '12'] 705 # ] 706 # ] 707 708 ok(ref $deserialized eq 'ARRAY'); 709 ok(@$deserialized == 2); 710 ok(@{$deserialized->[0]} == 2); 711 ok(@{$deserialized->[0]->[0]} == 3); 712 ok($deserialized->[0]->[0]->[2] == 3); 713} 714 715{ 716 print "Serialization without specified typemapping test(s)...\n"; 717 718 $serialized = SOAP::Serializer->method(a => bless {a => 1} => 'A'); 719 ok($serialized =~ m!<A xsi:type="namesp\d+:A">!); 720 ok($serialized =~ m!^<\?xml!); # xml declaration 721 722 # higly questionably, but that's how it is 723 $serialized = SOAP::Serializer->encoding(undef)->method(a => bless {a => 1} => 'A'); 724 ok($serialized =~ m!<A(?: xsi:type="namesp\d+:A"| xmlns:namesp\d+="http://namespaces.soaplite.com/perl")>!); 725 ok($serialized !~ m!^<\?xml!); # no xml declaration 726} 727 728{ 729 print "Deserialization with different XML Schemas on one element test(s)...\n"; 730 731 my $deserializer = SOAP::Deserializer->new; 732 $deserializer->deserialize(q!<soap:Envelope 733 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" 734 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 735 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 736 xmlns:xsi1="http://www.w3.org/2001/XMLSchema-instance" 737 xmlns:xsi0="http://www.w3.org/2000/10/XMLSchema-instance" 738 xmlns:xsi9="http://www.w3.org/1999/XMLSchema-instance" 739 xmlns:xsd9="http://www.w3.org/1999/XMLSchema" 740 xmlns:xsd1="http://www.w3.org/2001/XMLSchema" 741 xmlns:xsd0="http://www.w3.org/2000/10/XMLSchema" > 742 <soap:Body> 743 <ns0:echoString xmlns:ns0="http://soapinterop.org/" > 744 <inputString xsi0:type="xsd0:string" xsi1:type="xsd1:string" 745xsi9:type="xsd9:string">Simple Test String</inputString> 746 </ns0:echoString> 747 </soap:Body> 748</soap:Envelope>!); 749 750 ok($deserializer->xmlschema eq 'http://www.w3.org/1999/XMLSchema'); 751 752 $deserializer->deserialize(q!<soap:Envelope 753 soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/" 754 xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/" 755 xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/" 756 xmlns:xsi1="http://www.w3.org/2001/XMLSchema-instance" 757 xmlns:xsi0="http://www.w3.org/2000/10/XMLSchema-instance" 758 xmlns:xsi9="http://www.w3.org/1999/XMLSchema-instance" 759 xmlns:xsd9="http://www.w3.org/1999/XMLSchema" 760 xmlns:xsd1="http://www.w3.org/2001/XMLSchema" 761 xmlns:xsd0="http://www.w3.org/2000/10/XMLSchema" > 762 <soap:Body> 763 <ns0:echoString xmlns:ns0="http://soapinterop.org/" > 764 <inputString xsi0:type="xsd1:string" xsi1:type="xsd1:string" 765xsi9:type="xsd1:string">Simple Test String</inputString> 766 </ns0:echoString> 767 </soap:Body> 768</soap:Envelope>!); 769 770 ok($deserializer->xmlschema eq 'http://www.w3.org/2001/XMLSchema'); 771} 772 773{ 774 print "SOAP::Fault stringification test(s)...\n"; 775 776 my $f = SOAP::Fault->faultcode('Client.Authenticate') 777 ->faultstring('Bad error'); 778 ok($f eq 'Client.Authenticate: Bad error'); 779} 780 781{ 782 print "Memory leaks test(s)...\n"; # also check 36-leaks.t 783 784 my %calls; 785 { 786 SOAP::Lite->import(trace => [objects => sub { 787 if ((caller(2))[3] =~ /^(.+)::(.+)$/) { 788 $calls{$2}{$1}++; 789 } 790 }]); 791 792 my $soap = SOAP::Lite 793 -> uri("Echo") 794 -> proxy("http://services.soaplite.com/echo.cgi"); 795 } 796 foreach (keys %{$calls{new}}) { 797 ok(exists $calls{DESTROY}{$_}); 798 } 799 800 %calls = (); 801 { 802 local $SOAP::Constants::DO_NOT_USE_XML_PARSER = 1; 803 my $soap = SOAP::Lite 804 -> uri("Echo") 805 -> proxy("http://services.soaplite.com/echo.cgi"); 806 } 807 foreach (keys %{$calls{new}}) { 808 ok(exists $calls{DESTROY}{$_}); 809 } 810 811 SOAP::Lite->import(trace => '-objects'); 812} 813