[svn:dbi] r15299 - in dbi/trunk: . t

Author: timbo
Date: Wed Apr 25 05:24:24 2012
New Revision: 15299

Modified:
   dbi/trunk/Changes
   dbi/trunk/DBI.pm
   dbi/trunk/t/10examp.t

Log:
Modified column renaming in fetchall_arrayref, added in 1.619, to work on column index numbers not names (an incompatible change).
Reworked the fetchall_arrayref documentation.
Hash slices in fetchall_arrayref now detect invalid column names.


Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes	(original)
+++ dbi/trunk/Changes	Wed Apr 25 05:24:24 2012
@@ -6,6 +6,13 @@
 
 =cut
 
+=head2 Changes in DBI 1.620 (svn r15299) 25th April 2012
+
+  Modified column renaming in fetchall_arrayref, added in 1.619,
+    to work on column index numbers not names (an incompatible change).
+  Reworked the fetchall_arrayref documentation.
+  Hash slices in fetchall_arrayref now detect invalid column names.
+
 =head2 Changes in DBI 1.619 (svn r15294) 23rd April 2012
 
   Fixed the connected method to stop showing the password in

Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm	(original)
+++ dbi/trunk/DBI.pm	Wed Apr 25 05:24:24 2012
@@ -2011,10 +2011,10 @@
         return undef if $max_rows and not $sth->FETCH('Active');
 
 	my $mode = ref($slice) || 'ARRAY';
-	$mode = 'HASH' if $mode eq 'REF' && ref($$slice) eq 'HASH';
 	my @rows;
-	my $row;
+
 	if ($mode eq 'ARRAY') {
+	    my $row;
 	    # we copy the array here because fetch (currently) always
 	    # returns the same array ref. XXX
 	    if ($slice && @$slice) {
@@ -2029,33 +2029,42 @@
 	    else {
 		push @rows, [ @$row ] while($row = $sth->fetch);
 	    }
+	    return \@rows
+	}
+
+	my %row;
+	if ($mode eq 'REF' && ref($$slice) eq 'HASH') { # \{ $idx => $name }
+            keys %$$slice; # reset the iterator
+            while ( my ($idx, $name) = each %$$slice ) {
+                $sth->bind_col($idx+1, \$row{$name});
+            }
 	}
 	elsif ($mode eq 'HASH') {
-	    $max_rows = -1 unless defined $max_rows;
-	    my (%row, $rename);
-	    if (ref($slice) eq 'REF') {
-		$rename = 1;
-		$slice = $$slice;
-	    }
-	    if ($rename || keys %$slice) {
-		my %map = $rename
-		    ? map { lc($_) => $slice->{$_} } keys %$slice
-		    : map { lc($_) => $_ } keys %$slice;
-                my $idx = 0;
-		for my $col_name ( @{$sth->FETCH('NAME_lc')} ) {
-                    ++$idx;
-                    next unless exists $map{$col_name};
-                    $sth->bind_col($idx, \$row{$map{$col_name}});
+            if (keys %$slice) {
+                keys %$slice; # reset the iterator
+                my $name2idx = $sth->FETCH('NAME_lc_hash');
+                while ( my ($name, $unused) = each %$slice ) {
+                    my $idx = $name2idx->{lc $name};
+                    return $sth->set_err($DBI::stderr, "Invalid column name '$name' for slice")
+                        if not defined $idx;
+                    $sth->bind_col($idx+1, \$row{$name});
                 }
 	    }
 	    else {
 		$sth->bind_columns( \( @row{ @{$sth->FETCH($sth->FETCH('FetchHashKeyName')) } } ) );
 	    }
-	    push @rows, { %row }
-		while ($max_rows-- and $sth->fetch);
-
 	}
-	else { Carp::croak("fetchall_arrayref($mode) invalid") }
+	else {
+            return $sth->set_err($DBI::stderr, "fetchall_arrayref($mode) invalid");
+        }
+
+        if (not defined $max_rows) {
+            push @rows, { %row } while ($sth->fetch); # full speed ahead!
+        }
+        else {
+            push @rows, { %row } while ($max_rows-- and $sth->fetch);
+        }
+
 	return \@rows;
     }
 
@@ -6403,20 +6412,6 @@
 With no parameters, or if $slice is undefined, C<fetchall_arrayref>
 acts as if passed an empty array ref.
 
-If $slice is a hash reference, C<fetchall_arrayref> fetches each row
-as a hash reference. If the $slice hash is empty then the keys in the
-hashes have whatever name lettercase is returned by default. (See
-L</FetchHashKeyName> attribute.) If the $slice hash is not empty, then
-it is used as a slice to select individual columns by name. The values
-of the hash should be set to 1. The key names of the returned hashes
-match the letter case of the names in the parameter hash, regardless of
-the L</FetchHashKeyName> attribute.
-
-If $slice is a reference to a hash reference, C<fetchall_arrayref>
-fetches each row as a hash reference, returning only the columns
-matching (case insensitively) the keys, renamed to the corresponding
-values in the hash.
-
 For example, to fetch just the first column of every row:
 
   $tbl_ary_ref = $sth->fetchall_arrayref([0]);
@@ -6425,22 +6420,35 @@
 
   $tbl_ary_ref = $sth->fetchall_arrayref([-2,-1]);
 
-To fetch all fields of every row as a hash ref:
+Those two examples both return a reference to an array of array refs.
+
+If $slice is a hash reference, C<fetchall_arrayref> fetches each row as a hash
+reference. If the $slice hash is empty then the keys in the hashes have
+whatever name lettercase is returned by default. (See L</FetchHashKeyName>
+attribute.) If the $slice hash is I<not> empty, then it is used as a slice to
+select individual columns by name. The values of the hash should be set to 1.
+The key names of the returned hashes match the letter case of the names in the
+parameter hash, regardless of the L</FetchHashKeyName> attribute.
+
+For example, to fetch all fields of every row as a hash ref:
 
   $tbl_ary_ref = $sth->fetchall_arrayref({});
 
 To fetch only the fields called "foo" and "bar" of every row as a hash ref
-(with keys named "foo" and "BAR"):
+(with keys named "foo" and "BAR", regardless of the original capitalization):
 
   $tbl_ary_ref = $sth->fetchall_arrayref({ foo=>1, BAR=>1 });
 
-To fetch only the fields "foo" and "bar" of every row as a hash ref
-(with keys renamed to "f" and "b", respectively):
+Those two examples both return a reference to an array of hash refs.
+
+If $slice is a I<reference to a hash reference>, that hash is used to select
+and rename columns. The keys are 0-based column index numbers and the values
+are the corresponding keys for the returned row hashes.
 
-  $tbl_ary_ref = $sth->fetchall_arrayref(\{ foo => "f", bar => "b" });
+For example, to fetch only the first and second columns of every row as a hash
+ref (with keys named "k" and "v" regardless of their original names):
 
-The first two examples return a reference to an array of array refs.
-The third and forth return a reference to an array of hash refs.
+  $tbl_ary_ref = $sth->fetchall_arrayref( \{ 0 => 'k', 1 => 'v' } );
 
 If $max_rows is defined and greater than or equal to zero then it
 is used to limit the number of rows fetched before returning.

Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t	(original)
+++ dbi/trunk/t/10examp.t	Wed Apr 25 05:24:24 2012
@@ -14,7 +14,7 @@
 require File::Spec;
 require VMS::Filespec if $^O eq 'VMS';
 
-use Test::More tests => 225;
+use Test::More tests => 229;
 
 do {
     # provide some protection against growth in size of '.' during the test
@@ -234,13 +234,19 @@
 ok($r->[0]->{SizE} == $row_a[1]);
 ok($r->[0]->{nAMe} eq $row_a[2]);
 
+ok ! $csr_b->fetchall_arrayref({ NoneSuch=>1 });
+like $DBI::errstr, qr/Invalid column name/;
+
 print "fetchall_arrayref renaming hash slice\n";
 ok($csr_b->execute());
-$r = $csr_b->fetchall_arrayref(\{ SizE=> "Koko", nAMe=>"Nimi"});
+$r = $csr_b->fetchall_arrayref(\{ 1 => "Koko", 2 => "Nimi"});
 ok($r && @$r);
 ok($r->[0]->{Koko} == $row_a[1]);
 ok($r->[0]->{Nimi} eq $row_a[2]);
 
+ok ! eval { $csr_b->fetchall_arrayref(\{ 9999 => "Koko" }) };
+like $@, qr/\Qis not a valid column/;
+
 print "fetchall_arrayref empty renaming hash slice\n";
 ok($csr_b->execute());
 $r = $csr_b->fetchall_arrayref(\{});
@@ -248,8 +254,8 @@
 ok(keys %{$r->[0]} == 0);
 
 ok($csr_b->execute());
-ok(!eval { $csr_b->fetchall_arrayref(\[]); 1 });
-like $@, qr/\Qfetchall_arrayref(REF) invalid/;
+ok(!$csr_b->fetchall_arrayref(\[]));
+like $DBI::errstr, qr/\Qfetchall_arrayref(REF) invalid/;
 
 print "fetchall_arrayref hash\n";
 ok($csr_b->execute());

• [svn:dbi] r15299 - in dbi/trunk: . t by timbo