| Subject: | selectcol_arrayref and fetchall_hashref unimplemented? |
Some of the DBI calls seem to not be implemented so I coded the missing ones I needed as best I could.
methods added:
selectcol_arrayref
fetchrow_hashref
fetchall_hashref
I added tests for these in 64_selcol_fetchhash.t.
I am not certain if implementing selectcol_arrayref directly is the proper thing to do but it works now so hey =)
diff -Naur DBD-Mock-0.26/lib/DBD/Mock.pm DBD-Mock-0.26-fetch-col-hash/lib/DBD/Mock.pm
--- DBD-Mock-0.26/lib/DBD/Mock.pm 2005-04-22 14:00:40.000000000 -0700
+++ DBD-Mock-0.26-fetch-col-hash/lib/DBD/Mock.pm 2005-06-29 15:48:56.000000000 -0700
@@ -331,6 +331,19 @@
}
}
+sub selectcol_arrayref {
+ my ($dbh, $query, $attrib) = @_;
+ my $a_ref = $dbh->selectall_arrayref($query, $attrib);
+
+ my (@res_list, $res);
+
+ for $res (@{$a_ref}) {
+ push @res_list, ${ $res }[0];
+ }
+
+ return @res_list;
+}
+
sub FETCH {
my ( $dbh, $attrib ) = @_;
$dbh->trace_msg( "Fetching DB attrib '$attrib'\n" );
@@ -541,6 +554,60 @@
return $sth->DBD::Mock::st::fetch();
}
+sub fetchrow_hashref {
+ my ($sth) = @_;
+
+ my $tracker = $sth->FETCH( 'mock_my_history' );
+ my $rethash = {};
+ my $rec;
+
+ if ( defined ($rec = $tracker->next_record())) {
+ my $i;
+ my @fields = @{$tracker->fields};
+
+ for ($i=0;$i<(scalar @$rec);$i++) {
+ $rethash->{$fields[$i]} = $$rec[$i];
+ }
+
+ return $rethash;
+ }
+
+ return undef;
+}
+
+sub fetchall_hashref {
+ my ($sth, $keyfield) = @_;
+
+ my $tracker = $sth->FETCH( 'mock_my_history' );
+ my $rethash = {};
+ my $i;
+ my @fields = @{$tracker->fields};
+
+ # check if $keyfield is not an integer
+ if ( !($keyfield =~ /^-?\d+$/) ) {
+ my $keyind;
+
+ # search for index of item that matches $keyfield
+ for ($i=0;$i<scalar @fields;$i++) {
+ if ($fields[$i] eq $keyfield) {
+ $keyind = $i;
+ }
+ }
+
+ $keyfield = $keyind;
+ }
+
+ my $rec;
+ while ( defined ($rec = $tracker->next_record())) {
+ for ($i=0;$i<(scalar @$rec);$i++) {
+ $rethash->{$$rec[$keyfield]}->{$fields[$i]} = $$rec[$i];
+ }
+ }
+
+ return $rethash;
+}
+
+
sub finish {
my ($sth) = @_;
$sth->FETCH( 'mock_my_history' )->is_finished( 'yes' );
diff -Naur DBD-Mock-0.26/t/64_selcol_fetchhash.t DBD-Mock-0.26-fetch-col-hash/t/64_selcol_fetchhash.t
--- DBD-Mock-0.26/t/64_selcol_fetchhash.t 1969-12-31 16:00:00.000000000 -0800
+++ DBD-Mock-0.26-fetch-col-hash/t/64_selcol_fetchhash.t 2005-06-29 15:53:48.000000000 -0700
@@ -0,0 +1,82 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use Test::More tests => 5;
+
+BEGIN {
+ use_ok('DBD::Mock');
+ use_ok('DBI');
+}
+
+#use Data::Dumper qw( Dumper );
+
+my $swallow_sql = "SELECT id, type, inventory_id, species FROM birds WHERE species='swallow'";
+my $items_sql = "SELECT id, name, weight FROM items";
+my @resultList =
+ (
+ {
+ sql => $swallow_sql,
+ results => [
+ [ 'id', 'type', 'inventory_id' ],
+ [ '1', 'european', '42' ],
+ [ '27', 'african', '2' ],
+ ],
+ },
+ {
+ sql => $items_sql,
+ results => [
+ [ 'id', 'name', 'weight' ],
+ [ '2', 'coconuts', 'fairly hefty' ],
+ [ '42', 'not coconuts', 'pretty light' ],
+ ],
+ },
+ );
+
+my $coco_hash = {
+ 'id' => '2',
+ 'name' => 'coconuts',
+ 'weight' => 'fairly hefty',
+};
+
+my $not_coco_hash = {
+ 'id' => '42',
+ 'name' => 'not coconuts',
+ 'weight' => 'pretty light',
+};
+
+my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
+
+{
+ my $res;
+
+ foreach $res (@resultList) {
+ $dbh->{mock_add_resultset} = $res;
+ }
+}
+
+{
+ my @res = [];
+
+ my @expected = ('1','27');
+
+ eval {
+ @res = $dbh->selectcol_arrayref($swallow_sql);
+ };
+
+
+ is_deeply(\@res, \@expected, "Checking if selectcol_arrayref works.");
+}
+
+is_deeply(
+ $dbh->selectall_hashref($items_sql, 'id', "Checking selectall_hashref with named key."),
+ { '2' => $coco_hash,
+ '42' =>$not_coco_hash,
+ });
+
+is_deeply(
+ $dbh->selectall_hashref($items_sql, 1, "Checking selectall_hashref with named key."),
+ { 'coconuts' => $coco_hash,
+ 'not coconuts' =>$not_coco_hash,
+ });