Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 245 lines (205 sloc) 8.683 kb
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
1 #!/usr/bin/perl
2
3 # Test the RPC::XML::Client class
4
5 use strict;
e31cca2 @rjray One more patch for Windows compatibility with temp files.
authored
6 use vars qw($dir $vol $srv $child $port $cli $res $flag);
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
7 use subs qw(start_server find_port);
8
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
9 use Test::More;
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
10
0fc63f9 Traced a bug that was causing test failures in 50_client.t to a bug in v...
rjray authored
11 use LWP;
0cad667 Added a test for the spool-to-file loop of the client code.
rjray authored
12 require File::Spec;
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
13
14 require RPC::XML::Server;
15 require RPC::XML::Client;
16
e31cca2 @rjray One more patch for Windows compatibility with temp files.
authored
17 ($vol, $dir, undef) = File::Spec->splitpath(File::Spec->rel2abs($0));
18 $dir = File::Spec->catpath($vol, $dir, '');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
19 require File::Spec->catfile($dir, 'util.pl');
20
343e66b @rjray First round of Devel::Cover-inspired improvements.
authored
21 plan tests => 33;
b3b1df8 @rjray RT #34559: Allow control of LWP::UA timeouts from within client class.
authored
22
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
23 # The organization of the test suites is such that we assume anything that
24 # runs before the current suite is 100%. Thus, no consistency checks on
25 # any other classes are done, only on the data and return values of this
26 # class under consideration, RPC::XML::Client. In this particular case, this
27 # means that we can safely use RPC::XML::Server in creating a suitable test
28 # environment.
29
30 # Start with some very basic things, before actually firing up a live server.
343e66b @rjray First round of Devel::Cover-inspired improvements.
authored
31 $cli = RPC::XML::Client->new();
32 ok(! ref $cli, 'RPC::XML::Client::new without endpoint fails');
33 like($cli, qr/Missing location argument/, 'Correct error message set');
34
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
35 die "No usable port found between 9000 and 10000, skipping"
36 if (($port = find_port) == -1);
37 $cli = RPC::XML::Client->new("http://localhost:$port");
e31cca2 @rjray One more patch for Windows compatibility with temp files.
authored
38 $cli->timeout(5); #to prevent long waiting for non-existing server
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
39 isa_ok($cli, 'RPC::XML::Client', '$cli');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
40
41 # With no server yet at that port, test the failure modes
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
42 ok((! $cli->simple_request('system.identity')) && $RPC::XML::ERROR,
e31cca2 @rjray One more patch for Windows compatibility with temp files.
authored
43 'Calling a server method without a server sets $RPC::XML::ERROR');
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
44 ok(! ref($cli->send_request('system.identity')),
45 'send_request returns a non-ref value when there is no server');
343e66b @rjray First round of Devel::Cover-inspired improvements.
authored
46 $res = $cli->send_request();
47 ok(! ref $res, 'Call to send_request without a method name fails');
48 like($res, qr/No request object/, 'Correct error message set');
49 $res = $cli->send_request('bad^method');
50 ok(! ref $res, 'Call to send_request with a bad method name fails');
51 like($res, qr/Error creating RPC::XML::request object/,
52 'Correct error message set');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
53
54 # Test the error-handling callback
55 $cli->error_handler(sub { $res++ });
56 $res = 0;
57 $cli->simple_request('system.identity');
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
58 ok($res, 'error_handler callback system');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
59
60 # Test clearing it
61 $cli->error_handler(undef);
62 $res = 0;
63 $cli->simple_request('system.identity');
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
64 ok(! $res, 'Clearing the error_handler callback system');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
65
66 # Test setting and clearing both with combined_handler
67 $cli->combined_handler(sub { 1 });
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
68 ok($cli->error_handler() && ($cli->error_handler() eq $cli->fault_handler()),
69 'combined_handler set both error_handler and fault_handler');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
70
71 $cli->combined_handler(undef);
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
72 ok(! ($cli->error_handler() or $cli->fault_handler()),
73 'combined_handler clears both error_handler and fault_handler');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
74
b3b1df8 @rjray RT #34559: Allow control of LWP::UA timeouts from within client class.
authored
75 # Check the getting/setting of the timeout() value on the underlying UA
76 is($cli->timeout(), $cli->useragent->timeout(),
77 'Client timeout() method, fetching');
78 $cli->timeout(60);
79 is($cli->useragent->timeout(), 60, 'Client timeout() method, setting');
80
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
81 # Cool so far. Create and spawn the server.
3dea1e4 Applied a patch from Chris Darroch to make the spawning of servers work ...
rjray authored
82 $srv = RPC::XML::Server->new(host => 'localhost', port => $port);
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
83 die "Failed to create server: $srv, stopped" unless (ref $srv);
84 $child = start_server($srv);
85
86 # NOW, this should work. Also, set $RPC::XML::ERROR to see if it clears
87 $RPC::XML::ERROR = 'foo';
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
88 is($cli->simple_request('system.identity'), $srv->product_tokens,
89 'simple_request/system.identity returns correct value');
90 ok(! $RPC::XML::ERROR,
91 'simple_request/system.identity left $RPC::XML::ERROR empty');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
92
93 # Using send_request should yield an RPC::XML::string object with that value
94 $res = $cli->send_request('system.identity');
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
95 isa_ok($res, 'RPC::XML::string', 'system.identity response');
96 SKIP: {
97 skip 'Client response not a RPC::XML data object', 1
98 unless ref $res;
99 is($res->value, $srv->product_tokens,
100 'system.identity response is correct');
101 }
102
103 unless (ref $res)
104 {
105 # Assume that if an error occurred, the server might be in a confused
106 # state. Kill and restart it.
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
107 stop_server($child);
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
108 $child = start_server($srv);
109 }
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
110
111 # See what comes back from bad (but successful) calls
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
112 $res = $cli->simple_request('system.bad');
113 isa_ok($res, 'HASH', 'simple_request/system.bad response');
114 SKIP: {
115 skip 'Client response was not a RPC::XML data object', 2
116 unless ref $res;
117 is(join(';', sort keys %$res), 'faultCode;faultString',
118 'simple_request/system.bad hashref has correct keys');
119 like($res->{faultString}, qr/Unknown method/,
120 'simple_request/system.bad set correct faultString');
121 }
122
123 unless (ref $res)
124 {
125 # Assume that if an error occurred, the server might be in a confused
126 # state. Kill and restart it.
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
127 stop_server($child);
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
128 $child = start_server($srv);
129 }
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
130
131 # As opposed to a fault object:
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
132 $res = $cli->send_request('system.bad');
133 isa_ok($res, 'RPC::XML::fault', 'send_request/system.bad response');
134 SKIP: {
135 skip 'Client response not a RPC::XML data object', 1
136 unless ref $res;
137 like($res->string, qr/Unknown method/,
138 'send_request/system.bad set correct string() property');
139 }
140
141 unless (ref $res)
142 {
143 # Assume that if an error occurred, the server might be in a confused
144 # state. Kill and restart it.
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
145 stop_server($child);
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
146 $child = start_server($srv);
147 }
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
148
149 # Give the fault handler a whirl -- note the return value is the fault object
150 $cli->fault_handler(sub { $flag++ if ((ref($_[0]) eq 'RPC::XML::fault') &&
151 ($_[0]->string =~ /Unknown method/));
152 $_[0] });
153 $flag = 0;
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
154 $res = $cli->send_request('system.bad');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
155 # Did the callback run correctly?
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
156 ok($flag, 'fault_handler correctly set $flag');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
157 # Is the value returned correct?
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
158 isa_ok($res, 'RPC::XML::fault', 'fault_handler returned value');
159 SKIP: {
160 skip 'Client response not a RPC::XML data object', 1
161 unless ref $res;
162 like($res->string, qr/Unknown method/,
163 'fault_handler object has correct faultString');
164 }
165
166 unless (ref $res)
167 {
168 # Assume that if an error occurred, the server might be in a confused
169 # state. Kill and restart it.
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
170 stop_server($child);
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
171 $child = start_server($srv);
172 }
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
173
174 # Last tests-- is the url() method working?
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
175 like($cli->uri, qr|http://localhost(\.localdomain)?:$port/?|,
176 'RPC::XML::Client::uri method return value is correct');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
177
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
178 # does calling it as an accesor change it at all?
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
179 $cli->uri('http://www.oreilly.com/RPC');
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
180 is($cli->uri, 'http://www.oreilly.com/RPC',
181 'RPC::XML::Client::uri changes as expected');
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
182
0cad667 Added a test for the spool-to-file loop of the client code.
rjray authored
183 # Kill the server long enough to add a new method
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
184 stop_server($child);
0cad667 Added a test for the spool-to-file loop of the client code.
rjray authored
185
186 use Digest::MD5;
187
188 $srv->add_method({ name => 'cmpImg',
189 signature => [ 'boolean base64 base64' ],
190 code => sub {
191 my ($self, $img1, $img2) = @_;
192
193 return (Digest::MD5::md5_hex($img1) eq
194 Digest::MD5::md5_hex($img2));
195 } });
196 $child = start_server($srv);
197
1fe43b7 Changes to the opening of files for base64 data. The existing method did...
rjray authored
198 use Symbol;
199 my ($fh1, $fh2) = (gensym, gensym);
0cad667 Added a test for the spool-to-file loop of the client code.
rjray authored
200
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
201 SKIP: {
202 skip 'Message-to-file spooling broken with LWP < 5.801', 4
203 unless ($LWP::VERSION > 5.800);
204
205 open($fh1, '<' . File::Spec->catfile($dir, 'svsm_text.gif'));
206 open($fh2, '<' . File::Spec->catfile($dir, 'svsm_text.gif'));
207 SKIP: {
208 skip "Error opening svsm_text.gif: $!", 4
209 unless ($fh1 and $fh2);
3dea1e4 Applied a patch from Chris Darroch to make the spawning of servers work ...
rjray authored
210 # Setting the size threshhold to the size of the GIF will guarantee a
211 # file spool, since we're sending the GIF twice.
212 $cli->message_file_thresh(-s $fh1);
213 $cli->message_temp_dir($dir);
214
215 $cli->uri("http://localhost:$port/");
216 $res = $cli->send_request(cmpImg =>
217 RPC::XML::base64->new($fh1),
218 RPC::XML::base64->new($fh2));
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
219 isa_ok($res, 'RPC::XML::boolean', 'cmpImg return value');
220 SKIP: {
221 skip 'Client response not a RPC::XML data object', 1
222 unless ref($res);
223 ok($res->value, 'cmpImg, file spooling, correct return');
224 }
3dea1e4 Applied a patch from Chris Darroch to make the spawning of servers work ...
rjray authored
225
226 # Force the compression threshhold down, to test that branch
227 $cli->compress_requests(1);
228 $cli->compress_thresh(-s $fh1);
229 $res = $cli->send_request(cmpImg =>
230 RPC::XML::base64->new($fh1),
231 RPC::XML::base64->new($fh2));
97d40d3 Test suites armored against server processes that die as a result of cro...
rjray authored
232 isa_ok($res, 'RPC::XML::boolean', 'cmpImg return value');
233 SKIP: {
234 skip 'Client response not a RPC::XML data object', 1
235 unless ref($res);
236 ok($res->value, 'cmpImg, file spooling, correct return');
237 }
0fc63f9 Traced a bug that was causing test failures in 50_client.t to a bug in v...
rjray authored
238 }
0cad667 Added a test for the spool-to-file loop of the client code.
rjray authored
239 }
240
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
241 # Kill the server before exiting
b3f8e94 @rjray RT #47221: Applied a patch from kmx-@-volny.cz, for better Windows testi...
authored
242 stop_server($child);
381f2c0 New test suites. Set 50 is for the client class, and set 60 tests most o...
rjray authored
243
244 exit;
Something went wrong with that request. Please try again.