The following (supplied by ilmari) copied from 76573 as it was the same
issue:
If $slice is a reference to a hash reference, 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.
---
DBI.pm | 26 ++++++++++++++++++++------
t/10examp.t | 19 ++++++++++++++++++-
2 files changed, 38 insertions(+), 7 deletions(-)
diff --git a/DBI.pm b/DBI.pm
index c0325ae..37c0e01 100644
--- a/DBI.pm
+++ b/DBI.pm
@@ -2011,6 +2011,7 @@ sub _new_sth { # called by
DBD::<drivername>::db::prepare)
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') {
@@ -2031,12 +2032,15 @@ sub _new_sth { # called by
DBD::<drivername>::db::prepare)
}
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 {
@@ -6403,6 +6407,11 @@ 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]);
@@ -6420,6 +6429,11 @@ To fetch only the fields called "foo" and "bar"
of every row as a hash ref
$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.
diff --git a/t/10examp.t b/t/10examp.t
index 7035b72..26c51f4 100644
--- a/t/10examp.t
+++ b/t/10examp.t
@@ -14,7 +14,7 @@ require File::Basename;
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 && @$r);
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({});
--
1.7.5.4
--
Martin J. Evans
Wetherby, UK
RT for rt.cpan.org