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