On Thu Jun 20 17:19:37 2013, pianohacker@gmail.com wrote:
Show quoted text> From the DBI documentation:
>
> For queries returning more than one 'key' column, you can specify
> multiple column names by passing $key_field as a reference to an array
> containing one or more key column names (or
> index numbers). For example:
>
> $sth = $dbh->prepare("SELECT foo, bar, baz FROM table");
> $sth->execute;
> $hash_ref = $sth->fetchall_hashref( [ qw(foo bar) ] );
> print "For foo 42 and bar 38, baz is
> $hash_ref->{42}->{38}->{baz}\n"
>
I've attached a patch that adds support for multiple key fields. It also fixes a bug when the key field is given as a number instead of a column name: numeric key fields are one-indexed, but the code was assuming they are zero-indexed.
This patch is based on the implementation of fetchall_hashref in DBI v1.641 (
https://metacpan.org/source/TIMB/DBI-1.641/DBI.pm#L2101). Support for multiple key fields was introduced in DBI v1.48; previous versions choke if you pass an arrayref. If DBD::Mock needs to mimic that behavior for older versions of DBI, this patch will need to be tweaked.
diff -rupN DBD-Mock-1.45/lib/DBD/Mock/st.pm DBD-Mock-1.45-new/lib/DBD/Mock/st.pm
--- DBD-Mock-1.45/lib/DBD/Mock/st.pm 2012-10-21 20:45:29.000000000 -0500
+++ DBD-Mock-1.45-new/lib/DBD/Mock/st.pm 2018-08-13 12:05:06.000000000 -0500
@@ -237,45 +237,59 @@ sub fetchall_hashref {
}
$dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
- my $tracker = $sth->FETCH('mock_my_history');
- my $rethash = {};
-
- # get the name set by
- my $name = $sth->{Database}->FETCH('FetchHashKeyName') || 'NAME';
- my $fields = $sth->FETCH($name);
-
- # check if $keyfield is not an integer
- if ( !( $keyfield =~ /^-?\d+$/ ) ) {
- my $found = 0;
-
- # search for index of item that matches $keyfield
- foreach my $index ( 0 .. scalar( @{$fields} ) ) {
- if ( $fields->[$index] eq $keyfield ) {
- $found++;
+ # get the case conversion to use for hash key names (NAME/NAME_lc/NAME_uc)
+ my $hash_key_name = $sth->{Database}->FETCH('FetchHashKeyName') || 'NAME';
- # now make the keyfield the index
- $keyfield = $index;
-
- # and jump out of the loop :)
- last;
- }
+ # get a hashref mapping field names to their corresponding indexes. indexes
+ # start at zero
+ my $names_hash = $sth->FETCH("${hash_key_name}_hash");
+
+ # as of DBI v1.48, the $keyfield argument can be either an arrayref of field
+ # names/indexes or a single field name/index
+ my @key_fields = ref $keyfield ? @{$keyfield} : $keyfield;
+
+ my $num_fields = $sth->FETCH('NUM_OF_FIELDS');
+
+ # get the index(es) of the given key field(s). a key field can be specified
+ # as either the name of a field or an integer column number
+ my @key_indexes;
+ foreach my $field (@key_fields) {
+ if (defined $names_hash->{$field}) {
+ push @key_indexes, $names_hash->{$field};
+ }
+ elsif (DBI::looks_like_number($field) && $field >= 1 && $field <= $num_fields) {
+ # convert from column number to array index. column numbers start at
+ # one, while indexes start at zero
+ push @key_indexes, $field - 1;
}
- unless ($found) {
- $dbh->set_err( 1, "Could not find key field '$keyfield'" );
+ else {
+ my $err = "Could not find key field '$field' (not one of " .
+ join(' ', keys %{$names_hash}) . ')';
+ $dbh->set_err( 1, $err );
return;
}
}
+ my $tracker = $sth->FETCH('mock_my_history');
+ my $rethash = {};
+
# now loop through all the records ...
while ( my $record = $tracker->next_record() ) {
- # copy the values so as to preserve
- # the original record...
- my @values = @{$record};
-
- # populate the hash
- $rethash->{ $record->[$keyfield] } =
- { map { $_ => shift(@values) } @{$fields} };
+ # populate the hash, adding a layer of nesting for each key field
+ # specified by the user
+ my $ref = $rethash;
+ foreach my $index (@key_indexes) {
+ my $value = $record->[$index];
+ $ref->{$value} = {} if ! defined $ref->{$value};
+ $ref = $ref->{$value};
+ }
+
+ # copy all of the returned data into the most-nested level of the hash
+ foreach my $field (keys %{$names_hash}) {
+ my $index = $names_hash->{$field};
+ $ref->{$field} = $record->[$index];
+ }
}
return $rethash;
diff -rupN DBD-Mock-1.45/t/024_selcol_fetchhash.t DBD-Mock-1.45-new/t/024_selcol_fetchhash.t
--- DBD-Mock-1.45/t/024_selcol_fetchhash.t 2011-06-30 21:15:57.000000000 -0500
+++ DBD-Mock-1.45-new/t/024_selcol_fetchhash.t 2018-08-13 12:03:31.000000000 -0500
@@ -3,7 +3,7 @@ use 5.006;
use strict;
use warnings;
-use Test::More tests => 8;
+use Test::More tests => 11;
BEGIN {
use_ok('DBD::Mock');
@@ -88,8 +88,27 @@ is_deeply(
'... selectall_hashref worked correctly');
is_deeply(
- $dbh->selectall_hashref($items_sql, 1, "Checking selectall_hashref with named key."),
+ $dbh->selectall_hashref($items_sql, 2, "Checking selectall_hashref with numeric key."),
{ 'coconuts' => $coco_hash,
'not coconuts' => $not_coco_hash,
},
'... selectall_hashref worked correctly');
+
+is_deeply(
+ $dbh->selectall_hashref($items_sql, ['id', 'name'], "Checking selectall_hashref with array of named keys."),
+ { 2 => { 'coconuts' => $coco_hash, },
+ 42 => { 'not coconuts' => $not_coco_hash },
+ },
+ '... selectall_hashref worked correctly');
+
+is_deeply(
+ $dbh->selectall_hashref($items_sql, [1, 2], "Checking selectall_hashref with array of numeric keys."),
+ { 2 => { 'coconuts' => $coco_hash, },
+ 42 => { 'not coconuts' => $not_coco_hash },
+ },
+ '... selectall_hashref worked correctly');
+
+is_deeply(
+ $dbh->selectall_hashref($items_sql, [], "Checking selectall_hashref with empty array of keys."),
+ { %{$not_coco_hash} },
+ '... selectall_hashref worked correctly');
