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

Author: mjevans
Date: Wed Apr 18 11:37:16 2012
New Revision: 15273

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

Log:
rt76572 - Allow renaming columns in fetchall_arrayref hash slices


Modified: dbi/trunk/Changes
==============================================================================
--- dbi/trunk/Changes	(original)
+++ dbi/trunk/Changes	Wed Apr 18 11:37:16 2012
@@ -10,6 +10,8 @@
 
   RT76520 - Optimize fetchall_arrayref with hash slice thanks
     to Dagfinn Ilmari Manns�ker
+  RT76572 - Allow renaming columns in fetchall_arrayref hash slices
+    thanks to Dagfinn Ilmari Manns�ker
 
 =head2 Changes in DBI 1.619-TRIAL (svn r15271) 18th April 2012
 

Modified: dbi/trunk/DBI.pm
==============================================================================
--- dbi/trunk/DBI.pm	(original)
+++ dbi/trunk/DBI.pm	Wed Apr 18 11:37:16 2012
@@ -2009,6 +2009,7 @@
         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') {
@@ -2029,12 +2030,15 @@
 	}
 	elsif ($mode eq 'HASH') {
 	    $max_rows = -1 unless defined $max_rows;
-            # XXX It would be very helpful for DBIx::Class and others
-            # if a slice could 'rename' columns. Some kind of 'renaming slice'
-            # could be incorporated here.
-	    my %row;
-	    if (keys %$slice) {
-		my %map = map { lc($_) =>  $_ } keys %$slice;
+	    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;
 		$sth->bind_columns( map { exists $map{$_} ? \$row{$map{$_}} : \do { my $dummy } } @{$sth->FETCH('NAME_lc')} );
 	    }
 	    else {
@@ -6398,8 +6402,13 @@
 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.
+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:
 
@@ -6418,6 +6427,11 @@
 
   $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):
+
+  $tbl_ary_ref = $sth->fetchall_arrayref(\{ foo => "f", bar => "b" });
+
 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.
 

Modified: dbi/trunk/t/10examp.t
==============================================================================
--- dbi/trunk/t/10examp.t	(original)
+++ dbi/trunk/t/10examp.t	Wed Apr 18 11:37:16 2012
@@ -14,7 +14,7 @@
 require File::Spec;
 require VMS::Filespec if $^O eq 'VMS';
 
-use Test::More tests => 215;
+use Test::More tests => 225;
 
 do {
     # provide some protection against growth in size of '.' during the test
@@ -234,6 +234,23 @@
 ok($r->[0]->{SizE} == $row_a[1]);
 ok($r->[0]->{nAMe} eq $row_a[2]);
 
+print "fetchall_arrayref renaming hash slice\n";
+ok($csr_b->execute());
+$r = $csr_b->fetchall_arrayref(\{ SizE=> "Koko", nAMe=>"Nimi"});
+ok($r && @$r);
+ok($r->[0]->{Koko} == $row_a[1]);
+ok($r->[0]->{Nimi} eq $row_a[2]);
+
+print "fetchall_arrayref empty renaming hash slice\n";
+ok($csr_b->execute());
+$r = $csr_b->fetchall_arrayref(\{});
+ok($r && @$r);
+ok(keys %{$r->[0]} == 0);
+
+ok($csr_b->execute());
+ok(!eval { $csr_b->fetchall_arrayref(\[]); 1 });
+like $@, qr/\Qfetchall_arrayref(REF) invalid/;
+
 print "fetchall_arrayref hash\n";
 ok($csr_b->execute());
 $r = $csr_b->fetchall_arrayref({});

• [svn:dbi] r15273 - in dbi/trunk: . t by mjevans