Author: timbo
Date: Sat May 2 15:38:41 2009
New Revision: 12736
Modified:
dbi/trunk/Changes
dbi/trunk/DBI.pm
dbi/trunk/dbixs_rev.h
dbi/trunk/lib/DBD/File.pm
dbi/trunk/t/50dbm.t
Log:
Fix subtle bug in FETCH_many when using drivers that (incorrectly) return an
empty list from FETCH().
Fix DBD::File's FETCH to not return an empty list.
Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes (original)
+++ dbi/trunk/Changes Sat May 2 15:38:41 2009
@@ -67,6 +67,8 @@
Fixed DBD_ATTRIB_DELETE macro for driver authors
and updated DBI::DBD docs thanks to Martin J. Evans.
Fixed 64bit issues in trace messages thanks to Charles Jardine.
+ Fixed FETCH_many() method to work with drivers that incorrectly return
+ an empty list from $h->FETCH. Affected gofer.
Corrected many typos in DBI docs thanks to Martin J. Evans.
Improved DBI::DBD docs thanks to H.Merijn Brand.
Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm (original)
+++ dbi/trunk/DBI.pm Sat May 2 15:38:41 2009
@@ -1332,7 +1332,9 @@
sub FETCH_many { # XXX should move to C one day
my $h = shift;
- return map { $h->FETCH($_) } @_;
+ # scalar is needed to workaround drivers that return an empty list
+ # for some attributes
+ return map { scalar $h->FETCH($_) } @_;
}
*dump_handle = \&DBI::dump_handle;
Modified: dbi/trunk/dbixs_rev.h
==============================================================================
--- dbi/trunk/dbixs_rev.h (original)
+++ dbi/trunk/dbixs_rev.h Sat May 2 15:38:41 2009
@@ -1,3 +1,2 @@
-/* Mon Mar 2 11:10:31 2009 */
-/* Code modified since last checkin */
-#define DBIXS_REVISION 12558
+/* Sat May 2 16:48:00 2009 */
+#define DBIXS_REVISION 12733
Modified: dbi/trunk/lib/DBD/File.pm
==============================================================================
--- dbi/trunk/lib/DBD/File.pm (original)
+++ dbi/trunk/lib/DBD/File.pm Sat May 2 15:38:41 2009
@@ -593,12 +593,12 @@
{
my ($sth, $attrib) = @_;
exists $unsupported_attrib{$attrib}
- and return; # Workaround for a bug in DBI 0.93
+ and return undef; # Workaround for a bug in DBI 0.93
$attrib eq "NAME" and
return $sth->FETCH ("f_stmt")->{NAME};
if ($attrib eq "NULLABLE") {
my ($meta) = $sth->FETCH ("f_stmt")->{NAME}; # Intentional !
- $meta or return;
+ $meta or return undef;
return [ (1) x @$meta ];
}
if ($attrib eq lc $attrib) {
Modified: dbi/trunk/t/50dbm.t
==============================================================================
--- dbi/trunk/t/50dbm.t (original)
+++ dbi/trunk/t/50dbm.t Sat May 2 15:38:41 2009
@@ -23,6 +23,7 @@
# next line forces use of Nano rather than default behaviour
$ENV{DBI_SQL_NANO}=1;
+ push @mldbm_types, '';
if (eval { require 'MLDBM.pm'; }) {
push @mldbm_types, 'Data::Dumper' if eval { require 'Data/Dumper.pm' };
push @mldbm_types, 'Storable' if eval { require 'Storable.pm' };
@@ -55,7 +56,10 @@
print "Using DBM modules: @dbm_types\n";
print "Using MLDBM serializers: @mldbm_types\n" if @mldbm_types;
- my $num_tests = (1...@mldbm_types) * @dbm_types * 12;
+ my $tests_in_group = 14;
+ my $num_tests = @dbm_types * @mldbm_types * $tests_in_group;
+ printf "Test count: %d x %d x %d = %d\n",
+ scalar @dbm_types, 0...@mldbm_types, $tests_in_group, $num_tests;
if (!$num_tests) {
plan skip_all => "No DBM modules available";
@@ -72,7 +76,7 @@
my( $two_col_sql,$three_col_sql ) = split /\n\n/,join '',<DATA>;
-for my $mldbm ( '', @mldbm_types ) {
+for my $mldbm ( @mldbm_types ) {
my $sql = ($mldbm) ? $three_col_sql : $two_col_sql;
my @sql = split /\n/, $sql;
for my $dbm_type ( @dbm_types ) {
