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({});
