Permalink
Browse files

0.28 release

  • Loading branch information...
1 parent 0fc088e commit f819a97b2ce8fac4ec5c98d491516b8cd132dfe1 Stevan Little committed Jul 13, 2005
Showing with 97 additions and 49 deletions.
  1. +7 −0 Changes
  2. +1 −1 META.yml
  3. +1 −1 VERSION
  4. +80 −41 lib/DBD/Mock.pm
  5. +8 −6 t/024_selcol_fetchhash.t
View
@@ -1,5 +1,12 @@
Revision history for Perl extension DBD::Mock.
+0.28 Wen July 13, 2005
+ - update to patch from Andrew McHarg <amcharg@acm.org>
+ to fix behavior in selectcol_arrayref() methods and tests
+ - fix version in META.yml
+ - some refactoring of fetchall_hashref(), fetchrow_hashref()
+ to incorporate DBD-Mock error handling.
+
0.27 Mon July 11, 2005
- added NULL_RESULTSET constant
- now allowing errors to be set with mock_add_resultset.
View
@@ -1,6 +1,6 @@
#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
name: DBD-Mock
-version: 0.26
+version: 0.28
version_from: VERSION
installdirs: site
requires:
View
@@ -1 +1 @@
-$VERSION = '0.27';
+$VERSION = '0.28';
View
@@ -19,7 +19,7 @@ use warnings;
require DBI;
-our $VERSION = '1.30';
+our $VERSION = '1.31';
our $drh = undef; # will hold driver handle
our $err = 0; # will hold any error codes
@@ -347,17 +347,28 @@ sub prepare {
}
}
+# NOTE:
+# this method should work in most cases, however it does
+# not exactly follow the DBI spec in the case of error
+# handling. I am not sure if that level of detail is
+# really nessecary since it is a weird error conditon
+# which causes it to fail anyway. However if you find you do need it,
+# then please email me about it. I think it would be possible
+# to mimic it by accessing the DBD::Mock::StatementTrack
+# object directly.
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;
+ my ($dbh, $query, $attrib, @bindvalues) = @_;
+ # get all the columns ...
+ my $a_ref = $dbh->selectall_arrayref($query, $attrib, @bindvalues);
+
+ # if we get nothing back, or dont get an
+ # ARRAY ref back, then we can assume
+ # something went wrong, and so return undef.
+ return undef unless defined $a_ref || ref($a_ref) ne 'ARRAY';
+
+ # if we do get something then we
+ # grab all the columns out of it.
+ return [ map { $_->[0] } @{$a_ref} ]
}
sub FETCH {
@@ -587,52 +598,80 @@ sub fetchrow_arrayref {
}
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;
+ my ($sth, $name) = @_;
+ # handle any errors since we are grabbing
+ # from the tracker directly
+ unless ($sth->{Database}->{mock_can_connect}) {
+ $sth->{Database}->DBI::set_err(1, "No connection present");
+ return;
+ }
+
+ # first handle the $name, it will default to NAME
+ $name ||= 'NAME';
+ # then fetch the names from the $sth (per DBI spec)
+ my $fields = $sth->FETCH($name);
+
+ # now check the tracker ...
+ my $tracker = $sth->FETCH( 'mock_my_history' );
+ # and collect the results
+ if (my $record = $tracker->next_record()) {
+ my @values = @{$record};
+ return {
+ map {
+ $_ => shift(@values)
+ } @{$fields}
+ };
}
return undef;
}
sub fetchall_hashref {
my ($sth, $keyfield) = @_;
+ # handle any errors since we are grabbing
+ # from the tracker directly
+ unless ($sth->{Database}->{mock_can_connect}) {
+ $sth->{Database}->DBI::set_err(1, "No connection present");
+ return;
+ }
my $tracker = $sth->FETCH( 'mock_my_history' );
my $rethash = {};
- my @fields = @{$tracker->fields};
+
+ # 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 $keyind;
-
+ if (!($keyfield =~ /^-?\d+$/)) {
+ my $found = 0;
# search for index of item that matches $keyfield
- for (my $i = 0; $i < scalar @fields; $i++) {
- if ($fields[$i] eq $keyfield) {
- $keyind = $i;
- }
+ foreach my $index (0 .. scalar(@{$fields})) {
+ if ($fields->[$index] eq $keyfield) {
+ $found++;
+ # now make the keyfield the index
+ $keyfield = $index;
+ # and jump out of the loop :)
+ last;
+ }
+ }
+ unless ($found) {
+ $sth->{Database}->DBI::set_err(1, "Could not find key field '$keyfield'");
+ return;
}
-
- $keyfield = $keyind;
}
- my $rec;
- while ( defined ($rec = $tracker->next_record())) {
- for (my $i = 0; $i < (scalar @{$rec}); $i++) {
- $rethash->{$rec->[$keyfield]}->{$fields[$i]} = $rec->[$i];
- }
+ # 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}
+ };
}
return $rethash;
View
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use Test::More tests => 5;
+use Test::More tests => 7;
BEGIN {
use_ok('DBD::Mock');
@@ -55,28 +55,30 @@ my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
}
{
- my @res = [];
+ my $res;
my @expected = ('1','27');
eval {
- @res = $dbh->selectcol_arrayref($swallow_sql);
+ $res = $dbh->selectcol_arrayref($swallow_sql);
};
- is_deeply(\@res, \@expected, "Checking if selectcol_arrayref works.");
+ isa_ok(\$res, "REF");
+ isa_ok($res, "ARRAY");
+ 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,
+ '42' => $not_coco_hash,
},
'... selectall_hashref worked correctly');
is_deeply(
$dbh->selectall_hashref($items_sql, 1, "Checking selectall_hashref with named key."),
{ 'coconuts' => $coco_hash,
- 'not coconuts' =>$not_coco_hash,
+ 'not coconuts' => $not_coco_hash,
},
'... selectall_hashref worked correctly');

0 comments on commit f819a97

Please sign in to comment.