| 1 | #!/usr/bin/perl |
1 | #!/usr/bin/perl |
| 2 | BEGIN { |
2 | BEGIN { |
| 3 | my $server_pid; |
3 | unless ($ENV{PERL_ANYEVENT_DBI_TESTS}) { |
|
|
4 | print "1..0 # SKIP env var PERL_ANYEVENT_DBI_TESTS not set\n"; exit; |
|
|
5 | } |
|
|
6 | } |
|
|
7 | |
|
|
8 | BEGIN { |
| 4 | eval { |
9 | eval { |
| 5 | require DBIx::MyServer; |
10 | require DBIx::MyServer; |
| 6 | require DBIx::MyServer::DBI; |
11 | require DBIx::MyServer::DBI; |
| 7 | }; |
12 | }; |
| 8 | if ($@) { |
13 | if ($@) { |
| … | |
… | |
| 10 | import Test::More skip_all => 'these tests require DBIx::MyServer'; |
15 | import Test::More skip_all => 'these tests require DBIx::MyServer'; |
| 11 | exit 0; |
16 | exit 0; |
| 12 | } |
17 | } |
| 13 | } |
18 | } |
| 14 | |
19 | |
|
|
20 | no warnings; |
| 15 | use List::Util qw( sum ); |
21 | use List::Util qw(sum); |
| 16 | use Cwd qw( abs_path ); |
22 | use Cwd qw(abs_path); |
| 17 | use File::Basename qw( dirname ); |
23 | use File::Basename qw(dirname); |
|
|
24 | |
| 18 | use AnyEvent::DBI; |
25 | use AnyEvent::DBI; |
|
|
26 | |
| 19 | my $topdir = dirname(abs_path($0)); |
27 | my $topdir = dirname abs_path $0; |
| 20 | |
28 | |
| 21 | # fork off a child to be a mysql server |
29 | # fork off a child to be a mysql server |
| 22 | my $server_pid = fork; |
30 | my $server_pid = fork; |
| 23 | if (! $server_pid ) { |
31 | unless ($server_pid) { |
| 24 | exec "$^X $topdir/fake-mysql --config $topdir/myserver.conf"; |
32 | exec "$^X $topdir/fake-mysql --config $topdir/myserver.conf"; |
| 25 | die 'exec failed'; |
33 | die 'exec failed'; |
| 26 | } |
34 | } |
| 27 | |
35 | |
| 28 | # the parent is the test script |
36 | # the parent is the test script |
| 29 | eval { |
37 | eval { |
| 30 | require Test::More; |
38 | require Test::More; |
|
|
39 | #d#import Test::More tests => 34; |
| 31 | import Test::More tests => 34; |
40 | import Test::More tests => 33; |
| 32 | }; |
41 | }; |
| 33 | if ($@) { |
42 | if ($@) { |
| 34 | print 'ok 1 # skip this test requires Test::More'."\n"; |
43 | print 'ok 1 # skip this test requires Test::More'."\n"; |
| 35 | exit 0; |
44 | exit 0; |
| 36 | } |
45 | } |
| … | |
… | |
| 42 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
51 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
| 43 | PrintError => 0, |
52 | PrintError => 0, |
| 44 | timeout => 2, |
53 | timeout => 2, |
| 45 | on_error => sub { }, |
54 | on_error => sub { }, |
| 46 | on_connect => sub { |
55 | on_connect => sub { |
| 47 | if (! $_[0]) { |
56 | if (!$_[1]) { |
| 48 | $cv->send($@); |
57 | $cv->send($@); |
| 49 | } |
|
|
| 50 | else { |
58 | } else { |
| 51 | $cv->send(); |
59 | $cv->send(); |
| 52 | } |
60 | } |
| 53 | }, |
61 | }, |
| 54 | ); |
62 | ); |
| 55 | my $connect_error = $cv->recv(); |
63 | my $connect_error = $cv->recv(); |
| … | |
… | |
| 76 | |
84 | |
| 77 | # issue a query that returns an error |
85 | # issue a query that returns an error |
| 78 | $cv = AnyEvent->condvar; |
86 | $cv = AnyEvent->condvar; |
| 79 | $dbh->exec ( |
87 | $dbh->exec ( |
| 80 | "select a,b,c from nosuchtable", sub { |
88 | "select a,b,c from nosuchtable", sub { |
| 81 | my ($dbh,$rows, $metadata) = @_; |
89 | my ($dbh, $rows, $metadata) = @_; |
| 82 | if (! $dbh) { |
90 | if (!$rows) { |
| 83 | $cv->send($@); |
91 | $cv->send($@); |
| 84 | } |
|
|
| 85 | else { |
92 | } else { |
| 86 | $cv->send(undef,$rows); |
93 | $cv->send(undef,$rows); |
| 87 | } |
94 | } |
| 88 | } |
95 | } |
| 89 | ); |
96 | ); |
| 90 | ($error, $rows) = $cv->recv(); |
97 | ($error, $rows) = $cv->recv(); |
| 91 | is($error,qq{Table 'database.nosuchtable' doesn't exist},'SELECT on non-existant table returns NONFATAL error'); |
98 | is($error,qq{Table 'database.nosuchtable' doesn't exist},"SELECT on non-existant table returns NONFATAL error"); |
| 92 | |
99 | |
| 93 | # good query after bad |
100 | # good query after bad |
| 94 | $cv = AnyEvent->condvar; |
101 | $cv = AnyEvent->condvar; |
| 95 | $dbh->exec ( |
102 | $dbh->exec ( |
| 96 | "select a,b,c from rows14 where num=?", 10, sub { |
103 | "select a,b,c from rows14 where num=?", 10, sub { |
| 97 | my ($dbh,$rows, $metadata) = @_; |
104 | my ($dbh,$rows, $metadata) = @_; |
| 98 | if (! $dbh) { |
105 | if (!$rows) { |
| 99 | $cv->send($@); |
106 | $cv->send($@); |
| 100 | } |
|
|
| 101 | else { |
107 | } else { |
| 102 | $cv->send(undef,$rows); |
108 | $cv->send(undef,$rows); |
| 103 | } |
109 | } |
| 104 | } |
110 | } |
| 105 | ); |
111 | ); |
| 106 | ($error, $rows) = $cv->recv(); |
112 | ($error, $rows) = $cv->recv(); |
| … | |
… | |
| 115 | my @results = (); |
121 | my @results = (); |
| 116 | my $num_qry = 0; |
122 | my $num_qry = 0; |
| 117 | my $qrydone = sub { |
123 | my $qrydone = sub { |
| 118 | my ($dbh,$rows,$metadata) = @_; |
124 | my ($dbh,$rows,$metadata) = @_; |
| 119 | my $err = undef; |
125 | my $err = undef; |
| 120 | if (! $dbh) { |
126 | if (!$rows) { |
| 121 | $err = $@; |
127 | $err = $@; |
| 122 | } |
128 | } |
| 123 | push @results , [$err,$rows]; |
129 | push @results , [$err,$rows]; |
| 124 | if (scalar @results == $num_qry) { |
130 | if (scalar @results == $num_qry) { |
| 125 | $cv->send(); |
131 | $cv->send(); |
| … | |
… | |
| 139 | for my $r (0..$num_qry-1) { |
145 | for my $r (0..$num_qry-1) { |
| 140 | my $offset = int($r / 2 )+1; |
146 | my $offset = int($r / 2 )+1; |
| 141 | if ($r % 2) { |
147 | if ($r % 2) { |
| 142 | ok(! defined $results[$r]->[0],'Multi Query Queue: No error on good queries'); |
148 | ok(! defined $results[$r]->[0],'Multi Query Queue: No error on good queries'); |
| 143 | is(scalar @{$results[$r]->[1]},$offset,'Multi Query Queue: Good query got right number of rows'); |
149 | is(scalar @{$results[$r]->[1]},$offset,'Multi Query Queue: Good query got right number of rows'); |
| 144 | } |
|
|
| 145 | else { |
150 | } else { |
| 146 | is( |
151 | is( |
| 147 | $results[$r]->[0], |
152 | $results[$r]->[0], |
| 148 | qq{Table 'database.nosuchtable$offset' doesn't exist},'Multi Query Queue: Bad query gets correct error' |
153 | qq{Table 'database.nosuchtable$offset' doesn't exist},'Multi Query Queue: Bad query gets correct error' |
| 149 | ); |
154 | ); |
| 150 | } |
155 | } |
| … | |
… | |
| 159 | "dbi:mysql:database=test;host=127.0.0.1;port=9",'','', |
164 | "dbi:mysql:database=test;host=127.0.0.1;port=9",'','', |
| 160 | PrintError => 0, |
165 | PrintError => 0, |
| 161 | timeout => 3, |
166 | timeout => 3, |
| 162 | on_error => sub { }, |
167 | on_error => sub { }, |
| 163 | on_connect => sub { |
168 | on_connect => sub { |
| 164 | if (! $_[0]) { |
169 | if (!$_[1]) { |
| 165 | $cv->send($@); |
170 | $cv->send($@); |
| 166 | } |
171 | } |
| 167 | else { |
172 | else { |
| 168 | $cv->send(); |
173 | $cv->send(); |
| 169 | } |
174 | } |
| … | |
… | |
| 177 | $dbh2 = new AnyEvent::DBI( |
182 | $dbh2 = new AnyEvent::DBI( |
| 178 | "dbi:mysql:database=test;host=www.google.com;port=23306",'','', |
183 | "dbi:mysql:database=test;host=www.google.com;port=23306",'','', |
| 179 | timeout => 3, |
184 | timeout => 3, |
| 180 | on_error => sub { }, |
185 | on_error => sub { }, |
| 181 | on_connect => sub { |
186 | on_connect => sub { |
| 182 | if (! $_[0]) { |
187 | if (!$_[1]) { |
| 183 | $cv->send($@); |
188 | $cv->send($@); |
| 184 | } |
189 | } |
| 185 | else { |
190 | else { |
| 186 | $cv->send(); |
191 | $cv->send(); |
| 187 | } |
192 | } |
| 188 | }, |
193 | }, |
| 189 | ); |
194 | ); |
| 190 | $connect_error = $cv->recv(); |
195 | $connect_error = $cv->recv(); |
| 191 | is($connect_error,'TIMEOUT','mysql connect to google port 23306 times out'); |
196 | is($connect_error,'timeout','mysql connect to google port 23306 times out'); |
| 192 | undef $dbh2; |
197 | undef $dbh2; |
| 193 | |
198 | |
| 194 | # issue a query which times out |
199 | # issue a query which times out |
| 195 | $cv = AnyEvent->condvar; |
200 | $cv = AnyEvent->condvar; |
| 196 | $dbh->exec ( |
201 | $dbh->exec ( |
| 197 | "select a,b,c from delay10 where num=?", 10, sub { |
202 | "select a,b,c from delay10 where num=?", 10, sub { |
| 198 | my ($dbh,$rows, $metadata) = @_; |
203 | my ($dbh,$rows, $metadata) = @_; |
| 199 | if (! $dbh) { |
204 | if (! $rows) { |
| 200 | $cv->send($@); |
205 | $cv->send($@); |
| 201 | } |
206 | } |
| 202 | else { |
207 | else { |
| 203 | $cv->send(undef,$rows); |
208 | $cv->send(undef,$rows); |
| 204 | } |
209 | } |
| 205 | } |
210 | } |
| 206 | ); |
211 | ); |
| 207 | ($error,$rows) = $cv->recv(); |
212 | ($error,$rows) = $cv->recv(); |
| 208 | is($error,'TIMEOUT','timeout fires during long-running query'); |
213 | is($error,'timeout','timeout fires during long-running query'); |
| 209 | |
214 | |
| 210 | # issue a query after a fatal timeout error |
215 | # issue a query after a fatal timeout error |
| 211 | $cv = AnyEvent->condvar; |
216 | $cv = AnyEvent->condvar; |
| 212 | my $start = AnyEvent->now; |
217 | my $start = AnyEvent->now; |
| 213 | my $run = 10; |
218 | my $run = 10; |
| … | |
… | |
| 216 | my $errs = []; |
221 | my $errs = []; |
| 217 | while ($ran++ < $run) { |
222 | while ($ran++ < $run) { |
| 218 | $dbh->exec ( |
223 | $dbh->exec ( |
| 219 | "select d,e,f,g from rows5 where num=?", 10, sub { |
224 | "select d,e,f,g from rows5 where num=?", 10, sub { |
| 220 | my ($dbh,$rows, $metadata) = @_; |
225 | my ($dbh,$rows, $metadata) = @_; |
| 221 | if (! $dbh) { |
226 | if (!$rows) { |
| 222 | push @$errs, $@; |
227 | push @$errs, $@; |
| 223 | } |
228 | } |
| 224 | if (++$fin == $run) { |
229 | if (++$fin == $run) { |
| 225 | $cv->send(); |
230 | $cv->send(); |
| 226 | } |
231 | } |
| … | |
… | |
| 228 | ); |
233 | ); |
| 229 | } |
234 | } |
| 230 | $cv->recv(); |
235 | $cv->recv(); |
| 231 | ok(AnyEvent->now -$start < 0.0001,'invalid db handle returns from multiple queries immediately'); |
236 | ok(AnyEvent->now -$start < 0.0001,'invalid db handle returns from multiple queries immediately'); |
| 232 | is (scalar @$errs, 10, 'invalid db handle returned error for all enqueued queries'); |
237 | is (scalar @$errs, 10, 'invalid db handle returned error for all enqueued queries'); |
| 233 | is($errs->[0],'NO DATABASE CONNECTION','invalid db handle returns correct error'); |
238 | is($errs->[0],'no database connection','invalid db handle returns correct error'); |
| 234 | undef $dbh; |
239 | undef $dbh; |
| 235 | |
240 | |
| 236 | # check for server process leakage |
241 | # check for server process leakage |
| 237 | eval { |
242 | eval { |
| 238 | require Proc::Exists; |
243 | require Proc::Exists; |
| … | |
… | |
| 251 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
256 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
| 252 | PrintError => 0, |
257 | PrintError => 0, |
| 253 | timeout => 2, |
258 | timeout => 2, |
| 254 | on_error => sub { }, |
259 | on_error => sub { }, |
| 255 | on_connect => sub { |
260 | on_connect => sub { |
| 256 | if (! $_[0]) { |
261 | if (!$_[1]) { |
| 257 | push @handle_errors, $@; |
262 | push @handle_errors, $@; |
| 258 | } |
263 | } |
| 259 | if (++$connected == 3) { |
264 | if (++$connected == 3) { |
| 260 | $cv->send(); |
265 | $cv->send(); |
| 261 | } |
266 | } |
| … | |
… | |
| 265 | } |
270 | } |
| 266 | $cv->recv(); |
271 | $cv->recv(); |
| 267 | is(scalar @handles,3,'created three handles'); |
272 | is(scalar @handles,3,'created three handles'); |
| 268 | is(scalar @handle_errors,0,'no errors during handle creation'); |
273 | is(scalar @handle_errors,0,'no errors during handle creation'); |
| 269 | my @pids = map {$_->_server_pid} @handles; |
274 | my @pids = map {$_->_server_pid} @handles; |
| 270 | ok( defined pexists(@pids, {all=>1}),'Found three start_serve processes'); |
275 | ok( defined pexists(@pids, {all=>1}),'Found three slave processes'); |
| 271 | undef @handles; |
276 | undef @handles; |
| 272 | |
277 | |
| 273 | $cv = AnyEvent->condvar; |
278 | $cv = AnyEvent->condvar; |
| 274 | my $cleanup = AnyEvent->timer(after=>0.5,cb=>sub {$cv->send()}); |
279 | my $cleanup = AnyEvent->timer(after=>0.5,cb=>sub {$cv->send()}); |
| 275 | $cv->recv(); |
280 | $cv->recv(); |
| 276 | ok(!defined pexists(@pids, {any=>1}),'All start_serve processes exited'); |
281 | ok(!defined pexists(@pids, {any=>1}),'All slave processes exited'); |
| 277 | } |
282 | } |
| 278 | |
283 | |
| 279 | # connect to the server again |
284 | # connect to the server again |
| 280 | $cv = AnyEvent->condvar; |
285 | $cv = AnyEvent->condvar; |
| 281 | $dbh = new AnyEvent::DBI( |
286 | $dbh = new AnyEvent::DBI( |
| 282 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
287 | "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','', |
| 283 | PrintError => 0, |
288 | PrintError => 0, |
| 284 | timeout => 2, |
289 | timeout => 2, |
| 285 | on_error => sub { }, |
290 | on_error => sub { }, |
| 286 | on_connect => sub { |
291 | on_connect => sub { |
| 287 | if (! $_[0]) { |
292 | if (!$_[1]) { |
| 288 | $cv->send($@); |
293 | $cv->send($@); |
| 289 | } |
|
|
| 290 | else { |
294 | } else { |
| 291 | $cv->send(); |
295 | $cv->send(); |
| 292 | } |
296 | } |
| 293 | }, |
297 | }, |
| 294 | ); |
298 | ); |
| 295 | $connect_error = $cv->recv(); |
299 | $connect_error = $cv->recv(); |
| 296 | is($connect_error,undef,'on_connect() called without error, fake mysql server is re-connected'); |
300 | is($connect_error,undef,'on_connect() called without error, fake mysql server is re-connected'); |
| 297 | |
301 | |
| 298 | # End the server and reap it |
302 | # End the server and reap it |
| 299 | $cv = AnyEvent->condvar; |
303 | $cv = AnyEvent->condvar; |
| 300 | my $server_process_watcher = AnyEvent->child( |
304 | my $server_process_watcher = AnyEvent->child( |
| 301 | pid => $server_pid , |
305 | pid => $server_pid, |
| 302 | cb => sub { |
306 | cb => sub { |
| 303 | $cv->send(@_); |
307 | $cv->send(@_); |
| 304 | } |
308 | } |
| 305 | ); |
309 | ); |
| 306 | kill 2, $server_pid; |
310 | kill 2, $server_pid; # 2 is SIGINT, usually |
| 307 | my ($dead_pid,$dead_status)=$cv->recv(); |
311 | my ($dead_pid,$dead_status)=$cv->recv(); |
| 308 | is ($dead_pid,$server_pid,'MySQL Server processess exited'); |
312 | is ($dead_pid,$server_pid,'MySQL Server processess exited'); |
| 309 | is ($dead_status,2,'Server exited on our signal'); |
313 | is ($dead_status,2,'Server exited on our signal'); |
| 310 | sleep 2; # give all mysql server children a chance to exit |
314 | |
|
|
315 | if (0) { |
|
|
316 | # does not seem tor eliably kill all children |
|
|
317 | sleep 2; |
| 311 | |
318 | |
| 312 | # try to make another query with a down MYSQL server |
319 | # try to make another query with a down MYSQL server |
| 313 | # issue a query |
320 | # issue a query |
| 314 | $cv = AnyEvent->condvar; |
321 | $cv = AnyEvent->condvar; |
| 315 | $dbh->exec ( |
322 | $dbh->exec ( |
| 316 | "select x from rows1 where num=?", 10, sub { |
323 | "select x from rows1 where num=?", 10, sub { |
| 317 | my ($dbh,$rows, $metadata) = @_; |
324 | my ($dbh, $rows, $metadata) = @_; |
| 318 | if (! $dbh) { |
325 | if (!$rows) { |
| 319 | $cv->send($@); |
326 | $cv->send($@); |
| 320 | } |
|
|
| 321 | else { |
327 | } else { |
| 322 | $cv->send(undef,$rows); |
328 | $cv->send(undef,$rows); |
| 323 | } |
329 | } |
| 324 | } |
330 | } |
| 325 | ); |
331 | ); |
| 326 | |
332 | |
| 327 | ($error, $rows) = $cv->recv(); |
333 | ($error, $rows) = $cv->recv(); |
| 328 | is($error,'TIMEOUT','mysql query to dead server times out'); |
334 | is($error,'timeout','mysql query to dead server times out'); |
| 329 | undef $dbh; |
335 | undef $dbh; |
|
|
336 | } |
| 330 | |
337 | |
| 331 | END { |
338 | END { |
| 332 | if ($server_pid) { |
339 | if ($server_pid) { |
| 333 | # shut down the fake_mysql server |
340 | # shut down the fake_mysql server |
| 334 | delete $SIG{CLD}; |
341 | delete $SIG{CLD}; |
| 335 | kill 15, $server_pid; |
342 | kill 15, $server_pid; |
| 336 | waitpid $server_pid,0; |
343 | waitpid $server_pid,0; |
| 337 | } |
344 | } |
| 338 | exit 0; |
345 | exit 0; |
| 339 | } |
346 | } |
|
|
347 | |
