Author: timbo
Date: Fri May 26 02:49:32 2006
New Revision: 6349
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.xs
dbi/trunk/lib/DBI/PurePerl.pm
dbi/trunk/t/10examp.t
Log:
Fixed bind_col() to ignore undef as bind location, thanks to David Wheeler.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Fri May 26 02:49:32 2006
@@ -4,7 +4,7 @@
=cut
-=head2 Changes in DBI 1.51 (svn rev 6339), 25 May 2006
+=head2 Changes in DBI 1.51 (svn rev 6349), 26 May 2006
Fixed $dbh->clone method 'signature' thanks to Jeffrey Klein.
Fixed default ping() method to return false if !$dbh->{Active}.
@@ -13,6 +13,7 @@
Fixed DBD::Proxy to not alter $@ in disconnect or AUTOLOADd methods.
Fixed bind_columns() to use return set_err(...) instead of die()
to report incorrect number of parameters, thanks to Ben Thul.
+ Fixed bind_col() to ignore undef as bind location, thanks to David Wheeler.
Fixed for perl 5.9.x for non-threaded builds thanks to Nicholas Clark.
Users of Perl >= 5.9.x will require DBI >= 1.51.
Fixed fetching of rows as hash refs to preserve utf8 on field names
Modified: dbi/trunk/DBI.xs
==============================================================================
--- dbi/trunk/DBI.xs (original)
+++ dbi/trunk/DBI.xs Fri May 26 02:49:32 2006
@@ -1380,21 +1380,27 @@
? "" : " (perhaps you need to call execute first)");
}
- if (!SvROK(ref) || SvTYPE(SvRV(ref)) >= SVt_PVBM) /* XXX LV */
- croak("Can't %s->bind_col(%s, %s,...), need a reference to a scalar",
- neatsvpv(sth,0), neatsvpv(col,0), neatsvpv(ref,0));
-
if ( (av = DBIc_FIELDS_AV(imp_sth)) == Nullav)
av = dbih_setup_fbav(imp_sth);
if (DBIS_TRACE_LEVEL >= 3)
- PerlIO_printf(DBILOGFP," dbih_sth_bind_col %s => %s\n",
- neatsvpv(col,0), neatsvpv(ref,0));
+ PerlIO_printf(DBILOGFP," dbih_sth_bind_col %s => %s %s\n",
+ neatsvpv(col,0), neatsvpv(ref,0), neatsvpv(attribs,0));
if (idx < 1 || idx > fields)
croak("bind_col: column %d is not a valid column (1..%d)",
idx, fields);
+ if (!SvOK(ref) && SvREADONLY(ref)) { /* binding to literal undef */
+ /* presumably the call is just setting the TYPE or other atribs */
+ /* but this default method ignores attribs, so we just return */
+ return 1;
+ }
+
+ if (!SvROK(ref) || SvTYPE(SvRV(ref)) >= SVt_PVBM) /* XXX LV */
+ croak("Can't %s->bind_col(%s, %s,...), need a reference to a scalar",
+ neatsvpv(sth,0), neatsvpv(col,0), neatsvpv(ref,0));
+
/* use supplied scalar as storage for this column */
SvREADONLY_off(av);
av_store(av, idx-1, SvREFCNT_inc(SvRV(ref)) );
Modified: dbi/trunk/lib/DBI/PurePerl.pm
==============================================================================
--- dbi/trunk/lib/DBI/PurePerl.pm (original)
+++ dbi/trunk/lib/DBI/PurePerl.pm Fri May 26 02:49:32 2006
@@ -851,11 +851,14 @@
}
sub bind_col {
my ($h, $col, $value_ref,$from_bind_columns) = @_;
- $col-- unless $from_bind_columns; # XXX fix later
+ my $fbav = $h->{'_fbav'} ||= dbih_setup_fbav($h); # from _get_fbav()
+ my $num_of_fields = @$fbav;
+ DBI::croak("bind_col: column $col is not a valid column
(1..$num_of_fields)")
+ if $col < 1 or $col > $num_of_fields;
+ return 1 if not defined $value_ref; # ie caller is just trying to set TYPE
DBI::croak("bind_col($col,$value_ref) needs a reference to a scalar")
unless ref $value_ref eq 'SCALAR';
- my $fbav = $h->_get_fbav;
- $h->{'_bound_cols'}->[$col] = $value_ref;
+ $h->{'_bound_cols'}->[$col-1] = $value_ref;
return 1;
}
sub finish {
Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t (original)
+++ dbi/trunk/t/10examp.t Fri May 26 02:49:32 2006
@@ -7,11 +7,12 @@
use strict;
$^W = 1;
+$| = 1;
my $haveFileSpec = eval { require File::Spec };
require VMS::Filespec if $^O eq 'VMS';
-use Test::More tests => 258;
+use Test::More tests => 263;
# "globals"
my ($r, $dbh);
@@ -261,6 +262,11 @@
ok( ! $csr_a->bind_columns(undef, \($col0, $col1, $col2, $col3)) );
like $csr_a->errstr, '/bind_columns called with 4 values but 3 are needed/',
'errstr should contain error message';
+ok( $csr_a->bind_col(2, undef, { foo => 42 }) );
+ok ! eval { $csr_a->bind_col(0, undef) };
+like $@, '/bind_col: column 0 is not a valid column \(1..3\)/', 'errstr should
contain error message';
+ok ! eval { $csr_a->bind_col(4, undef) };
+like $@, '/bind_col: column 4 is not a valid column \(1..3\)/', 'errstr should
contain error message';
SKIP: {
