Here is the fix:
sub execute and sub bind_param in DBD\ADO.pm were modified to
handle undef in parameter values. Like below.
if(defined($val)){
......
......
}else{
$i->{Value} = Variant(VT_NULL);
}
Attached file contains new code for these 2 subs in full.
Thanks
On Mon, 30 Jun 2003 09:18:50 -0400 (EDT)
Yimin Zheng wrote:
>hi there,
>
>I am having trouble inserting null value into table using DBD:ADO
>and placeholders. I tried bind_param, bind_param_array and
execute_array,
>none worked. I tried MS Access and MS SQL server for data sources,
>none worked. There is no problem if I use dbi:ODBC instead
>to access the same backend database. So I think the problem
>must be in DBD:ADO.
>Below is the code that I tested and failed. Am I the only one
>with this problem?
>
>Thank you
>
>---------------------
>code 1, using bind_param:
>$sth = $dbh->prepare("INSERT INTO tbl_parameter VALUES (?, ?, ?)");
>$sth->bind_param(1, "name");
>$sth->bind_param(2, "value");
>$sth->bind_param(3, undef);
>$sth->execute;
>
>result:
>Can't use string ("0") as an ARRAY ref while "strict refs" in
>use at C:/Perl/site/lib/DBD/ADO.pm line 1811.
>Connection open, destroy at test004.pl line 0
>
>---------------------
>code 2, using bind_param_array and execute_array:
>$sth = $dbh->prepare("INSERT INTO tbl_parameter VALUES (?, ?, ?)");
>$sth->bind_param_array(1, [undef]);
>$sth->bind_param_array(2, ["value"]);
>$sth->bind_param_array(3, ["description"]);
>$tuples = $sth->execute_array({ ArrayTupleStatus => [EMAIL PROTECTED]
>});
>
>result:
>DBD::ADO::st execute_array failed: Can't execute statement 'INSERT
>INTO tbl_parameter VALUES (?, ?, ?)':
>Lasterror: -2146824580: OLE exception from "ADODB.Command":
>
>Parameter object is improperly defined. Inconsistent or incomplete
>information was provided.
>
>Win32::OLE(0.1502) error 0x800a0e7c
> in METHOD/PROPERTYGET "Execute" at test004.pl line 56.
>
>---------------------
>code 3, using execute_array:
>$sth = $dbh->prepare("INSERT INTO tbl_parameter VALUES (?, ?, ?)");
>$tuples = $sth->execute_array({ ArrayTupleStatus => [EMAIL PROTECTED]
>}, [undef], ["value"], ["description"]);
>
>result:
>DBD::ADO::st execute_array failed: Can't execute statement 'INSERT
>INTO tbl_parameter VALUES (?, ?, ?)':
>Lasterror: -2146824580: OLE exception from "ADODB.Command":
>
>Parameter object is improperly defined. Inconsistent or incomplete
>information was provided.
>
>Win32::OLE(0.1502) error 0x800a0e7c
> in METHOD/PROPERTYGET "Execute" at test004.pl line 59.
>
>
>
>--------------------------------------------------------------------------
>Global Internet phone calls, voicemail, fax, e-mail and instant
messaging.
>Sign-up today at http://www.hotvoice.com
>
>
--------------------------------------------------------------------------
Global Internet phone calls, voicemail, fax, e-mail and instant messaging.
Sign-up today at http://www.hotvoice.com sub bind_param {
my ($sth, $pNum, $val, $attr) = @_;
my $conn = $sth->{ado_conn};
my $comm = $sth->{ado_comm};
my $ado_consts = $sth->{ado_dbh}->{ado_consts};
my $param_cnt = $sth->FETCH( 'NUM_OF_PARAMS' );
return DBI::set_err($sth, $DBD::ADO::err,
"Bind Parameters called with no parameters defined!")
unless $param_cnt;
return DBI::set_err($sth, $DBD::ADO::err,
"Bind Parameter $pNum outside current range of
$param_cnt.")
if ($pNum > $param_cnt or $pNum < 1);
# Get the data type
my $type = (ref $attr) ? $attr->{TYPE}: $attr;
# Convert from ODBC to ADO type
my $aType = &_convert_type($type);
my $pd;
my $params = $sth->{ado_params};
$params->[$pNum-1] = $val;
my $p = $comm->Parameters;
# Determine if the Parameter is defined.
my $i = $p->Item( $pNum -1 );
if(defined($val)){
if ($i->{Type} == $ado_consts->{adVarBinary} or
$i->{Type} ==
$ado_consts->{adLongVarBinary}
) {
# Deal with an image request.
my $sz = length $val;
#my $pic2 =
Variant(VT_UI1|VT_ARRAY,$i->{Size});
my $pic = Variant(VT_UI1|VT_ARRAY,$sz + 10);
$pic->Put($val);
$i->{Value} = $pic;
$sth->trace_msg( "->(VarBinary) : ". $i->Size.
" ". $i->Type. "\n");
} else {
$i->{Size} = $val? length $val: $aType->[2];
$i->{Value} = $val if $val;
$sth->trace_msg( "->(default) : ". $i->Size. "
". $i->Type. "\n");
}
}else{
$i->{Value} = Variant(VT_NULL);
}
return 1;
}
sub execute {
my ($sth, @bind_values) = @_;
my $comm = $sth->{ado_comm};
my $conn = $sth->{ado_conn};
my $ado_consts = $sth->{ado_dbh}->{ado_consts};
my $sql = $sth->FETCH("Statement");
$sth->trace_msg("-> execute state handler\n");
# If a record set is currently defined,
# release the set.
my $ors = $sth->{ado_rowset};
if (defined $ors) {
$ors->Close () if $ors and
$ors->State & $ado_consts->{adStateOpen};
$sth->STORE(ado_rowset => undef);
$ors = undef;
}
#
# If the application is excepting arguments, then
# process them here.
#
my $lastError;
my $rs;
my $p = $comm->Parameters;
$lastError = DBD::ADO::errors($conn);
return DBI::set_err($sth, $DBD::ADO::err,
"Execute Parameters failed 'ADODB.Command':
$lastError")
if $lastError and $DBD::ADO::err ne NOT_SUPPORTED;
my $not_supported = ( $DBD::ADO::err eq NOT_SUPPORTED ) || 0;
$sth->trace_msg( " -> Not Supported flag: $not_supported\n" );
my $parm_cnt = 0;
# Need to test if we can access the parameter attributes.
{
# Turn the OLE Warning Off for this test.
local ($Win32::OLE::Warn);
$Win32::OLE::Warn = 0;
$parm_cnt = $p->{Count};
$lastError = DBD::ADO::errors($conn);
$not_supported = ( $DBD::ADO::err eq EXCEPTION_OCC )
|| 0;
}
$sth->trace_msg( " -> Is the Parameter Object Supported? " .
($not_supported ? 'No' : 'Yes') . "\n" );
# Remember if the provider errored with a "not supported"
message.
return DBI::set_err( $sth, $DBD::ADO::err,
"Bind params passed without place holders")
if (@bind_values and $p->{Count} == 0);
my $x = 0;
# Convert the parameters as needed.
for (@bind_values) {
my $i = $p->Item($x);
# Fix from Jacqui Caren <[EMAIL PROTECTED]>,
if(defined($_)){
if ($i->{Type} == $ado_consts->{adVarBinary} or
$i->{Type} ==
$ado_consts->{adLongVarBinary}
) {
# Deal with an image request.
my $sz = length $_;
#my $pic =
Variant(VT_UI1|VT_ARRAY,$i->{Size});
my $pic = Variant(VT_UI1|VT_ARRAY,$sz
+ 10);
$pic->Put($_);
$i->{Value} = $pic;
} else {
$i->{Size} = length $_;
$i->{Value} = $_;
}
}else{
$i->{Value} = Variant(VT_NULL);
}
$sth->trace_msg("-> Bind parameter (execute): " .
$i->Type . "\n");
$x++;
}
$x = 0;
# If the provider errored with not_supported above in the
Parameters
# methods, do not attempt to display anything about the
object. If we
# it triggers warning message.
unless($not_supported) {
$sth->trace_msg( "-> Parameter count: " . $p->{Count}
. "\n");
while( $x < $p->{Count} ) {
my $params = $sth->{ado_params};
$sth->trace_msg( "-> Parameter $x: " .
($p->Item($x)->{Value}|| 'undef') . "\n");
$sth->trace_msg( "-> Parameter $x: " .
($params->[$x]||'undef') . "\n");
$x++;
}
}
# At this point a command is ready to execute. To allow for
different
# type of cursors, I need to create a recordset object.
# Return the affected number to rows.
my $rows = Variant->new($VT_I4_BYREF, 0);
# However, a RecordSet Open does not return affected rows. So
I need to
# determine if a recordset open is needed, or a command
execute.
# print "usecmd ", exists $sth->{ado_usecmd},
defined $sth->{ado_usecmd}, "\n";
# print "CursorType ", exists
$sth->{ado_attribs}->{CursorType}, defined $sth->{ado_attribs}->{CursorType}, "\n";
# print "cursortype ", exists $sth->{ado_cursortype},
defined $sth->{ado_cursortype}, "\n";
# print "users ", exists $sth->{ado_users},
defined $sth->{ado_users}, "\n";
my $UseRecordSet = (
not (exists $sth->{ado_usecmd}
and defined $sth->{ado_usecmd})
&& ((exists $sth->{ado_attribs}->{CursorType} and
defined $sth->{ado_attribs}->{CursorType})
|| (exists $sth->{ado_cursortype} and defined
$sth->{ado_cursortype})
|| (exists $sth->{ado_users} and
defined $sth->{ado_users}))
);
if ( $UseRecordSet ) {
$rs = Win32::OLE->new('ADODB.RecordSet');
$lastError = Win32::OLE->LastError;
return $sth->DBI::set_err(1,
"Can't create 'object ADODB.RecordSet':
$lastError")
if $lastError;
# Determine the the CursorType to use. The default is
adOpenForwardOnly.
my $cursortype = $ado_consts->{adOpenForwardOnly};
if ( exists $sth->{ado_attribs}->{CursorType} ) {
my $type = $sth->{ado_attribs}->{CursorType};
if (exists $ado_consts->{$type}) {
$sth->trace_msg( " -> Changing the
cursor type to $type\n" );
$cursortype = $ado_consts->{$type};
} else {
warn "Attempting to use an invalid
CursorType: $type : using default adOpenForwardOnly";
}
}
# Call to clear any previous error messages.
$lastError = DBD::ADO::errors($conn);
$sth->trace_msg( " Open record set using cursor type:
$cursortype\n" );
$rs->Open( $comm, undef, $cursortype );
# Execute the statement, get a recordset in return.
# $rs = $comm->Execute($rows);
$lastError = DBD::ADO::errors($conn);
return $sth->DBI::set_err( $DBD::ADO::err,
"Can't execute statement '$sql':
$lastError")
if $DBD::ADO::err;
} else {
# Execute the command.
# Execute the statement, get a recordset in return.
$rs = $comm->Execute($rows);
$lastError = DBD::ADO::errors($conn);
return $sth->DBI::set_err( $DBD::ADO::err,
"Can't execute statement '$sql':
$lastError")
if $DBD::ADO::err;
}
$sth->{ado_fields} = my $ado_fields = [
Win32::OLE::in($rs->Fields) ];
my $num_of_fields = @$ado_fields;
if ($num_of_fields == 0) { # assume non-select statement
# If the AutoCommit is on, Commit current
transaction.
$conn->CommitTrans
if $sth->{ado_dbh}->{AutoCommit}
and
$sth->{ado_dbh}->{ado_provider_support_auto_commit};
$lastError = DBD::ADO::errors($conn);
return DBI::set_err( $sth, $DBD::ADO::err,
"Execute: Commit failed:
$lastError")
if $lastError;
# Determine the effected row count?
my $c = ($rows->Value == 0 ? qq{0E0} :
$rows->Value);
$sth->STORE('rows', $c);
$sth->trace_msg("<- executed state handler (no
recordset)\n");
# Clean up the record set that isn't used.
if (defined $rs and (ref $rs) =~ /Win32::OLE/)
{
$rs->Close () if $rs and
$rs->State &
$ado_consts->{adStateOpen};
}
$rs = undef;
return ( $c );
}
$sth->STORE( ado_rowset => $rs );
# Current setting of RowsInCache?
my $rowcache = $sth->FETCH( 'RowCacheSize' );
if ( defined $rowcache and $rowcache > 0 ) {
my $currowcache = $rs->CacheSize( );
$sth->trace_msg( " changing the CacheSize
using RowCacheSize: $rowcache" );
$rs->CacheSize( $rowcache ) unless $rowcache
== $currowcache;
$lastError = DBD::ADO::errors($conn);
return $sth->DBI::set_err( $DBD::ADO::err,
" Unable to change CacheSize
to RowCacheSize : $rowcache : $lastError")
if $DBD::ADO::err;
warn "Changed CacheSize\n";
}
my $nof = $sth->FETCH('NUM_OF_FIELDS');
$sth->STORE(Active => 1);
$sth->STORE('NUM_OF_FIELDS' => $num_of_fields)
unless ($nof == $num_of_fields);
$sth->STORE( NAME => [ map { $_->Name }
@$ado_fields ] );
$sth->STORE( TYPE => [ map {
DBD::ADO::db::convert_ado_to_odbc($sth, $_->Type)
} @$ado_fields ] );
$sth->STORE( PRECISION => [ map { $_->Precision } @$ado_fields ] );
$sth->STORE( SCALE => [
map { $_->NumericScale } @$ado_fields ] );
$sth->STORE( NULLABLE =>
[
map { $_->Attributes & $ado_consts->{adFldMayBeNull}?
1 : 0 }
@$ado_fields
]
);
$sth->STORE( ado_type => [ map { $_->Type } @$ado_fields ] );
# print "May Defer"
# , join( ", "
# , map { $_->Attributes & $ado_consts->{adFldMayDefer}?
1 : 0 }
# @$ado_fields ), "\n";
# print "Is Long"
# , join( ", "
# , map { $_->Attributes & $ado_consts->{adFldLong}? 1 :
0 }
# @$ado_fields ), "\n";
$sth->STORE( CursorName => undef);
$sth->STORE( Statement => $rs->Source);
$sth->STORE( RowsInCache => $rs->CacheSize);
$sth->STORE( rows =>
$rs->RecordCount );
# We need to return a true value for a successful select
# -1 means total row count unavailable
$sth->trace_msg("<- executed state handler\n");
return $rs->RecordCount;
}
