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
|
use strict;
use warnings;
use Test::More;
use Test::Warn;
use_ok('Test::MockDBI');
my $instance = Test::MockDBI::get_instance();
my %methods = (
'DBI::db' => ['prepare', 'prepare_cached', 'do', 'commit', 'rollback', 'begin_work', 'ping', 'disconnect'],
'DBI::st' => ['bind_param', 'bind_param_inout', 'execute', 'fetchrow_arrayref', 'fetchrow_array', 'fetchrow_hashref',
'fetchall_arrayref', 'finish', 'rows']
);
my $dbh = DBI->connect('DBI:mydb:somedb', 'user1', 'password1', { AutoCommit => undef } ); #AutoCommit to silence warnings!
my $sth = $dbh->prepare('SELECT something FROM sometable');
$sth->execute(); #Make sure its executed
{
#Testing that we can set the returnvalue to plain undef
#Testing the databasehandler
foreach my $method ( @{ $methods{'DBI::db'} } ){
#Setting a fake retval for the prepare method
$instance->set_retval( method => $method, retval => undef );
my $retval = $dbh->$method();
ok(!$retval, $method . ' returned undef');
}
#Testing the statementhandler
foreach my $method ( @{ $methods{'DBI::st'} } ){
#Setting a fake retval for the prepare method
$instance->set_retval( method => $method, retval => undef);
my $retval = $sth->$method();
ok(!$retval, $method . ' returned undef');
}
#Resetting the mock instance
$instance->reset();
}
{
#Testing that we can set the returnvalue and custom err and errstr
#Testing the databasehandler
foreach my $method ( @{ $methods{'DBI::db'} } ){
my %args = ( method => $method, retval => undef, err => 99, errstr => 'Custom DBI error' );
#Setting a fake retval for the prepare method
$instance->set_retval( %args );
my $retval = $dbh->$method();
ok(!$retval, $method . ' returned undef');
cmp_ok($dbh->err, '==', $args{err}, '$sth->err is ' . $args{err});
cmp_ok($dbh->errstr, 'eq', $args{errstr}, '$sth->errstr is ' . $args{errstr});
}
#Testing the statementhandler
foreach my $method ( @{ $methods{'DBI::st'} } ){
my %args = ( method => $method, retval => undef, err => 99, errstr => 'Custom DBI error' );
#Setting a fake retval for the prepare method
$instance->set_retval( %args );
my $retval = $sth->$method();
ok(!$retval, $method . ' returned undef');
cmp_ok($sth->err, '==', $args{err}, '$sth->err is ' . $args{err});
cmp_ok($sth->errstr, 'eq', $args{errstr}, '$sth->errstr is ' . $args{errstr});
}
$instance->reset();
}
{
#Setting a fake retval should fail if no method is provided
my %args = ( retval => undef, err => 99, errstr => 'Custom DBI error' );
warning_like{
ok(!$instance->set_retval( %args ), "set_retval fails without a method");
} qr/No method provided/, "set_retval displays warning on no method";
}
{
#Method must be a scalar string
my %args = ( method => sub{ return 'somemethod';}, retval => undef, err => 99, errstr => 'Custom DBI error' );
warning_like{
ok(!$instance->set_retval( %args ), "set_retval fails with an invalid method");
} qr/Parameter method must be a scalar string/, "set_retval displays warning on invalid method";
}
{
#If provided sql must be a scalar string
my %args = ( method => 'prepare', sql => ['sql'], retval => undef, err => 99, errstr => 'Custom DBI error' );
warning_like{
ok(!$instance->set_retval( %args ), "set_retval fails with an invalid sql");
} qr/Parameter SQL must be a scalar string/, "set_retval displays warning on invalid sql";
}
{
#A retval must be provided
my %args = ( method => 'prepare', err => 99, errstr => 'Custom DBI error' );
warning_like{
ok(!$instance->set_retval( %args ), "set_retval fails without a retval");
} qr/No retval provided/, "set_retval displays warning when called without a retval";
}
done_testing();
|
