AnyEvent-DBI/t/02_sql_lite.t

#!/usr/bin/perl
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,$metadata);

($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 $_[0]; $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 $_[0];$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 $_[0]; $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 $_[0]; $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 $_[0]; $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 $_[0];$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 $_[0];$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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors inserting into table');
is($metadata->{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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors inserting into table');
ok($metadata->{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 $_[0]; $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 $_[0]; $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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors inserting into table');
is($metadata->{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 $_[0]; $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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors selecting from table');
ok($metadata->{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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors inserting into table');
is($metadata->{rv},1,'One row affected');

# commit to db
$cv = AnyEvent->condvar;
$dbh->commit(sub {return $cv->send($@) unless $_[0];$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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'No errors inserting into table');
ok($metadata->{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 $_[0]; $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,$metadata) = $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 $_[0];$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 $_[0];$cv->send(undef,@_[1,2]);});
($error,$result,$metadata) = $cv->recv();
ok(!$error,'Our new function works fine');
ok($metadata->{rv},'select succeeded');
is(scalar @$result,1,'found only one row');
is($result->[0]->[0],'moredata','found correct data');

exit;

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