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 => 32 }
14
15use SOAP::Lite;
16
17my($a, $s, $r, $serialized, $deserialized);
18
19my %tests = (
20    'XML only' => <<'EOM',
21<?xml version="1.0" encoding="UTF-8"?>
22<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
23                   soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
24                   xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
25                   xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
26                   xmlns:xsd="http://www.w3.org/1999/XMLSchema">
27<soap:Body>
28<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
29  <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
30  <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
31</namesp1:add>
32</soap:Body>
33</soap:Envelope>
34EOM
35
36    'message with headers' => <<'EOM',
37Content-Type: text/xml
38
39<?xml version="1.0" encoding="UTF-8"?>
40<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
41                   soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
42                   xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
43                   xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
44                   xmlns:xsd="http://www.w3.org/1999/XMLSchema">
45<soap:Body>
46<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
47  <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
48  <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
49</namesp1:add>
50</soap:Body>
51</soap:Envelope>
52EOM
53
54    'singlepart MIME' => <<'EOM',
55Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
56
57--MIME_boundary
58Content-Type: text/xml; charset=UTF-8
59Content-Transfer-Encoding: 8bit
60Content-ID: <calc061400a.xml@soaplite.com>
61
62<?xml version="1.0" encoding="UTF-8"?>
63<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
64                   soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
65                   xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
66                   xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
67                   xmlns:xsd="http://www.w3.org/1999/XMLSchema">
68<soap:Body>
69<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
70  <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
71  <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
72</namesp1:add>
73</soap:Body>
74</soap:Envelope>
75
76--MIME_boundary--
77EOM
78
79    'multipart MIME' => <<'EOM',
80Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
81
82--MIME_boundary
83Content-Type: text/xml; charset=UTF-8
84Content-Transfer-Encoding: 8bit
85Content-ID: <calc061400a.xml@soaplite.com>
86
87<?xml version="1.0" encoding="UTF-8"?>
88<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
89                   soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
90                   xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
91                   xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
92                   xmlns:xsd="http://www.w3.org/1999/XMLSchema">
93<soap:Body>
94<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
95  <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
96  <c-gensym7 xsi:type="xsd:int">5</c-gensym7>
97</namesp1:add>
98</soap:Body>
99</soap:Envelope>
100
101--MIME_boundary
102Content-Type: text/plain
103Content-Transfer-Encoding: binary
104Content-ID: <calc061400a.a@soaplite.com>
105
1062
107--MIME_boundary
108Content-Type: text/plain
109Content-Transfer-Encoding: binary
110Content-ID: <calc061400a.b@soaplite.com>
111
1125
113--MIME_boundary--
114EOM
115
116    'multipart MIME w/multiref' => <<'EOM',
117Content-Type: Multipart/Related; boundary=MIME_boundary; type="text/xml"; start="<calc061400a.xml@soaplite.com>"
118
119--MIME_boundary
120Content-Type: text/xml; charset=UTF-8
121Content-Transfer-Encoding: 8bit
122Content-ID: <calc061400a.xml@soaplite.com>
123
124<?xml version="1.0" encoding="UTF-8"?>
125<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
126                   soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
127                   xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
128                   xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
129                   xmlns:xsd="http://www.w3.org/1999/XMLSchema">
130<soap:Body>
131<namesp1:add xmlns:namesp1="http://www.soaplite.com/Calculator">
132  <c-gensym5 href="cid:calc061400a.a@soaplite.com"/>
133  <c-gensym7 href="cid:calc061400a.b@soaplite.com"/>
134</namesp1:add>
135</soap:Body>
136</soap:Envelope>
137
138--MIME_boundary
139Content-Type: text/plain
140Content-Transfer-Encoding: binary
141Content-ID: <calc061400a.a@soaplite.com>
142
1432
144--MIME_boundary
145Content-Type: text/plain
146Content-Transfer-Encoding: binary
147Content-ID: <calc061400a.b@soaplite.com>
148
1495
150--MIME_boundary--
151EOM
152);
153
154eval "SOAP::Packager::MIME->new->initialize_parser();";
155my $is_mimetools_installed = ($@) ? 0 : 1;
156
157(my $reason = $@) =~ s/ at .+// unless $is_mimetools_installed;
158
159print "MIME tests will be skipped: $reason" if defined $reason;
160my $package = '
161    package Calculator;
162    sub new { bless {} => ref($_[0]) || $_[0] }
163    sub add { $_[1] + $_[2] }
164    sub schema { $SOAP::Constants::DEFAULT_XML_SCHEMA }
1651;';
166
167# TEST 1-4
168HANDLER: {
169    print "Server handler test(s)...\n";
170
171    my $server = SOAP::Server->dispatch_to('Calculator');
172
173    SKIP: for (reverse sort keys %tests) {
174        #print $_, "\n";
175        my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
176        skip(1, 'skip')
177            if ($_ =~m/XML/ || !$is_mimetools_installed)
178                || ($result->faultstring || '') =~ /Failed to access class \(Calculator\)/;
179        #print $result->faultstring;
180        #print "SKIP\n";
181    }
182    eval $package or die;
183
184    SKIP: for (reverse sort keys %tests) {
185        my $result = SOAP::Deserializer->deserialize($server->handle($tests{$_}));
186        if ($_ =~m/XML/ || !$is_mimetools_installed) {
187            skip(1, 'skip');
188            next SKIP;
189        }
190        ok (($result->result || 0) == 7);
191    }
192}
193
194{
195    print "Server handler with complex dispatches test(s)...\n";
196    foreach my $server (
197        # dispatch to class
198        SOAP::Server->dispatch_to('Calculator'),
199
200        # dispatch to object
201        SOAP::Server->dispatch_to(Calculator->new),
202
203        # dispatch to regexp
204        SOAP::Server->dispatch_to('Calc\w+'),
205
206        # dispatch URI to class
207        SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => 'Calculator'}),
208
209        # dispatch URI to object
210        SOAP::Server->dispatch_with({'http://www.soaplite.com/Calculator' => Calculator->new}),
211
212        # dispatch quoted SOAPAction to class
213        SOAP::Server->action('"http://action/#method"')
214            ->dispatch_with({'http://action/#method' => 'Calculator'}),
215
216        # dispatch non-quoted SOAPAction to class
217        SOAP::Server->action('http://action/#method')
218            ->dispatch_with({'http://action/#method' => 'Calculator'}),
219
220        # dispatch to class and BAD regexp.
221        SOAP::Server->dispatch_to('\protocols', 'Calculator')
222    ) { # end for
223        my $result = SOAP::Deserializer->deserialize($server->handle($tests{'XML only'}));
224        my $value = $result->result;
225use Data::Dumper;		print Dumper $value;
226		ok($value + 0 == 7);
227    }
228}
229
230{
231    print "Error handling in server test(s)...\n";
232
233    $a = SOAP::Server->handle('<a></a>');
234    ok($a =~ /Can't find root/);
235
236    $a = SOAP::Server->handle('<Envelope></Envelope>');
237    ok($a =~ /Can't find method/);
238
239    $a = SOAP::Server->handle('<Envelope><Body><Add><a>1</a><b>1</b></Add></Body></Envelope>');
240    ok($a =~m{Denied \s access \s to \s method}x);
241
242    $a = SOAP::Server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
243        soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
244        xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
245        xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
246        xmlns:xsd="http://www.w3.org/1999/XMLSchema">
247        <soap:Body></soap:Body></soap:Envelope>');
248    ok($a =~ /Can't find method/);
249}
250
251{
252    print "Envelope with no namespaces test(s)...\n";
253
254    eval 'sub add { $_[1] + $_[2] }; 1' or die;
255
256    my $result = SOAP::Deserializer->deserialize(SOAP::Server->dispatch_to('add')->handle('<Envelope><Body><add><a>3</a><b>4</b></add></Body></Envelope>'));
257    ok(($result->result || 0) == 7);
258}
259
260{
261    print "Different XML Schemas test(s)...\n";
262
263    my $server = SOAP::Server->dispatch_to('Calculator');
264    $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
265        soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
266        xmlns:xsi="http://www.w3.org/1999/XMLSchema-instance"
267        xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
268        xmlns:xsd="http://www.w3.org/1999/XMLSchema">
269        <soap:Body>
270            <namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator"/>
271        </soap:Body></soap:Envelope>');
272
273    ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
274    ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
275    ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
276
277    $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
278        soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
279        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
280        xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
281        xmlns:xsd="http://www.w3.org/2001/XMLSchema">
282        <soap:Body>
283            <namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
284                <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
285            </namesp1:schema>
286        </soap:Body></soap:Envelope>');
287
288    ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
289    ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
290    ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
291
292    $a = $server->handle('<soap:Envelope xmlns:soapenc="http://schemas.xmlsoap.org/soap/encoding/"
293        soap:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/"
294        xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance"
295        xmlns:soap="http://schemas.xmlsoap.org/soap/envelope/"
296        xmlns:xsd="http://www.w3.org/2001/XMLSchema">
297        <soap:Body>
298            <namesp1:schema xmlns:namesp1="http://www.soaplite.com/Calculator">
299                <c-gensym5 xsi:type="xsd:int">2</c-gensym5>
300            </namesp1:schema>
301        </soap:Body></soap:Envelope>');
302
303    ok($a =~ m!xsi="http://www.w3.org/2001/XMLSchema-instance"!);
304    ok($a =~ m!xsd="http://www.w3.org/2001/XMLSchema"!);
305    ok($a =~ m!>http://www.w3.org/2001/XMLSchema<!);
306}
307