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