1#!/usr/bin/perl
2
3BEGIN {
4   unless ($ENV{PERL_ANYEVENT_DBI_TESTS}) {
5      print "1..0 # SKIP env var PERL_ANYEVENT_DBI_TESTS not set\n"; exit;
6   }
7   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 => 44;
15}
16
17use strict;
18use warnings;
19use AnyEvent;
20use AnyEvent::DBI;
21use File::Temp qw(tempfile);
22
23# we are going to watch what the sub-processes send to stderr
24close STDERR;
25my($tfh_err,$tfn_err) = tempfile;
26close $tfh_err;
27open(STDERR,">>$tfn_err");
28
29my ($cv,$dbh,$tfh,$tfn,$error,$result,$rv);
30
31($tfh,$tfn) = tempfile;
32close $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   on_connect  => sub {return $cv->send($@) unless $_[1]; $cv->send()},
44);
45$error = $cv->recv();
46is($error,undef,'on_connect() called without error, sqlite server is connected');
47
48# lets have an error
49$cv = AnyEvent->condvar;
50$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
51($error,$result) = $cv->recv();
52like ($error,qr{no such table}i,'Select from non existant table results in error');
53# ensure we got no stderr output
54ok(-z $tfn_err,'Error does not result in output on STDERR');
55
56# check the error behavior
57$cv = AnyEvent->condvar;
58$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
59($error,$result)= $cv->recv();
60ok(!$error,'No errors occur while checking attribute');
61ok(!$result,'Accessor without set (PrintError) returns false');
62
63# change the error behavior
64$cv = AnyEvent->condvar;
65$dbh->attr(PrintError=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
66($error,$result)= $cv->recv();
67ok(!$error,'No error occurs while setting PrintError => 1');
68ok($result,'Accessor with set (PrintError) returns true');
69
70# check the error behavior
71$cv = AnyEvent->condvar;
72$dbh->attr('PrintError',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
73($error,$result)= $cv->recv();
74ok(!$error,'No errors occur while checking attribute');
75ok($result,'PrintError was true');
76
77# lets have an error
78$cv = AnyEvent->condvar;
79$dbh->exec('select bogus_column from no_such_table',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
80($error,$result) = $cv->recv();
81like ($error,qr{no such table}i,'Select from non existant column makes an error');
82# ensure we did get STDERR output
83ok(-s $tfn_err,'Error message has appeared on STDERR');
84
85# create a table
86$cv = AnyEvent->condvar;
87$dbh->exec('create table a_table (a_column text)',sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
88($error,$result) = $cv->recv();
89ok(!$error,'No errors creating a table');
90
91# add some data
92$cv = AnyEvent->condvar;
93$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();
95ok(!$error,'No errors inserting into table');
96is($rv,1,"One row affected");
97
98# check for the data
99$cv = AnyEvent->condvar;
100$dbh->exec('select a_column from a_table',sub {return $cv->send($@) unless $#_;$cv->send(undef,@_[1,2])});
101($error,$result,$rv) = $cv->recv();
102ok(!$error,'No errors inserting into table');
103ok($rv,'select succeeded');
104is($result->[0]->[0],'test','found correct data');
105
106# stattr
107$cv = AE::cv;
108$dbh->stattr ("NAME", sub {
109   $cv->send ($_[1]);
110});
111$rv = $cv->recv;
112is($rv->[0], "a_column", "NAME attribute returned correctly");
113
114# check the autocommit behavior
115$cv = AnyEvent->condvar;
116$dbh->attr('AutoCommit',sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
117($error,$result)= $cv->recv();
118ok(!$error,'No errors occur while checking attribute');
119ok($result,'AutoCommit was true');
120
121# turn off autocommit
122$cv = AnyEvent->condvar;
123$dbh->attr(AutoCommit=>0,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
124($error,$result)= $cv->recv();
125ok(!$error,'No error setting attr');
126ok(!$result,'AutoCommit was false');
127
128# add some data
129$cv = AnyEvent->condvar;
130$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;
132ok(!$error,'No errors inserting into table');
133is($rv,1,"One row affected");
134
135# crash the handle
136unlink $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   on_connect  => sub {return $cv->send($@) unless $_[1]; $cv->send()},
148);
149$error = $cv->recv();
150is($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$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();
156ok(!$error,'No errors selecting from table');
157ok($rv,'select succeeded');
158is(scalar @$result,1,'found only one row');
159is($result->[0]->[0],'test','found correct data in that row');
160
161# add some data
162$cv = AnyEvent->condvar;
163$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();
165ok(!$error,'No errors inserting into table');
166is($rv,1,'One row affected');
167
168# commit to db
169$cv = AnyEvent->condvar;
170$dbh->commit(sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])});
171($error,$result) = $cv->recv();
172ok(!$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$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();
178ok(!$error,'No errors inserting into table');
179ok($rv,'select succeeded');
180is(scalar @$result,2,'found two rows');
181is($result->[0]->[0],'test','found correct data in row one');
182is($result->[1]->[0],'moredata','found correct data in row two');
183
184# change the autocommit behavior
185$cv = AnyEvent->condvar;
186$dbh->attr(AutoCommit=>1,sub {return $cv->send($@) unless $_[1]; $cv->send(undef,$_[1])});
187($error,$result)= $cv->recv();
188ok(!$error,'No error occurs while setting AutoCommit => 1');
189ok($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$dbh->exec('select a_column from a_table where xyzzyinstr(a_column,?)','re',
195           sub {return $cv->send($@,@_[0,1,2]);});
196my $hdl;
197($error,$hdl,$result,$rv) = $cv->recv();
198like($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   sub {return $cv->send($@) unless $_[1];$cv->send(undef,$_[1])}
214);
215$cv->recv(); # ignore result from this particular private fn.
216
217# using new function
218$cv = AnyEvent->condvar;
219$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();
221ok(!$error,'Our new function works fine');
222ok($rv,'select succeeded');
223is(scalar @$result,1,'found only one row');
224is($result->[0]->[0],'moredata','found correct data');
225
226END {
227   unlink $tfn if $tfn;
228#   system ("cat $tfn_err");
229   unlink $tfn_err if $tfn_err;
230}
231
232