@EXPORT = qw(); # Do NOT @EXPORT anything.
$VERSION = substr(q
$Revision: 10.6 $, 9,-1);
# $Id: Sponge.pm,v 10.6 2001/03/30 14:35:41 timbo Exp $
# Copyright (c) 1994, Tim Bunce
# You may distribute under the terms of either the GNU General Public
# License or the Artistic License, as specified in the Perl README file.
$drh = undef; # holds driver handle once initialised
$err = 0; # The $DBI::err value
($drh) = DBI
::_new_drh
($class, {
'Attribution' => "DBD::Sponge $VERSION (fake cursor driver) by Tim Bunce",
{ package DBD
::Sponge
::dr
; # ====== DRIVER ======
# we use default (dummy) connect method
{ package DBD
::Sponge
::db
; # ====== DATABASE ======
my($dbh, $statement, $attribs) = @_;
my $rows = $attribs->{'rows'}
|| Carp
::croak
("No rows attribute supplied to prepare");
delete $attribs->{'rows'};
my ($outer, $sth) = DBI
::_new_sth
($dbh, {
'Statement' => $statement,
# we need to set NUM_OF_FIELDS
if ($attribs->{'NUM_OF_FIELDS'}) {
$numFields = $attribs->{'NUM_OF_FIELDS'};
} elsif ($attribs->{'NAME'}) {
$numFields = @
{$attribs->{NAME
}};
} elsif ($attribs->{'TYPE'}) {
$numFields = @
{$attribs->{TYPE
}};
} elsif (my $firstrow = $rows->[0]) {
$numFields = scalar @
$firstrow;
DBI
::set_err
($dbh, 1, 'Cannot determine NUM_OF_FIELDS');
$sth->STORE('NUM_OF_FIELDS' => $numFields);
$sth->{NAME
} = $attribs->{NAME
}
|| [ map { "col$_" } 1..$numFields ];
$sth->{TYPE
} = $attribs->{TYPE
}
|| [ (DBI
::SQL_VARCHAR
()) x
$numFields ];
$sth->{PRECISION
} = $attribs->{PRECISION
}
|| [ map { length($sth->{NAME
}->[$_]) } 0..$numFields -1 ];
[ 'VARCHAR', DBI
::SQL_VARCHAR
, undef, "'","'", undef, 0, 1, 1, 0, 0,0,undef,0,0 ],
# In reality this would interrogate the database engine to
# either return dynamic values that cannot be precomputed
# or fetch and cache attribute values too expensive to prefetch.
return 1 if $attrib eq 'AutoCommit';
# else pass up to DBI to handle
return $dbh->SUPER::FETCH
($attrib);
my ($dbh, $attrib, $value) = @_;
# would normally validate and only store known attributes
# else pass up to DBI to handle
if ($attrib eq 'AutoCommit') {
return 1 if $value; # is already set
croak
("Can't disable AutoCommit");
return $dbh->SUPER::STORE
($attrib, $value);
{ package DBD
::Sponge
::st
; # ====== STATEMENT ======
my $row = shift @
{$sth->{'rows'}};
$sth->STORE(Active
=> 0);
return $sth->_set_fbav($row);
*fetchrow_arrayref
= \
&fetch
;
# would normally validate and only fetch known attributes
# else pass up to DBI to handle
return $sth->SUPER::FETCH
($attrib);
my ($sth, $attrib, $value) = @_;
# would normally validate and only store known attributes
# else pass up to DBI to handle
return $sth->SUPER::STORE
($attrib, $value);