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 => 44;
}

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');

# stattr
$cv = AE::cv;
$dbh->stattr ("NAME", sub {
   $cv->send ($_[1]);
});
$rv = $cv->recv;
is($rv->[0], "a_column", "NAME attribute returned correctly");

# 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.5
Committed:	Tue Aug 15 07:28:55 2017 UTC (6 years, 9 months ago) by root
Content type:	application/x-troff
Branch:	MAIN
CVS Tags:	rel-3_0, rel-3_01, rel-3_02, rel-3_03, rel-3_04, HEAD
Changes since 1.4:	+9 -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	root	1.5	import Test::More tests => 44;
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	root	1.5	# stattr
107			$cv = AE::cv;
108			$dbh->stattr ("NAME", sub {
109			$cv->send ($_[1]);
110			});
111			$rv = $cv->recv;
112			is($rv->[0], "a_column", "NAME attribute returned correctly");
113
114	root	1.1	# check the autocommit behavior
115			$cv = AnyEvent->condvar;
116	root	1.2	$dbh->attr('AutoCommit',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
117	root	1.1	($error,$result)= $cv->recv();
118			ok(!$error,'No errors occur while checking attribute');
119			ok($result,'AutoCommit was true');
120
121			# turn off autocommit
122			$cv = AnyEvent->condvar;
123	root	1.2	$dbh->attr(AutoCommit=>0,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
124	root	1.1	($error,$result)= $cv->recv();
125			ok(!$error,'No error setting attr');
126			ok(!$result,'AutoCommit was false');
127
128			# add some data
129			$cv = AnyEvent->condvar;
130	root	1.2	$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
131			($error,$result,$rv) = $cv->recv;
132	root	1.1	ok(!$error,'No errors inserting into table');
133	root	1.2	is($rv,1,"One row affected");
134	root	1.1
135			# crash the handle
136			unlink $dbh;
137
138			# connect without exec or autocommit
139			$cv = AnyEvent->condvar;
140			$dbh = new AnyEvent::DBI(
141			"dbi:SQLite:dbname=$tfn",'','',
142			AutoCommit => 0,
143			PrintError => 0,
144			timeout => 2,
145			exec_server => 0,
146			on_error => sub { },
147	root	1.2	on_connect => sub {return $cv->send($@) unless $_[1]; $cv->send()},
148	root	1.1	);
149			$error = $cv->recv();
150			is($error,undef,'on_connect() called without error, sqlite server is connected');
151
152			# check for the data and that the aborted transaction did not make it to the database
153			$cv = AnyEvent->condvar;
154	root	1.2	$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
155			($error,$result,$rv) = $cv->recv();
156	root	1.1	ok(!$error,'No errors selecting from table');
157	root	1.2	ok($rv,'select succeeded');
158	root	1.1	is(scalar @$result,1,'found only one row');
159			is($result->[0]->[0],'test','found correct data in that row');
160
161			# add some data
162			$cv = AnyEvent->condvar;
163	root	1.2	$dbh->exec('insert into a_table (a_column) values(?)','moredata',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
164			($error,$result,$rv) = $cv->recv();
165	root	1.1	ok(!$error,'No errors inserting into table');
166	root	1.2	is($rv,1,'One row affected');
167	root	1.1
168			# commit to db
169			$cv = AnyEvent->condvar;
170	root	1.2	$dbh->commit(sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
171	root	1.1	($error,$result) = $cv->recv();
172			ok(!$error,'No errors commiting');
173
174			# check for the data and that the aborted transaction did not make it to the database
175			$cv = AnyEvent->condvar;
176	root	1.2	$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,@_[1,2])});
177			($error,$result,$rv) = $cv->recv();
178	root	1.1	ok(!$error,'No errors inserting into table');
179	root	1.2	ok($rv,'select succeeded');
180	root	1.1	is(scalar @$result,2,'found two rows');
181			is($result->[0]->[0],'test','found correct data in row one');
182			is($result->[1]->[0],'moredata','found correct data in row two');
183
184			# change the autocommit behavior
185			$cv = AnyEvent->condvar;
186	root	1.2	$dbh->attr(AutoCommit=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
187	root	1.1	($error,$result)= $cv->recv();
188			ok(!$error,'No error occurs while setting AutoCommit => 1');
189			ok($result,'Accessor with set (AutoCommit) returns true');
190
191			# using bad function returns error
192			$cv = AnyEvent->condvar;
193			#$dbh->exec('select a_column from a_table where instr(a_column,?)','re',sub {return $cv->send($@) unless $_[0];$cv->send(undef,@_[1,2]);});
194	root	1.4	$dbh->exec('select a_column from a_table where xyzzyinstr(a_column,?)','re',
195	root	1.1	sub {return $cv->send($@,@_[0,1,2]);});
196			my $hdl;
197	root	1.2	($error,$hdl,$result,$rv) = $cv->recv();
198	root	1.1	like($error,qr{function}i,'Using an unknown function results in error');
199
200			# create the function
201			$cv = AnyEvent->condvar;
202
203			$dbh->func(
204			q{
205			'instr',
206			2,
207			sub {
208			my ($string, $search) = @_;
209			return index $string, $search;
210			},
211			},
212			'create_function',
213	root	1.2	sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])}
214	root	1.1	);
215			$cv->recv(); # ignore result from this particular private fn.
216
217			# using new function
218			$cv = AnyEvent->condvar;
219	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])});
220			($error,$result,$rv) = $cv->recv();
221	root	1.1	ok(!$error,'Our new function works fine');
222	root	1.2	ok($rv,'select succeeded');
223	root	1.1	is(scalar @$result,1,'found only one row');
224			is($result->[0]->[0],'moredata','found correct data');
225
226			END {
227			unlink $tfn if $tfn;
228			# system ("cat $tfn_err");
229			unlink $tfn_err if $tfn_err;
230			}
231	root	1.2