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
} );
my
$sth
=
$dbh
->prepare(
'SELECT something FROM sometable'
);
$sth
->execute();
{
foreach
my
$method
( @{
$methods
{
'DBI::db'
} } ){
$instance
->set_retval(
method
=>
$method
,
retval
=>
undef
);
my
$retval
=
$dbh
->
$method
();
ok(!
$retval
,
$method
.
' returned undef'
);
}
foreach
my
$method
( @{
$methods
{
'DBI::st'
} } ){
$instance
->set_retval(
method
=>
$method
,
retval
=>
undef
);
my
$retval
=
$sth
->
$method
();
ok(!
$retval
,
$method
.
' returned undef'
);
}
$instance
->
reset
();
}
{
foreach
my
$method
( @{
$methods
{
'DBI::db'
} } ){
my
%args
= (
method
=>
$method
,
retval
=>
undef
,
err
=> 99,
errstr
=>
'Custom DBI error'
);
$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});
}
foreach
my
$method
( @{
$methods
{
'DBI::st'
} } ){
my
%args
= (
method
=>
$method
,
retval
=>
undef
,
err
=> 99,
errstr
=>
'Custom DBI error'
);
$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
();
}
{
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"
;
}
{
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"
;
}
{
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"
;
}
{
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();