1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236
|
#!/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');
SKIP: {
skip "instr() exists since sqlite 3.7.15, this test assumes it's an unknown function", 1
if $DBD::SQLite::sqlite_version >= 3.7.15;
# 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;
}
|