line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
# ====================================================================== |
2
|
|
|
|
|
|
|
# |
3
|
|
|
|
|
|
|
# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com) |
4
|
|
|
|
|
|
|
# SOAP::Lite is free software; you can redistribute it |
5
|
|
|
|
|
|
|
# and/or modify it under the same terms as Perl itself. |
6
|
|
|
|
|
|
|
# |
7
|
|
|
|
|
|
|
# ====================================================================== |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
package SOAP::Test; |
10
|
|
|
|
|
|
|
|
11
|
11
|
|
|
11
|
|
5105
|
use 5.006; |
|
11
|
|
|
|
|
28
|
|
|
11
|
|
|
|
|
1515
|
|
12
|
|
|
|
|
|
|
our $VERSION = 1.12; |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
our $TIMEOUT = 5; |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
# ====================================================================== |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
package My::PingPong; # we'll use this package in our tests |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
sub new { |
21
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
22
|
0
|
|
0
|
|
|
0
|
my $class = ref($self) || $self; |
23
|
0
|
|
|
|
|
0
|
bless {_num=>shift} => $class; |
24
|
|
|
|
|
|
|
} |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub next { |
27
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
28
|
0
|
|
|
|
|
0
|
$self->{_num}++; |
29
|
|
|
|
|
|
|
} |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
sub value { |
32
|
0
|
|
|
0
|
|
0
|
my $self = shift; |
33
|
0
|
|
|
|
|
0
|
$self->{_num}; |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
# ====================================================================== |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
package SOAP::Test::Server; |
39
|
|
|
|
|
|
|
|
40
|
11
|
|
|
11
|
|
50
|
use strict; |
|
11
|
|
|
|
|
14
|
|
|
11
|
|
|
|
|
320
|
|
41
|
11
|
|
|
11
|
|
4332
|
use Test; |
|
11
|
|
|
|
|
22279
|
|
|
11
|
|
|
|
|
1557
|
|
42
|
11
|
|
|
11
|
|
6487
|
use SOAP::Lite; |
|
11
|
|
|
|
|
27
|
|
|
11
|
|
|
|
|
73
|
|
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub run_for { |
45
|
6
|
50
|
|
6
|
|
70
|
my $proxy = shift or die "Proxy/endpoint is not specified"; |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
# ------------------------------------------------------ |
48
|
6
|
|
|
6
|
|
71
|
my $s = SOAP::Lite->uri('http://something/somewhere')->proxy($proxy)->on_fault(sub{}); |
|
6
|
|
|
|
|
54
|
|
49
|
6
|
|
|
|
|
22
|
eval { $s->transport->timeout($SOAP::Test::TIMEOUT) }; |
|
6
|
|
|
|
|
31
|
|
50
|
6
|
|
|
|
|
147
|
my $r = $s->test_connection; |
51
|
|
|
|
|
|
|
|
52
|
6
|
50
|
33
|
|
|
34
|
unless (defined $r && defined $r->envelope) { |
53
|
6
|
|
|
|
|
30
|
print "1..0 # Skip: ", $s->transport->status, "\n"; |
54
|
6
|
|
|
|
|
82
|
exit; |
55
|
|
|
|
|
|
|
} |
56
|
|
|
|
|
|
|
# ------------------------------------------------------ |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
plan tests => 53; |
59
|
|
|
|
|
|
|
|
60
|
0
|
0
|
|
|
|
|
eval q!use SOAP::Lite on_fault => sub{ref $_[1] ? $_[1] : new SOAP::SOM}; 1! or die; |
61
|
|
|
|
|
|
|
|
62
|
0
|
|
|
|
|
|
print STDERR "Perl SOAP server test(s)...\n"; |
63
|
|
|
|
|
|
|
|
64
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
65
|
|
|
|
|
|
|
-> uri('urn:/My/Examples') |
66
|
|
|
|
|
|
|
-> proxy($proxy); |
67
|
|
|
|
|
|
|
|
68
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->result eq 'Alabama'); |
69
|
0
|
|
|
|
|
|
ok($s->getStateNames(1,4,6,13)->result =~ /^Alabama\s+Arkansas\s+Colorado\s+Illinois\s*$/); |
70
|
|
|
|
|
|
|
|
71
|
0
|
|
|
|
|
|
$r = $s->getStateList([1,2,3,4])->result; |
72
|
0
|
|
0
|
|
|
|
ok(ref $r && $r->[0] eq 'Alabama'); |
73
|
|
|
|
|
|
|
|
74
|
0
|
|
|
|
|
|
$r = $s->getStateStruct({item1 => 1, item2 => 4})->result; |
75
|
0
|
|
0
|
|
|
|
ok(ref $r && $r->{item2} eq 'Arkansas'); |
76
|
0
|
|
|
|
|
|
print $s->transport->status, "\n"; |
77
|
|
|
|
|
|
|
{ |
78
|
0
|
|
|
|
|
|
my $autoresult = $s->autoresult; |
|
0
|
|
|
|
|
|
|
79
|
0
|
|
|
|
|
|
$s->autoresult(1); |
80
|
0
|
|
|
|
|
|
ok($s->getStateName(1) eq 'Alabama'); |
81
|
0
|
|
|
|
|
|
$s->autoresult($autoresult); |
82
|
|
|
|
|
|
|
} |
83
|
|
|
|
|
|
|
|
84
|
0
|
|
|
|
|
|
print STDERR "Autobinding of output parameters test(s)...\n"; |
85
|
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
|
$s->uri('urn:/My/Parameters'); |
87
|
0
|
|
|
|
|
|
my $param1 = 10; |
88
|
0
|
|
|
|
|
|
my $param2 = SOAP::Data->name('myparam' => 12); |
89
|
0
|
|
|
|
|
|
my $result = $s->autobind($param1, $param2)->result; |
90
|
0
|
|
0
|
|
|
|
ok($result == $param1 && $param2->value == 24); |
91
|
|
|
|
|
|
|
|
92
|
0
|
|
|
|
|
|
print STDERR "Header manipulation test(s)...\n"; |
93
|
0
|
|
|
|
|
|
$a = $s->addheader(2, SOAP::Header->name(my => 123)); |
94
|
0
|
|
0
|
|
|
|
ok(ref $a->header && $a->header->{my} eq '123123'); |
95
|
0
|
|
|
|
|
|
ok($a->headers eq '123123'); |
96
|
|
|
|
|
|
|
|
97
|
0
|
|
|
|
|
|
print STDERR "Echo untyped data test(s)...\n"; |
98
|
0
|
|
|
|
|
|
$a = $s->echotwo(11, 12); |
99
|
0
|
|
|
|
|
|
ok($a->result == 11); |
100
|
|
|
|
|
|
|
|
101
|
0
|
|
|
|
|
|
print STDERR "mustUnderstand test(s)...\n"; |
102
|
0
|
|
|
|
|
|
$s->echo(SOAP::Header->name(somethingelse => 123) |
103
|
|
|
|
|
|
|
->mustUnderstand(1)); |
104
|
0
|
|
|
|
|
|
ok($s->call->faultstring =~ /[Hh]eader has mustUnderstand attribute/); |
105
|
|
|
|
|
|
|
|
106
|
0
|
0
|
|
|
|
|
if ($proxy =~ /^http/) { |
107
|
0
|
|
|
|
|
|
ok($s->transport->status =~ /^500/); |
108
|
|
|
|
|
|
|
} else { |
109
|
0
|
|
|
|
|
|
skip('No Status checks for non http protocols on server side' => undef); |
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
0
|
|
|
|
|
|
$s->echo(SOAP::Header->name(somethingelse => 123) |
113
|
|
|
|
|
|
|
->mustUnderstand(1) |
114
|
|
|
|
|
|
|
->actor('http://notme/')); |
115
|
0
|
|
|
|
|
|
ok(!defined $s->call->fault); |
116
|
|
|
|
|
|
|
|
117
|
0
|
|
|
|
|
|
print STDERR "dispatch_from test(s)...\n"; |
118
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite |
119
|
|
|
|
|
|
|
uri => 'http://my.own.site.com/My/Examples', |
120
|
|
|
|
|
|
|
dispatch_from => ['A', 'B'], |
121
|
|
|
|
|
|
|
proxy => '$proxy', |
122
|
|
|
|
|
|
|
; 1" or die; |
123
|
|
|
|
|
|
|
|
124
|
0
|
|
|
|
|
|
eval { C->c }; |
|
0
|
|
|
|
|
|
|
125
|
0
|
|
|
|
|
|
ok($@ =~ /Can't locate object method "c"/); |
126
|
|
|
|
|
|
|
|
127
|
0
|
|
|
|
|
|
eval { A->a }; |
|
0
|
|
|
|
|
|
|
128
|
0
|
|
0
|
|
|
|
ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/); |
129
|
|
|
|
|
|
|
|
130
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite |
131
|
|
|
|
|
|
|
dispatch_from => 'A', |
132
|
|
|
|
|
|
|
uri => 'http://my.own.site.com/My/Examples', |
133
|
|
|
|
|
|
|
proxy => '$proxy', |
134
|
|
|
|
|
|
|
; 1" or die; |
135
|
|
|
|
|
|
|
|
136
|
0
|
|
|
|
|
|
eval { A->a }; |
|
0
|
|
|
|
|
|
|
137
|
0
|
|
0
|
|
|
|
ok(!$@ && SOAP::Lite->self->call->faultstring =~ /Failed to access class \(A\)/); |
138
|
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
print STDERR "Object autobinding and SOAP:: prefix test(s)...\n"; |
140
|
|
|
|
|
|
|
|
141
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite +autodispatch => |
142
|
|
|
|
|
|
|
uri => 'urn:', proxy => '$proxy'; 1" or die; |
143
|
|
|
|
|
|
|
|
144
|
0
|
|
|
|
|
|
ok(SOAP::Lite->autodispatched); |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
eval { SOAP->new(1) }; |
|
0
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
ok($@ =~ /^URI is not specified/); |
148
|
|
|
|
|
|
|
|
149
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite +autodispatch => |
150
|
|
|
|
|
|
|
uri => 'urn:/A/B', proxy => '$proxy'; 1" or die; |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# should call My::PingPong, not A::B |
153
|
0
|
|
|
|
|
|
my $p = My::PingPong->SOAP::new(10); |
154
|
0
|
|
0
|
|
|
|
ok(ref $p && $p->SOAP::next+1 == $p->value); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# forget everything |
157
|
0
|
|
|
|
|
|
SOAP::Lite->self(undef); |
158
|
|
|
|
|
|
|
|
159
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
160
|
|
|
|
|
|
|
-> uri('urn:/My/PingPong') |
161
|
|
|
|
|
|
|
-> proxy($proxy) |
162
|
|
|
|
|
|
|
; |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
# should return object EXACTLY as after My::PingPong->SOAP::new(10) |
165
|
0
|
|
|
|
|
|
$p = $s->SOAP::new(10); |
166
|
0
|
|
0
|
|
|
|
ok(ref $p && $s->SOAP::next($p)+1 == $p->value); |
167
|
|
|
|
|
|
|
|
168
|
0
|
|
|
|
|
|
print STDERR "VersionMismatch test(s)...\n"; |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
{ |
171
|
0
|
|
|
|
|
|
local $SOAP::Constants::NS_ENV = 'http://schemas.xmlsoap.org/new/envelope/'; |
|
0
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $s = SOAP::Lite |
173
|
|
|
|
|
|
|
-> uri('http://my.own.site.com/My/Examples') |
174
|
|
|
|
|
|
|
-> proxy($proxy) |
175
|
0
|
|
|
0
|
|
|
-> on_fault(sub{}) |
176
|
0
|
|
|
|
|
|
; |
177
|
0
|
|
|
|
|
|
$r = $s->dosomething; |
178
|
0
|
|
0
|
|
|
|
ok(ref $r && $r->faultcode =~ /:VersionMismatch/); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
0
|
|
|
|
|
|
print STDERR "Objects-by-reference test(s)...\n"; |
182
|
|
|
|
|
|
|
|
183
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite +autodispatch => |
184
|
|
|
|
|
|
|
uri => 'urn:', proxy => '$proxy'; 1" or die; |
185
|
|
|
|
|
|
|
|
186
|
0
|
|
|
|
|
|
print STDERR "Session iterator\n"; |
187
|
0
|
|
|
|
|
|
$r = My::SessionIterator->new(10); |
188
|
0
|
0
|
0
|
|
|
|
if (!ref $r || exists $r->{id}) { |
189
|
0
|
|
0
|
|
|
|
ok(ref $r && $r->next && $r->next == 11); |
190
|
|
|
|
|
|
|
} else { |
191
|
0
|
|
|
|
|
|
skip('No persistent objects (o-b-r) supported on server side' => undef); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
|
print STDERR "Persistent iterator\n"; |
195
|
0
|
|
|
|
|
|
$r = My::PersistentIterator->new(10); |
196
|
0
|
0
|
0
|
|
|
|
if (!ref $r || exists $r->{id}) { |
197
|
0
|
0
|
|
|
|
|
my $first = ($r->next, $r->next) if ref $r; |
198
|
|
|
|
|
|
|
|
199
|
0
|
|
|
|
|
|
$r = My::PersistentIterator->new(10); |
200
|
0
|
|
0
|
|
|
|
ok(ref $r && $r->next && $r->next == $first+2); |
201
|
|
|
|
|
|
|
} else { |
202
|
0
|
|
|
|
|
|
skip('No persistent objects (o-b-r) supported on server side' => undef); |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
0
|
|
|
|
|
|
{ local $^W; # disable warnings about deprecated AUTOLOADing for nonmethods |
|
0
|
|
|
|
|
|
|
206
|
0
|
|
|
|
|
|
print STDERR "Parameters-by-name test(s)...\n"; |
207
|
0
|
0
|
|
|
|
|
print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W; |
208
|
|
|
|
|
|
|
|
209
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite +autodispatch => |
210
|
|
|
|
|
|
|
uri => 'http://my.own.site.com/My/Parameters', proxy => '$proxy'; 1" or die; |
211
|
|
|
|
|
|
|
|
212
|
0
|
|
|
|
|
|
my @parameters = ( |
213
|
|
|
|
|
|
|
SOAP::Data->name(b => 222), |
214
|
|
|
|
|
|
|
SOAP::Data->name(c => 333), |
215
|
|
|
|
|
|
|
SOAP::Data->name(a => 111) |
216
|
|
|
|
|
|
|
); |
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
# switch to 'main' package, because nonqualified methods should be there |
219
|
0
|
|
|
|
|
|
ok(main::byname(@parameters) eq "a=111, b=222, c=333"); |
220
|
|
|
|
|
|
|
|
221
|
0
|
|
|
|
|
|
ok(main::bynameororder(@parameters) eq "a=111, b=222, c=333"); |
222
|
|
|
|
|
|
|
|
223
|
0
|
|
|
|
|
|
ok(main::bynameororder(111, 222, 333) eq "a=111, b=222, c=333"); |
224
|
|
|
|
|
|
|
|
225
|
0
|
|
|
|
|
|
print STDERR "Function call test(s)...\n"; |
226
|
0
|
0
|
|
|
|
|
print STDERR "You can see warning about AUTOLOAD for non-method...\n" if $^W; |
227
|
0
|
|
|
|
|
|
ok(main::echo(11) == 11); |
228
|
|
|
|
|
|
|
} |
229
|
|
|
|
|
|
|
|
230
|
0
|
|
|
|
|
|
print STDERR "SOAPAction test(s)...\n"; |
231
|
0
|
0
|
|
|
|
|
if ($proxy =~ /^tcp:/) { |
232
|
0
|
|
|
|
|
|
for (1..2) {skip('No SOAPAction checks for tcp: protocol on server side' => undef)} |
|
0
|
|
|
|
|
|
|
233
|
|
|
|
|
|
|
} else { |
234
|
0
|
|
|
0
|
|
|
my $s = SOAP::Lite |
235
|
|
|
|
|
|
|
-> uri('http://my.own.site.com/My/Examples') |
236
|
|
|
|
|
|
|
-> proxy($proxy) |
237
|
|
|
|
|
|
|
-> on_action(sub{'""'}) |
238
|
0
|
|
|
|
|
|
; |
239
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->result eq 'Alabama'); |
240
|
|
|
|
|
|
|
|
241
|
0
|
|
|
0
|
|
|
$s->on_action(sub{'"wrong_SOAPAction_here"'}); |
|
0
|
|
|
|
|
|
|
242
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->faultstring =~ /SOAPAction shall match/); |
243
|
|
|
|
|
|
|
} |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
print STDERR "UTF8 test(s)...\n"; |
246
|
0
|
0
|
|
|
|
|
if (!eval "pack('U*', 0)") { |
247
|
0
|
|
|
|
|
|
for (1) {skip('No UTF8 test. No support for pack("U*") modifier' => undef)} |
|
0
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
} else { |
249
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
250
|
|
|
|
|
|
|
-> uri('http://my.own.site.com/My/Parameters') |
251
|
|
|
|
|
|
|
-> proxy($proxy); |
252
|
|
|
|
|
|
|
|
253
|
0
|
|
|
|
|
|
my $latin1 = '�ਢ��'; |
254
|
0
|
|
|
|
|
|
my $utf8 = pack('U*', unpack('C*', $latin1)); |
255
|
0
|
|
|
|
|
|
my $result = $s->echo(SOAP::Data->type(string => $utf8))->result; |
256
|
|
|
|
|
|
|
|
257
|
0
|
|
0
|
|
|
|
ok(pack('U*', unpack('C*', $result)) eq $utf8 # should work where XML::Parser marks resulting strings as UTF-8 |
258
|
|
|
|
|
|
|
|| join('', unpack('C*', $result)) eq join('', unpack('C*', $utf8)) # should work where it doesn't |
259
|
|
|
|
|
|
|
); |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
{ |
263
|
0
|
|
|
|
|
|
my $on_fault_was_called = 0; |
|
0
|
|
|
|
|
|
|
264
|
0
|
|
|
|
|
|
print STDERR "Die in server method test(s)...\n"; |
265
|
0
|
|
|
0
|
|
|
my $s = SOAP::Lite |
266
|
|
|
|
|
|
|
-> uri('http://my.own.site.com/My/Parameters') |
267
|
|
|
|
|
|
|
-> proxy($proxy) |
268
|
0
|
|
|
|
|
|
-> on_fault(sub{$on_fault_was_called++;return}) |
269
|
0
|
|
|
|
|
|
; |
270
|
0
|
|
|
|
|
|
ok($s->die_simply()->faultstring =~ /Something bad/); |
271
|
0
|
|
|
|
|
|
ok($on_fault_was_called > 0); |
272
|
0
|
|
|
|
|
|
my $detail = $s->die_with_object()->dataof(SOAP::SOM::faultdetail . '/[1]'); |
273
|
0
|
|
|
|
|
|
ok($on_fault_was_called > 1); |
274
|
0
|
|
0
|
|
|
|
ok(ref $detail && $detail->name =~ /(^|:)something$/); |
275
|
|
|
|
|
|
|
|
276
|
|
|
|
|
|
|
# get Fault as hash of subelements |
277
|
0
|
|
|
|
|
|
my $fault = $s->die_with_fault()->fault; |
278
|
0
|
|
|
|
|
|
ok($fault->{faultcode} =~ ':Server.Custom'); |
279
|
0
|
|
|
|
|
|
ok($fault->{faultstring} eq 'Died in server method'); |
280
|
0
|
|
|
|
|
|
ok(ref $fault->{detail}->{BadError} eq 'BadError'); |
281
|
0
|
|
|
|
|
|
ok($fault->{faultactor} eq 'http://www.soaplite.com/custom'); |
282
|
|
|
|
|
|
|
} |
283
|
|
|
|
|
|
|
|
284
|
0
|
|
|
|
|
|
print STDERR "Method with attributes test(s)...\n"; |
285
|
|
|
|
|
|
|
|
286
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
287
|
|
|
|
|
|
|
-> uri('urn:/My/Examples') |
288
|
|
|
|
|
|
|
-> proxy($proxy) |
289
|
|
|
|
|
|
|
; |
290
|
|
|
|
|
|
|
|
291
|
0
|
|
|
|
|
|
ok($s->call(SOAP::Data->name('getStateName')->attr({xmlns => 'urn:/My/Examples'}), 1)->result eq 'Alabama'); |
292
|
|
|
|
|
|
|
|
293
|
0
|
|
|
|
|
|
print STDERR "Call with empty uri test(s)...\n"; |
294
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
295
|
|
|
|
|
|
|
-> uri('') |
296
|
|
|
|
|
|
|
-> proxy($proxy) |
297
|
|
|
|
|
|
|
; |
298
|
|
|
|
|
|
|
|
299
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/); |
300
|
|
|
|
|
|
|
|
301
|
0
|
|
|
|
|
|
ok($s->call('a:getStateName' => 1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/); |
302
|
|
|
|
|
|
|
|
303
|
0
|
|
|
|
|
|
print STDERR "Number of parameters test(s)...\n"; |
304
|
|
|
|
|
|
|
|
305
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
306
|
|
|
|
|
|
|
-> uri('http://my.own.site.com/My/Parameters') |
307
|
|
|
|
|
|
|
-> proxy($proxy) |
308
|
|
|
|
|
|
|
; |
309
|
0
|
|
|
|
|
|
{ my @all = $s->echo->paramsall; ok(@all == 0) } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
310
|
0
|
|
|
|
|
|
{ my @all = $s->echo(1)->paramsall; ok(@all == 1) } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
311
|
0
|
|
|
|
|
|
{ my @all = $s->echo((1) x 10)->paramsall; ok(@all == 10) } |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
312
|
|
|
|
|
|
|
|
313
|
0
|
|
|
|
|
|
print STDERR "Memory refresh test(s)...\n"; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
# Funny test. |
316
|
|
|
|
|
|
|
# Let's forget about ALL settings we did before with 'use SOAP::Lite...' |
317
|
0
|
|
|
|
|
|
SOAP::Lite->self(undef); |
318
|
0
|
|
|
|
|
|
ok(!defined SOAP::Lite->self); |
319
|
|
|
|
|
|
|
|
320
|
0
|
|
|
|
|
|
print STDERR "Call without uri test(s)...\n"; |
321
|
0
|
|
|
|
|
|
$s = SOAP::Lite |
322
|
|
|
|
|
|
|
-> proxy($proxy) |
323
|
|
|
|
|
|
|
; |
324
|
|
|
|
|
|
|
|
325
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->faultstring =~ /Denied access to method \(getStateName\) in class \(main\)/); |
326
|
|
|
|
|
|
|
|
327
|
0
|
|
|
|
|
|
print STDERR "Different settings for method and namespace test(s)...\n"; |
328
|
|
|
|
|
|
|
|
329
|
0
|
|
|
|
|
|
ok($s->call(SOAP::Data |
330
|
|
|
|
|
|
|
->name('getStateName') |
331
|
|
|
|
|
|
|
->attr({xmlns => 'urn:/My/Examples'}), 1)->result eq 'Alabama'); |
332
|
|
|
|
|
|
|
|
333
|
0
|
|
|
|
|
|
ok($s->call(SOAP::Data |
334
|
|
|
|
|
|
|
->name('a:getStateName') |
335
|
|
|
|
|
|
|
->uri('urn:/My/Examples'), 1)->result eq 'Alabama'); |
336
|
|
|
|
|
|
|
|
337
|
0
|
|
|
|
|
|
ok($s->call(SOAP::Data |
338
|
|
|
|
|
|
|
->name('getStateName') |
339
|
|
|
|
|
|
|
->uri('urn:/My/Examples'), 1)->result eq 'Alabama'); |
340
|
|
|
|
|
|
|
|
341
|
0
|
|
|
|
|
|
ok($s->call(SOAP::Data |
342
|
|
|
|
|
|
|
->name('a:getStateName') |
343
|
|
|
|
|
|
|
->attr({'xmlns:a' => 'urn:/My/Examples'}), 1)->result eq 'Alabama'); |
344
|
|
|
|
|
|
|
|
345
|
0
|
|
|
|
|
|
eval { $s->call(SOAP::Data->name('a:getStateName')) }; |
|
0
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
|
347
|
0
|
|
|
|
|
|
ok($@ =~ /Can't find namespace for method \(a:getStateName\)/); |
348
|
|
|
|
|
|
|
|
349
|
0
|
|
|
|
|
|
$s->serializer->namespaces->{'urn:/My/Examples'} = ''; |
350
|
|
|
|
|
|
|
|
351
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->result eq 'Alabama'); |
352
|
|
|
|
|
|
|
|
353
|
0
|
0
|
|
|
|
|
eval "use SOAP::Lite |
354
|
|
|
|
|
|
|
uri => 'urn:/My/Examples', proxy => '$proxy'; 1" or die; |
355
|
|
|
|
|
|
|
|
356
|
0
|
|
|
|
|
|
print STDERR "Global settings test(s)...\n"; |
357
|
0
|
|
|
|
|
|
$s = new SOAP::Lite; |
358
|
|
|
|
|
|
|
|
359
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->result eq 'Alabama'); |
360
|
|
|
|
|
|
|
|
361
|
0
|
0
|
|
0
|
|
|
SOAP::Trace->import(transport => |
362
|
|
|
|
|
|
|
sub {$_[0]->content_type('something/wrong') if UNIVERSAL::isa($_[0] => 'HTTP::Request')} |
363
|
0
|
|
|
|
|
|
); |
364
|
|
|
|
|
|
|
|
365
|
0
|
0
|
|
|
|
|
if ($proxy =~ /^tcp:/) { |
366
|
0
|
|
|
|
|
|
skip('No Content-Type checks for tcp: protocol on server side' => undef); |
367
|
|
|
|
|
|
|
} else { |
368
|
0
|
|
|
|
|
|
ok($s->getStateName(1)->faultstring =~ /Content-Type must be/); |
369
|
|
|
|
|
|
|
} |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
|
372
|
|
|
|
|
|
|
# ====================================================================== |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
1; |
375
|
|
|
|
|
|
|
|
376
|
|
|
|
|
|
|
__END__ |