Browse files

1.33 release

  • Loading branch information...
1 parent 180b85c commit b1095751a5f7d2633eeee5f2661d251c0480f2a4 Stevan Little committed Feb 6, 2006
Showing with 209 additions and 16 deletions.
  1. +5 −0 Changes
  2. +0 −4 MANIFEST
  3. +3 −0 MANIFEST.SKIP
  4. +1 −1 README
  5. +52 −10 lib/DBD/Mock.pm
  6. +148 −1 t/023_statement_failure.t
View
5 Changes
@@ -1,5 +1,10 @@
Revision history for Perl extension DBD::Mock.
+1.33
+ - Thanks to Chas Owens for patch and test
+ for the mock_can_prepare, mock_can_execute,
+ and mock_can_fetch features.
+
1.32 Wed Dec 14, 2005
- Fixed RT Bug #15599
- Fixed RT Bug #15602
View
4 MANIFEST
@@ -1,14 +1,10 @@
-.DS_Store
Build.PL
Changes
-lib/.DS_Store
-lib/DBD/.DS_Store
lib/DBD/Mock.pm
Makefile.PL
MANIFEST
META.yml
README
-t/.DS_Store
t/000_basic.t
t/001_db_handle.t
t/002_dr_handle.t
View
3 MANIFEST.SKIP
@@ -24,3 +24,6 @@
# Devel::Cover
^cover_db/?
+
+# Mac OS X resource forks
+\.DS_Store
View
2 README
@@ -26,7 +26,7 @@ This module requires these other modules and libraries:
COPYRIGHT AND LICENCE
Copyright (C) 2004 Chris Winters <chris@cwinters.com>
-Copyright (C) 2004 & 2005 Stevan Little <stevan@iinteractive.com>
+Copyright (C) 2004-2006 Stevan Little <stevan@iinteractive.com>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
View
62 lib/DBD/Mock.pm
@@ -7,7 +7,7 @@ sub import {
}
# --------------------------------------------------------------------------- #
-# Copyright (c) 2004 Stevan Little, Chris Winters
+# Copyright (c) 2004-2006 Stevan Little, Chris Winters
# (spawned from original code Copyright (c) 1994 Tim Bunce)
# --------------------------------------------------------------------------- #
# You may distribute under the terms of either the GNU General Public
@@ -19,7 +19,7 @@ use warnings;
require DBI;
-our $VERSION = '1.32';
+our $VERSION = '1.33';
our $drh = undef; # will hold driver handle
our $err = 0; # will hold any error codes
@@ -117,6 +117,10 @@ sub connect {
mock_statement_history => [],
# ability to fake a failed DB connection
mock_can_connect => 1,
+ # ability to make other things fail :)
+ mock_can_prepare => 1,
+ mock_can_execute => 1,
+ mock_can_fetch => 1,
# rest of attributes
%{ $attributes },
}) || return;
@@ -203,6 +207,17 @@ sub get_info {
sub prepare {
my($dbh, $statement) = @_;
+
+ unless ($dbh->{mock_can_connect}) {
+ $dbh->DBI::set_err(1, "No connection present");
+ return;
+ }
+ unless ($dbh->{mock_can_prepare}) {
+ $dbh->DBI::set_err(1, "Cannot prepare");
+ return;
+ }
+ $dbh->{mock_can_prepare}++ if $dbh->{mock_can_prepare} < 0;
+
eval {
foreach my $parser ( @{ $dbh->{mock_parser} } ) {
@@ -555,6 +570,11 @@ sub execute {
$dbh->DBI::set_err(1, "No connection present");
return 0;
}
+ unless ($dbh->{mock_can_execute}) {
+ $dbh->DBI::set_err(1, "Cannot execute");
+ return 0;
+ }
+ $dbh->{mock_can_execute}++ if $dbh->{mock_can_execute} < 0;
my $tracker = $sth->FETCH( 'mock_my_history' );
@@ -599,10 +619,16 @@ sub execute {
sub fetch {
my ($sth) = @_;
- unless ($sth->{Database}->{mock_can_connect}) {
- $sth->{Database}->DBI::set_err(1, "No connection present");
+ my $dbh = $sth->{Database};
+ unless ($dbh->{mock_can_connect}) {
+ $dbh->DBI::set_err(1, "No connection present");
return;
}
+ unless ($dbh->{mock_can_fetch}) {
+ $dbh->DBI::set_err(1, "Cannot fetch");
+ return;
+ }
+ $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
my $tracker = $sth->FETCH( 'mock_my_history' );
return $tracker->next_record;
@@ -622,12 +648,18 @@ sub fetchrow_arrayref {
sub fetchrow_hashref {
my ($sth, $name) = @_;
+ my $dbh = $sth->{Database};
# 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");
+ unless ($dbh->{mock_can_connect}) {
+ $dbh->DBI::set_err(1, "No connection present");
return;
}
+ unless ($dbh->{mock_can_fetch}) {
+ $dbh->DBI::set_err(1, "Cannot fetch");
+ return;
+ }
+ $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
# first handle the $name, it will default to NAME
$name ||= 'NAME';
@@ -651,12 +683,18 @@ sub fetchrow_hashref {
sub fetchall_hashref {
my ($sth, $keyfield) = @_;
+ my $dbh = $sth->{Database};
# 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");
+ unless ($dbh->{mock_can_connect}) {
+ $dbh->DBI::set_err(1, "No connection present");
return;
}
+ unless ($dbh->{mock_can_fetch}) {
+ $dbh->DBI::set_err(1, "Cannot fetch");
+ return;
+ }
+ $dbh->{mock_can_fetch}++ if $dbh->{mock_can_fetch} < 0;
my $tracker = $sth->FETCH( 'mock_my_history' );
my $rethash = {};
@@ -679,7 +717,7 @@ sub fetchall_hashref {
}
}
unless ($found) {
- $sth->{Database}->DBI::set_err(1, "Could not find key field '$keyfield'");
+ $dbh->DBI::set_err(1, "Could not find key field '$keyfield'");
return;
}
}
@@ -1939,11 +1977,15 @@ L<http://groups-beta.google.com/group/DBDMock>
=item Thanks to Andrew W. Gibbs for the C<mock_last_insert_ids> patch and test
+=item Thanks to Chas Owens for patch and test for the C<mock_can_prepare>, C<mock_can_execute>, and C<mock_can_fetch> features.
+
=back
=head1 COPYRIGHT
-Copyright (c) 2004 & 2005 Stevan Little, Chris Winters. All rights reserved.
+Copyright (C) 2004 Chris Winters <chris@cwinters.com>
+
+Copyright (C) 2004-2006 Stevan Little <stevan@iinteractive.com>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
View
149 t/023_statement_failure.t
@@ -1,6 +1,6 @@
use strict;
-use Test::More tests => 6;
+use Test::More tests => 28;
BEGIN {
use_ok('DBD::Mock');
@@ -28,4 +28,151 @@ BEGIN {
eval { $sth->execute() };
ok( $@, '$sth handled executed and died' );
+
+ $dbh->{mock_add_resultset} = {
+ sql => 'SELECT bar FROM foo',
+ results => [
+ [ 'bar' ],
+ [1], [2], [3], [4], [5], [6], [7], [8], [9], [10]
+ ]
+ };
+ #test new error generators
+ $dbh->{mock_can_prepare} = 0;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 1;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_arrayref) {
+ 1;
+ }
+ };
+ ok($@ =~ /Cannot prepare/, '$sth handle failed to prepare');
+
+ $dbh->{mock_can_prepare} = -3;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 1;
+ my $i = 0;
+ for (1 .. 10) {
+ $i++;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_arrayref) {
+ 1;
+ }
+ };
+ last if $@;
+ }
+ ok($@ =~ /Cannot prepare/, "$@ should contain 'Cannot prepare'");
+ ok($i == 4, "$i should be 4");
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 0;
+ $dbh->{mock_can_fetch} = 1;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_arrayref) {
+ 1;
+ }
+ };
+ ok($@ =~ /Cannot execute/, '$sth handle failed to execute');
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = -3;
+ $dbh->{mock_can_fetch} = 1;
+ $i = 0;
+ for (1 .. 10) {
+ $i++;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_arrayref) {
+ 1;
+ }
+ };
+ last if $@;
+ }
+ ok($@ =~ /Cannot execute/, "$@ should contain 'Cannot execute'");
+ ok($i == 4, "$i should be 4");
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 0;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_arrayref) {
+ 1;
+ }
+ };
+ ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch');
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 0;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my @row = $sth->fetchrow_array) {
+ 1;
+ }
+ };
+ ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch');
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 0;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ while (my $row = $sth->fetchrow_hashref) {
+ 1;
+ }
+ };
+ ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch');
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = 0;
+ eval {
+ my $sth = $dbh->prepare("SELECT bar FROM foo");
+ $sth->execute;
+ my @row = $sth->fetchall_arrayref;
+ };
+ ok($@ =~ /Cannot fetch/, '$sth handle failed to fetch');
+
+ $dbh->{mock_can_prepare} = 1;
+ $dbh->{mock_can_execute} = 1;
+ $dbh->{mock_can_fetch} = -100;
+ {
+ my $sth;
+ eval {
+ $sth = $dbh->prepare("select bar from foo");
+ $sth->execute;
+ };
+ ok(!$@, "prepare and execute should work");
+ isa_ok($sth, 'DBI::st');
+
+ eval { my $row = $sth->fetch };
+ ok(!$@, "fetch should work");
+ ok($dbh->{mock_can_fetch}==-99, "$dbh->{mock_can_fetch} should be -99");
+
+ eval { my $row = $sth->fetchrow_arrayref };
+ ok(!$@, "fetch should work");
+ ok($dbh->{mock_can_fetch}==-98, "$dbh->{mock_can_fetch} should be -98");
+
+ eval { my @row = $sth->fetchrow_array };
+ ok(!$@, "fetch should work");
+ ok($dbh->{mock_can_fetch}==-97, "$dbh->{mock_can_fetch} should be -97");
+
+ eval { my $row = $sth->fetchrow_hashref };
+ ok(!$@, "fetch should work");
+ ok($dbh->{mock_can_fetch}==-96, "$dbh->{mock_can_fetch} should be -96");
+
+ eval { my @rows = $sth->fetchall_arrayref };
+ ok(!$@, "fetch should work");
+ ok($dbh->{mock_can_fetch}==-95, "$dbh->{mock_can_fetch} should be -95");
+ }
}

0 comments on commit b109575

Please sign in to comment.