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