AnyEvent-DBI/t/01_fake_mysql.t

#!/usr/bin/perl
BEGIN {
   unless ($ENV{PERL_ANYEVENT_DBI_TESTS}) {
      print "1..0 # SKIP env var PERL_ANYEVENT_DBI_TESTS not set\n"; exit;
   }
   eval {
      require DBIx::MyServer;
      require DBIx::MyServer::DBI;
   };
   if ($@) {
      print "1..0 # SKIP these tests require DBIx::MyServer\n"; exit;
   }
}

no warnings;
use List::Util     qw(sum);
use Cwd            qw(abs_path);
use File::Basename qw(dirname);

use AnyEvent::DBI;

my $topdir = dirname abs_path $0;

# fork off a child to be a mysql server
my $server_pid = fork;
unless ($server_pid) {
   exec "$^X $topdir/fake-mysql --config $topdir/myserver.conf";
   die 'exec failed';
}

# the parent is the test script
eval {
   require Test::More;
   #d#import Test::More tests => 34;
   import Test::More tests => 33;
};
if ($@) {
   print 'ok 1 # skip this test requires Test::More'."\n";
   exit 0;
}

# wait for server
sleep 1;
my $cv  = AnyEvent->condvar;
my $dbh = new AnyEvent::DBI(
   "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','',
   PrintError => 0,
   timeout    => 2,
   on_error   => sub { },
   on_connect => sub {
      if (!$_[1]) {
         $cv->send($@);
      } else {
         $cv->send();
      }
   },
);
my $connect_error = $cv->recv();
is($connect_error,undef,'on_connect() called without error, fake mysql server is connected');

# issue a query
$cv = AnyEvent->condvar;
$dbh->exec (
   "select a,b,c from rows14 where num=?", 10, sub {
      my ($dbh,$rows, $metadata) = @_;
      if (! $dbh) {
         $cv->send($@);
      }
      else {
         $cv->send(undef,$rows);
      }
   }
);
my ($error, $rows) = $cv->recv();
#print "@$_\n" for @$rows;
is($error,undef,'query returns no errors');
is(scalar @$rows,14,'query found 14 rows');
is(scalar @{$$rows[0]},3,'first row has 3 data');

# issue a query that returns an error
$cv = AnyEvent->condvar;
$dbh->exec (
   "select a,b,c from nosuchtable", sub {
      my ($dbh, $rows, $metadata) = @_;
      if (!$rows) {
         $cv->send($@);
      } else {
         $cv->send(undef,$rows);
      }
   }
);
($error, $rows) = $cv->recv();
is($error,qq{Table 'database.nosuchtable' doesn't exist},"SELECT on non-existant table returns NONFATAL error");

# good query after bad
$cv = AnyEvent->condvar;
$dbh->exec (
   "select a,b,c from rows14 where num=?", 10, sub {
      my ($dbh,$rows, $metadata) = @_;
      if (!$rows) {
         $cv->send($@);
      } else {
         $cv->send(undef,$rows);
      }
   }
);
($error, $rows) = $cv->recv();
#print "@$_\n" for @$rows;
is($error,undef,'good query after bad returns no errors');
is(scalar @$rows,14,'query found 14 rows');
is(scalar @{$$rows[0]},3,'first row has 3 data');

############################################################################
# enque a series of alternating good/bad queries
$cv = AnyEvent->condvar;
my @results = ();
my $num_qry = 0;
my $qrydone = sub {
   my ($dbh,$rows,$metadata) = @_;
   my $err = undef;
   if (!$rows) {
      $err = $@;
   }
   push @results , [$err,$rows];
   if (scalar @results == $num_qry) {
      $cv->send();
   }
};

$dbh->exec ("select a,b,c from nosuchtable1", $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from rows1"       , $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from nosuchtable2", $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from rows2"       , $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from nosuchtable3", $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from rows3"       , $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from nosuchtable4", $qrydone); $num_qry++;
$dbh->exec ("select a,b,c from rows4"       , $qrydone); $num_qry++;

$cv->recv();
for my $r (0..$num_qry-1) {
   my $offset = int($r / 2 )+1;
   if ($r % 2) {
      ok(! defined $results[$r]->[0],'Multi Query Queue: No error on good queries');
      is(scalar @{$results[$r]->[1]},$offset,'Multi Query Queue: Good query got right number of rows');
   } else {
      is(
         $results[$r]->[0],
         qq{Table 'database.nosuchtable$offset' doesn't exist},'Multi Query Queue: Bad query gets correct error'
      );
   }
}

############################################################################

# try to connect to a closed port
# NOTE tcp port 9 is 'discard', hopefully not running
$cv = AnyEvent->condvar;
my $dbh2 = new AnyEvent::DBI(
   "dbi:mysql:database=test;host=127.0.0.1;port=9",'','',
   PrintError => 0,
   timeout    => 3,
   on_error   => sub { },
   on_connect => sub {
      if (!$_[1]) {
         $cv->send($@);
      }
      else {
         $cv->send();
      }
   },
);
$connect_error = $cv->recv();
like($connect_error,qr{can't connect}i,'mysql connect to localhost:9 refused');

# try to connect to a firewalled port
$cv = AnyEvent->condvar;
$dbh2 = new AnyEvent::DBI(
   "dbi:mysql:database=test;host=www.google.com;port=23306",'','',
   timeout    => 3,
   on_error   => sub { },
   on_connect => sub {
      if (!$_[1]) {
         $cv->send($@);
      }
      else {
         $cv->send();
      }
   },
);
$connect_error = $cv->recv();
is($connect_error,'timeout','mysql connect to google port 23306 times out');
undef $dbh2;

# issue a query which times out
$cv = AnyEvent->condvar;
$dbh->exec (
   "select a,b,c from delay10 where num=?", 10, sub {
      my ($dbh,$rows, $metadata) = @_;
      if (! $rows) {
         $cv->send($@);
      }
      else {
         $cv->send(undef,$rows);
      }
   }
);
($error,$rows) = $cv->recv();
is($error,'timeout','timeout fires during long-running query');

# issue a query after a fatal timeout error
$cv = AnyEvent->condvar;
my $start = AnyEvent->now;
my $run   = 10;
my $ran   = 0;
my $fin   = 0;
my $errs  = [];
while ($ran++ < $run) {
   $dbh->exec (
      "select d,e,f,g from rows5 where num=?", 10, sub {
         my ($dbh,$rows, $metadata) = @_;
         if (!$rows) {
            push @$errs, $@;
         }
         if (++$fin == $run) {
            $cv->send();
         }
      }
   );
}
$cv->recv();
ok(AnyEvent->now -$start < 0.0001,'invalid db handle returns from multiple queries immediately');
is (scalar @$errs, 10, 'invalid db handle returned error for all enqueued queries');
is($errs->[0],'no database connection','invalid db handle returns correct error');
undef $dbh;

# check for server process leakage
eval {
   require Proc::Exists;
   import Proc::Exists qw(pexists);
};
my $has_pe = ! $@;
SKIP: {
   skip ( 'This test requires Proc::Exists',4)  unless $has_pe;
   # connect three handles
   $cv  = AnyEvent->condvar;
   my @handles;
   my @handle_errors;
   my $connected =0;
   for (0..2) {
      my $dbh3 = new AnyEvent::DBI(
         "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','',
         PrintError => 0,
         timeout    => 2,
         on_error   => sub { },
         on_connect => sub {
            if (!$_[1]) {
               push @handle_errors, $@;
            }
            if (++$connected == 3) {
               $cv->send();
            }
         },
      );
      push @handles, $dbh3;
   }
   $cv->recv();
   is(scalar @handles,3,'created three handles');
   is(scalar @handle_errors,0,'no errors during handle creation');
   my @pids = map {$_->_server_pid} @handles;
   ok( defined pexists(@pids, {all=>1}),'Found three slave processes');
   undef @handles;

   $cv = AnyEvent->condvar;
   my $cleanup = AnyEvent->timer(after=>0.5,cb=>sub {$cv->send()});
   $cv->recv();
   ok(!defined pexists(@pids, {any=>1}),'All slave processes exited');
}

# connect to the server again
$cv  = AnyEvent->condvar;
$dbh = new AnyEvent::DBI(
   "dbi:mysql:database=database;host=127.0.0.1;port=23306",'','',
   PrintError => 0,
   timeout    => 2,
   on_error   => sub { },
   on_connect => sub {
      if (!$_[1]) {
         $cv->send($@);
      } else {
         $cv->send();
      }
   },
);
$connect_error = $cv->recv();
is($connect_error,undef,'on_connect() called without error, fake mysql server is re-connected');

# End the server and reap it
$cv  = AnyEvent->condvar;
my $server_process_watcher = AnyEvent->child(
   pid => $server_pid,
   cb  => sub {
      $cv->send(@_);
   }
);
kill 2, $server_pid; # 2 is SIGINT, usually
my ($dead_pid,$dead_status)=$cv->recv();
is ($dead_pid,$server_pid,'MySQL Server processess exited');
is ($dead_status,2,'Server exited on our signal');

if (0) {
   # does not seem tor eliably kill all children
sleep 2;

# try to make another query with a down MYSQL server
# issue a query
$cv = AnyEvent->condvar;
$dbh->exec (
   "select x from rows1 where num=?", 10, sub {
      my ($dbh, $rows, $metadata) = @_;
      if (!$rows) {
         $cv->send($@);
      } else {
         $cv->send(undef,$rows);
      }
   }
);

($error, $rows) = $cv->recv();
is($error,'timeout','mysql query to dead server times out');
undef $dbh;
}

END {
   if ($server_pid) {
      # shut down the fake_mysql server
      delete $SIG{CLD};
      kill 15, $server_pid;
      waitpid $server_pid,0;
   }
   exit 0;
}

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