AnyEvent-DBI/t/02_sql_lite.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;
   }
}

use strict;
use warnings;
use AnyEvent;
use AnyEvent::DBI;
use File::Temp qw(tempfile);

eval {
   require Test::More;
   import Test::More tests => 43;
   require DBD::SQLite;
};
if ($@) {
   print 'ok 1 # skip - this test requires Test::More and DBD::SQLite'."\n";
   exit 0;
}

# we are going to watch what the sub-processes send to stderr
close STDERR;
my($tfh_err,$tfn_err) = tempfile;
close $tfh_err;
open(STDERR,">>$tfn_err");

my ($cv,$dbh,$tfh,$tfn,$error,$result,$rv);

($tfh,$tfn) = tempfile;
close $tfh;

# connect with exec
$cv  = AnyEvent->condvar;
$dbh = new AnyEvent::DBI(
   "dbi:SQLite:dbname=$tfn",'','',
   AutoCommit  => 1,
   PrintError  => 0,
   timeout     => 2,
   exec_server => 1,
   on_error    => sub { },
   on_connect  => sub {return $cv->send($@) unless $_[1]; $cv->send()},
);
$error = $cv->recv();
is($error,undef,'on_connect() called without error, sqlite server is connected');

# lets have an error
$cv = AnyEvent->condvar;
$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
($error,$result) = $cv->recv();
like ($error,qr{no such table}i,'Select from non existant table results in error');
# ensure we got no stderr output
ok(-z $tfn_err,'Error does not result in output on STDERR');

# check the error behavior
$cv = AnyEvent->condvar;
$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No errors occur while checking attribute');
ok(!$result,'Accessor without set (PrintError) returns false');

# change the error behavior
$cv = AnyEvent->condvar;
$dbh->attr(PrintError=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No error occurs while setting PrintError => 1');
ok($result,'Accessor with set (PrintError) returns true');

# check the error behavior
$cv = AnyEvent->condvar;
$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No errors occur while checking attribute');
ok($result,'PrintError was true');

# lets have an error
$cv = AnyEvent->condvar;
$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
($error,$result) = $cv->recv();
like ($error,qr{no such table}i,'Select from non existant column makes an error');
# ensure we did get STDERR output
ok(-s $tfn_err,'Error message has appeared on STDERR');

# create a table
$cv = AnyEvent->condvar;
$dbh->exec('create table a_table (a_column text)',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
($error,$result) = $cv->recv();
ok(!$error,'No errors creating a table');

# add some data
$cv = AnyEvent->condvar;
$dbh->exec('insert into a_table (a_column) values(?)','test',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'No errors inserting into table');
is($rv,1,"One row affected");

# check for the data
$cv = AnyEvent->condvar;
$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'No errors inserting into table');
ok($rv,'select succeeded');
is($result->[0]->[0],'test','found correct data');

# check the autocommit behavior
$cv = AnyEvent->condvar;
$dbh->attr('AutoCommit',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No errors occur while checking attribute');
ok($result,'AutoCommit was true');

# turn off autocommit
$cv = AnyEvent->condvar;
$dbh->attr(AutoCommit=>0,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No error setting attr');
ok(!$result,'AutoCommit was false');

# add some data
$cv = AnyEvent->condvar;
$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv;
ok(!$error,'No errors inserting into table');
is($rv,1,"One row affected");

# crash the handle
unlink $dbh;

# connect without exec or autocommit
$cv  = AnyEvent->condvar;
$dbh = new AnyEvent::DBI(
   "dbi:SQLite:dbname=$tfn",'','',
   AutoCommit  => 0,
   PrintError  => 0,
   timeout     => 2,
   exec_server => 0,
   on_error    => sub { },
   on_connect  => sub {return $cv->send($@) unless $_[1]; $cv->send()},
);
$error = $cv->recv();
is($error,undef,'on_connect() called without error, sqlite server is connected');

# check for the data and that the aborted transaction did not make it to the database
$cv = AnyEvent->condvar;
$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'No errors selecting from table');
ok($rv,'select succeeded');
is(scalar @$result,1,'found only one row');
is($result->[0]->[0],'test','found correct data in that row');

# add some data
$cv = AnyEvent->condvar;
$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'No errors inserting into table');
is($rv,1,'One row affected');

# commit to db
$cv = AnyEvent->condvar;
$dbh->commit(sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
($error,$result) = $cv->recv();
ok(!$error,'No errors commiting');

# check for the data and that the aborted transaction did not make it to the database
$cv = AnyEvent->condvar;
$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'No errors inserting into table');
ok($rv,'select succeeded');
is(scalar @$result,2,'found two rows');
is($result->[0]->[0],'test','found correct data in row one');
is($result->[1]->[0],'moredata','found correct data in row two');

# change the autocommit behavior
$cv = AnyEvent->condvar;
$dbh->attr(AutoCommit=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
($error,$result)= $cv->recv();
ok(!$error,'No error occurs while setting AutoCommit => 1');
ok($result,'Accessor with set (AutoCommit) returns true');

# using bad function returns error
$cv = AnyEvent->condvar;
#$dbh->exec('select a_column from a_table where instr(a_column,?)','re',sub {return $cv->send($@) unless $_[0];$cv->send(undef,@_[1,2]);});
$dbh->exec('select a_column from a_table where instr(a_column,?)','re',
           sub {return $cv->send($@,@_[0,1,2]);});
my $hdl;
($error,$hdl,$result,$rv) = $cv->recv();
like($error,qr{function}i,'Using an unknown function results in error');

# create the function
$cv = AnyEvent->condvar;

$dbh->func(
   q{
      'instr',
      2,
      sub {
         my ($string, $search) = @_;
         return index $string, $search;
      },
   },
   'create_function',
   sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])}
);
$cv->recv(); # ignore result from this particular private fn.

# using new function
$cv = AnyEvent->condvar;
$dbh->exec('select a_column from a_table where instr(a_column,?) >= 0','re',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
($error,$result,$rv) = $cv->recv();
ok(!$error,'Our new function works fine');
ok($rv,'select succeeded');
is(scalar @$result,1,'found only one row');
is($result->[0]->[0],'moredata','found correct data');

END {
   unlink $tfn if $tfn;
#   system ("cat $tfn_err");
   unlink $tfn_err if $tfn_err;
}

Revision:	1.2
Committed:	Sun Jun 28 14:59:51 2009 UTC (17 years, 3 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-2_2, rel-2_0, rel-2_1
Changes since 1.1:	+43 -38 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	#!/usr/bin/perl
2	root	1.2	BEGIN {
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	root	1.1	use strict;
9			use warnings;
10			use AnyEvent;
11			use AnyEvent::DBI;
12			use File::Temp qw(tempfile);
13
14			eval {
15			require Test::More;
16			import Test::More tests => 43;
17			require DBD::SQLite;
18			};
19			if ($@) {
20			print 'ok 1 # skip - this test requires Test::More and DBD::SQLite'."\n";
21			exit 0;
22			}
23
24			# we are going to watch what the sub-processes send to stderr
25			close STDERR;
26			my($tfh_err,$tfn_err) = tempfile;
27			close $tfh_err;
28			open(STDERR,">>$tfn_err");
29
30	root	1.2	my ($cv,$dbh,$tfh,$tfn,$error,$result,$rv);
31	root	1.1
32			($tfh,$tfn) = tempfile;
33			close $tfh;
34
35			# connect with exec
36			$cv = AnyEvent->condvar;
37			$dbh = new AnyEvent::DBI(
38			"dbi:SQLite:dbname=$tfn",'','',
39			AutoCommit => 1,
40			PrintError => 0,
41			timeout => 2,
42			exec_server => 1,
43			on_error => sub { },
44	root	1.2	on_connect => sub {return $cv->send($@) unless $_[1]; $cv->send()},
45	root	1.1	);
46			$error = $cv->recv();
47			is($error,undef,'on_connect() called without error, sqlite server is connected');
48
49			# lets have an error
50			$cv = AnyEvent->condvar;
51	root	1.2	$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
52	root	1.1	($error,$result) = $cv->recv();
53			like ($error,qr{no such table}i,'Select from non existant table results in error');
54			# ensure we got no stderr output
55			ok(-z $tfn_err,'Error does not result in output on STDERR');
56
57			# check the error behavior
58			$cv = AnyEvent->condvar;
59	root	1.2	$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
60	root	1.1	($error,$result)= $cv->recv();
61			ok(!$error,'No errors occur while checking attribute');
62			ok(!$result,'Accessor without set (PrintError) returns false');
63
64			# change the error behavior
65			$cv = AnyEvent->condvar;
66	root	1.2	$dbh->attr(PrintError=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
67	root	1.1	($error,$result)= $cv->recv();
68			ok(!$error,'No error occurs while setting PrintError => 1');
69			ok($result,'Accessor with set (PrintError) returns true');
70
71			# check the error behavior
72			$cv = AnyEvent->condvar;
73	root	1.2	$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
74	root	1.1	($error,$result)= $cv->recv();
75			ok(!$error,'No errors occur while checking attribute');
76			ok($result,'PrintError was true');
77
78			# lets have an error
79			$cv = AnyEvent->condvar;
80	root	1.2	$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
81	root	1.1	($error,$result) = $cv->recv();
82			like ($error,qr{no such table}i,'Select from non existant column makes an error');
83			# ensure we did get STDERR output
84			ok(-s $tfn_err,'Error message has appeared on STDERR');
85
86			# create a table
87			$cv = AnyEvent->condvar;
88	root	1.2	$dbh->exec('create table a_table (a_column text)',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
89	root	1.1	($error,$result) = $cv->recv();
90			ok(!$error,'No errors creating a table');
91
92			# add some data
93			$cv = AnyEvent->condvar;
94	root	1.2	$dbh->exec('insert into a_table (a_column) values(?)','test',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
95			($error,$result,$rv) = $cv->recv();
96	root	1.1	ok(!$error,'No errors inserting into table');
97	root	1.2	is($rv,1,"One row affected");
98	root	1.1
99			# check for the data
100			$cv = AnyEvent->condvar;
101	root	1.2	$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
102			($error,$result,$rv) = $cv->recv();
103	root	1.1	ok(!$error,'No errors inserting into table');
104	root	1.2	ok($rv,'select succeeded');
105	root	1.1	is($result->[0]->[0],'test','found correct data');
106
107			# check the autocommit behavior
108			$cv = AnyEvent->condvar;
109	root	1.2	$dbh->attr('AutoCommit',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
110	root	1.1	($error,$result)= $cv->recv();
111			ok(!$error,'No errors occur while checking attribute');
112			ok($result,'AutoCommit was true');
113
114			# turn off autocommit
115			$cv = AnyEvent->condvar;
116	root	1.2	$dbh->attr(AutoCommit=>0,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
117	root	1.1	($error,$result)= $cv->recv();
118			ok(!$error,'No error setting attr');
119			ok(!$result,'AutoCommit was false');
120
121			# add some data
122			$cv = AnyEvent->condvar;
123	root	1.2	$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
124			($error,$result,$rv) = $cv->recv;
125	root	1.1	ok(!$error,'No errors inserting into table');
126	root	1.2	is($rv,1,"One row affected");
127	root	1.1
128			# crash the handle
129			unlink $dbh;
130
131			# connect without exec or autocommit
132			$cv = AnyEvent->condvar;
133			$dbh = new AnyEvent::DBI(
134			"dbi:SQLite:dbname=$tfn",'','',
135			AutoCommit => 0,
136			PrintError => 0,
137			timeout => 2,
138			exec_server => 0,
139			on_error => sub { },
140	root	1.2	on_connect => sub {return $cv->send($@) unless $_[1]; $cv->send()},
141	root	1.1	);
142			$error = $cv->recv();
143			is($error,undef,'on_connect() called without error, sqlite server is connected');
144
145			# check for the data and that the aborted transaction did not make it to the database
146			$cv = AnyEvent->condvar;
147	root	1.2	$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
148			($error,$result,$rv) = $cv->recv();
149	root	1.1	ok(!$error,'No errors selecting from table');
150	root	1.2	ok($rv,'select succeeded');
151	root	1.1	is(scalar @$result,1,'found only one row');
152			is($result->[0]->[0],'test','found correct data in that row');
153
154			# add some data
155			$cv = AnyEvent->condvar;
156	root	1.2	$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
157			($error,$result,$rv) = $cv->recv();
158	root	1.1	ok(!$error,'No errors inserting into table');
159	root	1.2	is($rv,1,'One row affected');
160	root	1.1
161			# commit to db
162			$cv = AnyEvent->condvar;
163	root	1.2	$dbh->commit(sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
164	root	1.1	($error,$result) = $cv->recv();
165			ok(!$error,'No errors commiting');
166
167			# check for the data and that the aborted transaction did not make it to the database
168			$cv = AnyEvent->condvar;
169	root	1.2	$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
170			($error,$result,$rv) = $cv->recv();
171	root	1.1	ok(!$error,'No errors inserting into table');
172	root	1.2	ok($rv,'select succeeded');
173	root	1.1	is(scalar @$result,2,'found two rows');
174			is($result->[0]->[0],'test','found correct data in row one');
175			is($result->[1]->[0],'moredata','found correct data in row two');
176
177			# change the autocommit behavior
178			$cv = AnyEvent->condvar;
179	root	1.2	$dbh->attr(AutoCommit=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
180	root	1.1	($error,$result)= $cv->recv();
181			ok(!$error,'No error occurs while setting AutoCommit => 1');
182			ok($result,'Accessor with set (AutoCommit) returns true');
183
184			# using bad function returns error
185			$cv = AnyEvent->condvar;
186			#$dbh->exec('select a_column from a_table where instr(a_column,?)','re',sub {return $cv->send($@) unless $_[0];$cv->send(undef,@_[1,2]);});
187			$dbh->exec('select a_column from a_table where instr(a_column,?)','re',
188			sub {return $cv->send($@,@_[0,1,2]);});
189			my $hdl;
190	root	1.2	($error,$hdl,$result,$rv) = $cv->recv();
191	root	1.1	like($error,qr{function}i,'Using an unknown function results in error');
192
193			# create the function
194			$cv = AnyEvent->condvar;
195
196			$dbh->func(
197			q{
198			'instr',
199			2,
200			sub {
201			my ($string, $search) = @_;
202			return index $string, $search;
203			},
204			},
205			'create_function',
206	root	1.2	sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])}
207	root	1.1	);
208			$cv->recv(); # ignore result from this particular private fn.
209
210			# using new function
211			$cv = AnyEvent->condvar;
212	root	1.2	$dbh->exec('select a_column from a_table where instr(a_column,?) >= 0','re',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
213			($error,$result,$rv) = $cv->recv();
214	root	1.1	ok(!$error,'Our new function works fine');
215	root	1.2	ok($rv,'select succeeded');
216	root	1.1	is(scalar @$result,1,'found only one row');
217			is($result->[0]->[0],'moredata','found correct data');
218
219			END {
220			unlink $tfn if $tfn;
221			# system ("cat $tfn_err");
222			unlink $tfn_err if $tfn_err;
223			}
224	root	1.2