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;
   }
   eval {
      require DBD::SQLite;
   };
   if ($@) {
      print "1..0 # SKIP this test requires Test::More and DBD::SQLite\n"; exit;
   }
   require Test::More;
   import Test::More tests => 43;
}

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

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