{
our
@EXPORT
=
qw()
;
our
$VERSION
=
"12.014715"
;
our
$drh
=
undef
;
sub
driver{
return
$drh
if
$drh
;
my
(
$class
,
$attr
) =
@_
;
$class
.=
"::dr"
;
(
$drh
) = DBI::_new_drh(
$class
, {
'Name'
=>
'NullP'
,
'Version'
=>
$VERSION
,
'Attribution'
=>
'DBD Example Null Perl stub by Tim Bunce'
,
}, [
qw'example implementors private data'
]);
$drh
;
}
sub
CLONE {
undef
$drh
;
}
}
our
$imp_data_size
= 0;
sub
connect
{
my
$dbh
=
shift
->SUPER::
connect
(
@_
)
or
return
;
$dbh
->STORE(
Active
=> 1);
$dbh
;
}
sub
DESTROY {
undef
}
}
our
$imp_data_size
= 0;
sub
get_info {
my
(
$dbh
,
$type
) =
@_
;
if
(
$type
== 29) {
return
'"'
;
}
return
;
}
sub
table_info {
my
(
$dbh
,
$catalog
,
$schema
,
$table
,
$type
) =
@_
;
my
(
$outer
,
$sth
) = DBI::_new_sth(
$dbh
, {
'Statement'
=>
'tables'
,
});
if
(
defined
(
$type
) &&
$type
eq
'%'
&&
grep
{
defined
(
$_
) &&
$_
eq
''
} (
$catalog
,
$schema
,
$table
)) {
$outer
->{dbd_nullp_data} = [[
undef
,
undef
,
undef
,
'TABLE'
,
undef
],
[
undef
,
undef
,
undef
,
'VIEW'
,
undef
],
[
undef
,
undef
,
undef
,
'ALIAS'
,
undef
]];
}
elsif
(
defined
(
$catalog
) &&
$catalog
eq
'%'
&&
grep
{
defined
(
$_
) &&
$_
eq
''
} (
$schema
,
$table
)) {
$outer
->{dbd_nullp_data} = [[
'catalog1'
,
undef
,
undef
,
undef
,
undef
],
[
'catalog2'
,
undef
,
undef
,
undef
,
undef
]];
}
else
{
$outer
->{dbd_nullp_data} = [[
'catalog'
,
'schema'
,
'table1'
,
'TABLE'
]];
$outer
->{dbd_nullp_data} = [[
'catalog'
,
'schema'
,
'table2'
,
'TABLE'
]];
$outer
->{dbd_nullp_data} = [[
'catalog'
,
'schema'
,
'table3'
,
'TABLE'
]];
}
$outer
->STORE(
NUM_OF_FIELDS
=> 5);
$sth
->STORE(
Active
=> 1);
return
$outer
;
}
sub
prepare {
my
(
$dbh
,
$statement
)=
@_
;
my
(
$outer
,
$sth
) = DBI::_new_sth(
$dbh
, {
'Statement'
=>
$statement
,
});
return
$outer
;
}
sub
FETCH {
my
(
$dbh
,
$attrib
) =
@_
;
return
$dbh
->SUPER::FETCH(
$attrib
);
}
sub
STORE {
my
(
$dbh
,
$attrib
,
$value
) =
@_
;
if
(
$attrib
eq
'AutoCommit'
) {
Carp::croak(
"Can't disable AutoCommit"
)
unless
$value
;
$value
= (
$value
) ? -901 : -900;
}
elsif
(
$attrib
eq
'nullp_set_err'
) {
$dbh
->set_err(
$value
,
$value
);
}
return
$dbh
->SUPER::STORE(
$attrib
,
$value
);
}
sub
ping { 1 }
sub
disconnect {
shift
->STORE(
Active
=> 0);
}
}
our
$imp_data_size
= 0;
sub
bind_param {
my
(
$sth
,
$param
,
$value
,
$attr
) =
@_
;
$sth
->{ParamValues}{
$param
} =
$value
;
$sth
->{ParamAttr}{
$param
} =
$attr
if
defined
$attr
;
return
1;
}
sub
execute {
my
$sth
=
shift
;
$sth
->bind_param(
$_
,
$_
[
$_
-1])
for
(1..
@_
);
if
(
$sth
->{Statement} =~ m/^ \s* SELECT \s+/xmsi) {
$sth
->STORE(
NUM_OF_FIELDS
=> 1);
$sth
->{NAME} = [
"fieldname"
];
my
$params
=
$sth
->{ParamValues} || {};
$sth
->{dbd_nullp_data} = [ @{
$params
}{
sort
keys
%$params
} ];
$sth
->STORE(
Active
=> 1);
}
elsif
(
$sth
->{Statement} =~ m/^ \s* SLEEP \s+ (\S+) /xmsi) {
my
$secs
= $1;
if
(
eval
{
require
Time::HiRes;
defined
&Time::HiRes::sleep
}) {
Time::HiRes::
sleep
(
$secs
);
}
else
{
sleep
$secs
;
}
}
elsif
(
$sth
->{Statement} =~ m/^ \s* ERROR \s+ (\d+) \s* (.*) /xmsi) {
return
$sth
->set_err($1, $2);
}
1;
}
sub
fetchrow_arrayref {
my
$sth
=
shift
;
my
$data
=
shift
@{
$sth
->{dbd_nullp_data}};
if
(!
$data
|| !
@$data
) {
$sth
->finish;
return
undef
;
}
return
$sth
->_set_fbav(
$data
);
}
*fetch
= \
&fetchrow_arrayref
;
sub
FETCH {
my
(
$sth
,
$attrib
) =
@_
;
return
$sth
->SUPER::FETCH(
$attrib
);
}
sub
STORE {
my
(
$sth
,
$attrib
,
$value
) =
@_
;
return
$sth
->SUPER::STORE(
$attrib
,
$value
);
}
}
1;