...
 
Commits (21)
......@@ -2,6 +2,13 @@ Revision history for Perl extension DBD::Mock.
{{$NEXT}}
1.48 2019-09-12T06:34:47Z
- Added execution_history feature to enable tracking of multiple
executes for prepared statements.
- Added support for $dbh->table_info calls
- Fixed bug rt91055 "insert IGNORE" doesn't raise last_insert_id
- Fixed bug rt82243 Bug with Regex in DBD::Mock::Session
1.47 2019-09-06T10:03:39Z
- Applied Max Carey's patch from rt86294 adding support for
nested keys to fetchall_hashref
......
......@@ -67,11 +67,12 @@
"web" : "https://gitlab.com/scrapheap/DBD-Mock"
}
},
"version" : "1.47",
"version" : "1.48",
"x_authority" : "cpan:JLCOOPER",
"x_contributors" : [
"Chisel <CHISEL@cpan.org>",
"Dave Rolsky <DROLSKY@cpan.org>",
"Frédéric Brière <FBRIERE@cpan.org>",
"Gines R <ginesr@gmail.com>",
"Max Carey <MHC@cpan.org>",
"gregor herrmann <gregoa@debian.org>",
......
This diff is collapsed.
......@@ -30,7 +30,7 @@ sub import {
if ( @_ && lc( $_[0] ) eq "pool" );
}
our $VERSION = '1.47';
our $VERSION = '1.48';
our $drh = undef; # will hold driver handle
our $err = 0; # will hold any error codes
......@@ -376,7 +376,7 @@ Note: The handle attribute C<Active> and the handle method C<ping> will behave a
=item B<mock_add_resultset( \@resultset | \%sql_and_resultset )>
This stocks the database handle with a record set, allowing you to seed data for your application to see if it works properly.. Each recordset is a simple arrayref of arrays with the first arrayref being the fieldnames used. Every time a statement handle is created it asks the database handle if it has any resultsets available and if so uses it.
This stocks the database handle with a record set, allowing you to seed data for your application to see if it works properly.. Each recordset is a simple arrayref of arrays with the first arrayref being the field names used. Every time a statement handle is created it asks the database handle if it has any resultsets available and if so uses it.
Here is a sample usage, partially from the test suite:
......@@ -444,7 +444,7 @@ If the C<sql> parameter is a regular expression reference then the results will
],
};
If an SQL statement matches both a specified SQL statement result set and a regular expresion result set then the specified SQL statement takes precedence. If two regular expression result sets match then the first one added takes precedence:
If an SQL statement matches both a specified SQL statement result set and a regular expression result set then the specified SQL statement takes precedence. If two regular expression result sets match then the first one added takes precedence:
# Set up our first regex matching result set
$dbh->{mock_add_resultset} = {
......@@ -659,6 +659,50 @@ The same using named parameters
$sth->bind_param( ':id' => 7783 );
$sth->bind_param( ':active' => 'yes' );
=item B<mock_param_attrs>
Returns an arrayref of any attributes (parameter type) defined for bound parameters (note: you rarely to define attributes for bound parameters). Where an attribute/type hasn't been that slot in the returned arrayref will be C<undef>. e.g. for:
my $sth = $dbh->prepare( 'SELECT * FROM foo WHERE id = ? AND is_active = ?' );
$sth->bind_param( 2, 'yes' );
$sth->bind_param( 1 7783, SQL_INTEGER );
This would return:
[ SQL_INTEGER, undef ]
Passing parameters via C<execute()> will always populate the array with C<undef>, so for:
$sth->execute( 7783, 'yes' );
This would return:
[ undef, undef ]
=item B<mock_execution_history>
Returns an arrayref where each entry contains the details for an execution of the prepared statement. e.g. after:
my $sth = $dbh->prepare( 'SELECT * FROM foo WHERE id = ? AND is_active = ?' );
$sth->bind_param( 2, 'yes' );
$sth->bind_param( 1 7783, SQL_INTEGER );
$sth->execute();
$sth->execute( 1023, 'no' );
Then C<<$sth->{mock_execution_history}>> would be:
[
{
params => [ 7783, 'yes' ],
attrs => [ SQL_INTEGER, undef ],
}, {
params => [ 1023, 'no' ],
attrs => [ undef, undef ],
}
]
=item B<mock_records>
An arrayref of arrayrefs representing the records the mock statement was stocked with.
......@@ -727,6 +771,10 @@ B<fields>: Arrayref of field names
B<bound_params>: Arrayref of bound parameters
=item *
B<bound_param_attrs>: Arrayref of bound parameter attributes
=back
=item B<statement> (Statement attribute 'mock_statement')
......@@ -791,7 +839,7 @@ Tells the tracker that the statement has been executed and resets the current re
=item B<next_record()>
If the statement has been depleted (all records returned) returns undef; otherwise it gets the current recordfor returning, increments the current record number and returns the current record.
If the statement has been depleted (all records returned) returns undef; otherwise it gets the current record for returning, increments the current record number and returns the current record.
=item B<to_string()>
......@@ -801,7 +849,7 @@ Tries to give an decent depiction of the object state for use in debugging.
=head1 DBD::Mock::StatementTrack::Iterator
This object can be used to iterate through the current set of C<DBD::Mock::StatementTrack> objects in the history by fetching the 'mock_all_history_iterator' attribute from a database handle. This object is very simple and is meant to be a convience to make writing long test script easier. Aside from the constructor (C<new>) this object has only one method.
This object can be used to iterate through the current set of C<DBD::Mock::StatementTrack> objects in the history by fetching the 'mock_all_history_iterator' attribute from a database handle. This object is very simple and is meant to be a convenience to make writing long test script easier. Aside from the constructor (C<new>) this object has only one method.
=over 4
......@@ -847,7 +895,7 @@ The DBD::Mock::Session object is an alternate means of specifying the SQL statem
As you can see, a session is essentially made up a list of HASH references we call 'states'. Each state has a 'statement' and a set of 'results'. If DBD::Mock finds a session in the 'mock_session' attribute, then it will pass the current C<$dbh> and SQL statement to that DBD::Mock::Session. The SQL statement will be checked against the 'statement' field in the current state. If it passes, then the 'results' of the current state will get feed to DBD::Mock through the 'mock_add_resultset' attribute. We then advance to the next state in the session, and wait for the next call through DBD::Mock. If at any time the SQL statement does not match the current state's 'statement', or the session runs out of available states, an error will be raised (and propagated through the normal DBI error handling based on your values for RaiseError and PrintError).
Also, as can be seen in the the session element, bound parameters can also be supplied and tested. In this statement, the SQL is compared, then when the statement is executed, the bound parameters are also checked. The bound parameters much match in both number of parameters and the parameters themselves, or an error will be raised.
As can be seen in the session element, bound parameters can also be supplied and tested. In this statement, the SQL is compared, then when the statement is executed, the bound parameters are also checked. The bound parameters much match in both number of parameters and the parameters themselves, or an error will be raised.
As can also be seen in the example above, 'statement' fields can come in many forms. The simplest is a string, which will be compared using C<eq> against the currently running statement. The next is a reg-exp reference, this too will get compared against the currently running statement. The last option is a CODE ref, this is sort of a catch-all to allow for a wide range of SQL comparison approaches (including using modules like SQL::Statement or SQL::Parser for detailed functional comparisons). The first argument to the CODE ref will be the currently active SQL statement to compare against, the second argument is a reference to the current state HASH (in case you need to alter the results, or store extra information). The CODE is evaluated in boolean context and throws and exception if it is false.
......@@ -879,7 +927,7 @@ All functionality listed here is highly experimental and should be used with gre
=item Error handling in I<mock_add_resultset>
We have added experimental erro handling in I<mock_add_resultset> the best example is the test file F<t/023_statement_failure.t>, but it looks something like this:
We have added experimental error handling in I<mock_add_resultset> the best example is the test file F<t/023_statement_failure.t>, but it looks something like this:
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
......@@ -960,6 +1008,41 @@ Or you can extend the existing set of callbacks with another using the C<DBD::Mo
};
} );
=item table_info
This feature adds support for DBI's C<table_info> method. To mock the table info for a search of the C<testSchema> database schema you would use the following:
$dbh->{mock_add_table_info} = {
cataloge => undef,
schema => 'testSchema',
table => undef,
type => undef,
table_info => [
[ 'TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS' ],
[ undef, 'testSchema', 'foo', 'TABLE', undef ],
[ undef, 'testSchema', 'bar', 'VIEW', undef ],
],
};
The C<cataloge>, C<schema>, C<table> and C<type> parameters need to explicitly match what you expect table_info to be called with (note: table_info treats C<undef> and C<''> the same).
Similar to the mock_results_sets, the C<table_info> parameter's first entry is an arrayref of column names, and the rest are the values of the rows returned (one arrayref per row).
If you need to cover listing schemas then you'd use:
$dbh->{mock_add_table_info} = {
schema => '%',
table_info => [
[ 'TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS' ],
[ undef, 'testSchema', undef, undef, undef ],
[ undef, 'testSchema_2', undef, undef, undef ],
],
}
To clear the current mocked table info set the database handle's C<mock_clear_table_info> attribute to 1
$dbh->{mock_clear_table_info} = 1;
=back
=head1 BUGS
......@@ -1000,12 +1083,6 @@ Test::MockObject article - L<http://www.perl.com/pub/a/2002/07/10/tmo.html>
Perl Code Kata: Testing Databases - L<http://www.perl.com/pub/a/2005/02/10/database_kata.html>
=head1 DISCUSSION GROUP
We have created a B<DBD::Mock> google group for discussion/questions about this module.
L<http://groups.google.com/group/DBDMock>
=head1 ACKNOWLEDGEMENTS
=over 4
......
......@@ -171,14 +171,16 @@ sub _verify_bound_param {
my $ref = ref $expected;
if ( $ref eq 'Regexp' and $got !~ /$expected/ ) {
die "Bound param $index do not match (using regexp) "
. "in current state in DBD::Mock::Session ($self->{name})"
. " got: $got\n"
. " expected: $expected";
}
if ( $ref eq 'Regexp' ) {
if ( $got !~ /$expected/ ) {
die "Bound param $index do not match (using regexp) "
. "in current state in DBD::Mock::Session ($self->{name})"
. " got: $got\n"
. " expected: $expected";
}
if ( $got ne $expected ) {
} elsif ( $got ne $expected ) {
die "Bound param $index do not match "
. "in current state in DBD::Mock::Session ($self->{name})\n"
. " got: $got\n"
......
......@@ -8,11 +8,12 @@ sub new {
# these params have default values
# but can be overridden
$params{return_data} ||= [];
$params{fields} ||= [];
$params{bound_params} ||= [];
$params{statement} ||= "";
$params{failure} ||= undef;
$params{return_data} ||= [];
$params{fields} ||= [];
$params{bound_params} ||= [];
$params{bound_param_attrs} ||= [];
$params{statement} ||= "";
$params{failure} ||= undef;
# these params should never be overridden
# and should always start out in a default
......@@ -61,7 +62,7 @@ sub bind_col {
}
sub bound_param {
my ( $self, $param_num, $value ) = @_;
my ( $self, $param_num, $value, $attr ) = @_;
# Basic support for named parameters
if ( $param_num !~ /^\d+/ ) {
......@@ -69,6 +70,8 @@ sub bound_param {
}
$self->{bound_params}->[ $param_num - 1 ] = $value;
$self->{bound_param_attrs}->[ $param_num - 1 ] = ref $attr eq "HASH" ? { %$attr } : $attr;
return $self->bound_params;
}
......@@ -85,6 +88,7 @@ sub bind_cols {
sub bind_params {
my ( $self, @values ) = @_;
@{ $self->{bound_params} } = @values;
@{ $self->{bound_param_attrs} } = map { undef } @values;
}
# Rely on the DBI's notion of Active: a statement is active if it's
......@@ -116,6 +120,12 @@ sub is_finished {
sub mark_executed {
my ($self) = @_;
push @{$self->{execution_history} }, {
params => [ @{ $self->{bound_params} } ],
attrs => [ @{ $self->{bound_param_attrs} } ],
};
$self->is_executed('yes');
$self->current_record_num(0);
}
......@@ -191,4 +201,16 @@ sub bound_params {
return $self->{bound_params};
}
sub bound_param_attrs {
my ( $self, @values ) = @_;
push @{ $self->{bound_param_attrs} }, @values if scalar @values;
return $self->{bound_param_attrs};
}
sub execution_history {
my ( $self, @values ) = @_;
push @{ $self->{execution_history} }, @values if scalar @values;
return $self->{execution_history};
}
1;
......@@ -4,6 +4,7 @@ use strict;
use warnings;
use List::Util qw( first );
use DBI;
our $imp_data_size = 0;
......@@ -23,6 +24,31 @@ sub get_info {
return $dbh->{mock_get_info}{$attr};
}
sub table_info {
my ( $dbh, @params ) = @_;
my ($cataloge, $schema, $table, $type) = map { $_ || '' } @params[0..4];
$dbh->{mock_table_info} ||= {};
my @tables = @{ $dbh->{mock_table_info}->{ $cataloge }->{ $schema }->{ $table }->{ $type } || [] };
my ($fieldNames, @rows) = map { [ @$_ ] } @tables;
$fieldNames ||= [];
my $sponge = DBI->connect('dbi:Sponge:', '', '' )
or return $dbh->DBI::set_err($DBI::err, "DBI::Sponge: $DBI::errstr");
my $sth = $sponge->prepare("table_info", {
rows => \@rows,
NUM_OF_FIELDS => scalar @$fieldNames,
NAME => $fieldNames
}) or return $dbh->DBI::set_err( $sponge->err(), $sponge->errstr() );
return $sth;
}
sub prepare {
my ( $dbh, $statement ) = @_;
......@@ -374,6 +400,24 @@ sub STORE {
elsif ( $attrib =~ /^mock_(add_)?data_sources/ ) {
$dbh->{Driver}->STORE( $attrib, $value );
}
elsif ( $attrib =~ /^mock_add_table_info$/ ) {
$dbh->{mock_table_info} ||= {};
if ( ref $value ne "HASH" ) {
die "mock_add_table_info needs a hash reference"
}
my ( $cataloge, $schema, $table, $type ) = map { defined $_ ? $_ : '' } @$value{qw( cataloge schema table type )};
$dbh->{mock_table_info}->{ $cataloge }->{ $schema }->{ $table }->{ $type } = $value->{table_info};
}
elsif ( $attrib =~ /^mock_clear_table_info$/ ) {
if ( $value ) {
$dbh->{mock_table_info} = {};
}
return {};
}
elsif ( $attrib =~ /^mock/ ) {
return $dbh->{$attrib} = $value;
}
......
......@@ -16,7 +16,7 @@ sub bind_col {
sub bind_param {
my ( $sth, $param_num, $val, $attr ) = @_;
my $tracker = $sth->FETCH('mock_my_history');
$tracker->bound_param( $param_num, $val );
$tracker->bound_param( $param_num, $val, $attr );
return 1;
}
......@@ -127,7 +127,7 @@ sub execute {
# -RobK, 2007-10-12
#use Data::Dumper;warn Dumper $dbh->{mock_last_insert_ids};
if ( $dbh->{Statement} =~ /^\s*?insert\s+into\s+(\S+)/i ) {
if ( $dbh->{Statement} =~ /^\s*?insert(?:\s+ignore)?\s+into\s+(\S+)/i ) {
if ( $dbh->{mock_last_insert_ids}
&& exists $dbh->{mock_last_insert_ids}{$1} )
{
......@@ -374,12 +374,18 @@ sub FETCH {
if ( $attrib eq 'mock_my_history' ) {
return $tracker;
}
if ( $attrib eq 'mock_statement' ) {
elsif ( $attrib eq 'mock_execution_history' ) {
return $tracker->execution_history();
}
elsif ( $attrib eq 'mock_statement' ) {
return $tracker->statement;
}
elsif ( $attrib eq 'mock_params' ) {
return $tracker->bound_params;
}
elsif ( $attrib eq 'mock_param_attrs' ) {
return $tracker->bound_param_attrs;
}
elsif ( $attrib eq 'mock_records' ) {
return $tracker->return_data;
}
......
use 5.008;
use strict;
use warnings;
use Test::More tests => 1;
use Test::More;
BEGIN {
use_ok( 'DBD::Mock' );
}
if ( $ENV{REPORT_TEST_ENVIRONMENT} ) {
warn "\n\nperl $^V ($^O)\n\n";
warn "\n\nperl $] ($^O)\n\n";
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 24;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -130,3 +133,5 @@ BEGIN {
$dbh->disconnect();
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 24;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -93,3 +96,5 @@ is_deeply(
$drh->{nothing} = 100;
ok(!defined($drh->{nothing}), '... we only support our attributes');
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 22;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -77,3 +80,5 @@ BEGIN {
$dbh->disconnect();
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 27;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -93,3 +96,5 @@ $sth->finish();
# mock_is_finished
is($sth->{mock_is_finished}, 'yes', '... and we are now finished');
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 26;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -134,3 +137,5 @@ BEGIN {
}
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 11;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -35,3 +38,5 @@ is($st_track->statement, 'SELECT foo FROM bar WHERE x = ?', '... our statements
my $params = $st_track->bound_params;
is(scalar(@{$params}), 1, '... got the expected amount of params');
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 25;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -86,3 +89,5 @@ like($@, qr/Attribute aliases not available for \'Fail\'/, '... got the error we
is($dbh->{mysql_insertid}, 1, '... our alias works');
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 5;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -18,3 +21,5 @@ BEGIN {
is($dbh, $dbh2, '.. these should be the same handles');
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 3;
use Test::More;
BEGIN {
use_ok('DBI');
......@@ -11,3 +14,5 @@ isa_ok($dbh, 'DBI::db');
$dbh->{mock_get_info} = { foo => 4 };
is( $dbh->get_info( 'foo' ), '4', "Retrieved info successfully" );
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 38;
use Test::More;
BEGIN {
use_ok('DBI');
......@@ -84,3 +87,4 @@ ok( @{$history->[2]->bound_params} == 0, 'No parameters' );
is( $history->[3]->statement, 'COMMIT' );
ok( @{$history->[3]->bound_params} == 0, 'No parameters' );
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 15;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -39,3 +42,5 @@ my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
is( $sth->{mock_is_finished}, 'yes',
'Finished flag set after finish()' );
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 15;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -55,3 +58,5 @@ BEGIN {
{ FOO => 0, BAR => 1, BAZ => 2 },
'... got the right NAME_hash_uc attributes');
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 18;
use Test::More;
use DBI qw( :sql_types );
BEGIN {
use_ok('DBD::Mock');
use_ok('DBI');
}
my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
......@@ -17,8 +20,58 @@ my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
$sth->bind_param( 1, 'baz' );
};
ok( ! $@, 'Parameters bound to statement handle with bind_param()' );
eval { $sth->execute() };
ok( ! $@, 'Called execute() ok (empty, after bind_param calls)' );
my $t_params = $sth->{mock_my_history}->bound_params;
is( scalar @{ $t_params }, 2,
'Correct number of parameters bound (method on tracker)' );
is( $t_params->[0], 'baz',
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
is( $t_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
my $param_attrs = $sth->{mock_my_history}->bound_param_attrs;
is( scalar @{ $param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is( $param_attrs->[0], undef,
"as we didn't specify any attributes/types for the first bound parameter then it should be undefined");
is( $param_attrs->[1], undef,
"as we didn't specify any attributes/types for the second bound parameter then it should be undefined");
my $a_params = $sth->{mock_params};
is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (attribute)' );
is( $a_params->[0], 'baz',
'Statement handle stored bound parameter from bind_param() (attribute)' );
is( $a_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (attribute)' );
my $a_param_attrs = $sth->{mock_param_attrs};
is( scalar @{ $a_param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is( $a_param_attrs->[0], undef,
"as we didn't specify any attributes/types for the first bound parameter then it should be undefined");
is( $a_param_attrs->[1], undef,
"as we didn't specify any attributes/types for the second bound parameter then it should be undefined");
}
{
my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
my $sth = eval { $dbh->prepare( $sql ) };
eval {
$sth->bind_param( 2, 'bar', SQL_VARCHAR );
$sth->bind_param( 1, 'baz', { TYPE => SQL_VARCHAR } );
};
ok( ! $@, 'Parameters bound to statement handle with bind_param()' );
eval { $sth->execute() };
ok( ! $@, 'Called execute() ok (empty, after bind_param calls)' );
my $t_params = $sth->{mock_my_history}->bound_params;
is( scalar @{ $t_params }, 2,
'Correct number of parameters bound (method on tracker)' );
......@@ -26,14 +79,76 @@ my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
is( $t_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
my $param_attrs = $sth->{mock_my_history}->bound_param_attrs;
is( scalar @{ $param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is_deeply( $param_attrs->[0], { TYPE => SQL_VARCHAR },
"the second bound parameter attribute should match our hashref");
is( $param_attrs->[1], SQL_VARCHAR,
"the first bound parameter attribute should match what we bound");
my $a_params = $sth->{mock_params};
is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (attribute)' );
is( $a_params->[0], 'baz',
'Statement handle stored bound parameter from bind_param() (attribute)' );
is( $a_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (attribute)' );
my $a_param_attrs = $sth->{mock_param_attrs};
is( scalar @{ $a_param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is_deeply( $a_param_attrs->[0], { TYPE => SQL_VARCHAR },
"the second bound parameter attribute should match our hashref");
is( $a_param_attrs->[1], SQL_VARCHAR,
"the first bound parameter attribute should match what we bound");
}
{
my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
my $sth = eval { $dbh->prepare( $sql ) };
eval { $sth->execute( 'baz', 'bar' ) };
ok( ! $@, 'Called execute() ok (empty, after bind_param calls)' );
my $t_params = $sth->{mock_my_history}->bound_params;
is( scalar @{ $t_params }, 2,
'Correct number of parameters bound (method on tracker)' );
is( $t_params->[0], 'baz',
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
is( $t_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (method on tracker)' );
my $param_attrs = $sth->{mock_my_history}->bound_param_attrs;
is( scalar @{ $param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is( $param_attrs->[0], undef,
"the first bound parameter attribute should be undef as the value was bound in the execute() call");
is( $param_attrs->[1], undef,
"the second bound parameter attribute should be undef as the value was bound in the execute() call");
my $a_params = $sth->{mock_params};
is( scalar @{ $a_params }, 2, 'Correct number of parameters bound (attribute)' );
is( $a_params->[0], 'baz',
'Statement handle stored bound parameter from bind_param() (attribute)' );
is( $a_params->[1], 'bar',
'Statement handle stored bound parameter from bind_param() (attribute)' );
my $a_param_attrs = $sth->{mock_param_attrs};
is( scalar @{ $a_param_attrs }, 2,
'bound_param_types length should match the number of bound parameters' );
is( $a_param_attrs->[0], undef,
"the first bound parameter attribute should be undef as the value was bound in the execute() call");
is( $a_param_attrs->[1], undef,
"the second bound parameter attribute should be undef as the value was bound in the execute() call");
}
{
my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
my $sth = eval { $dbh->prepare( 'begin dbms_output.get_line(?,?); end;' ) };
......@@ -61,3 +176,37 @@ my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
'Statement handle stored bound parameter from bind_param_inout() (attribute)' );
}
{
my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
my $sth = eval { $dbh->prepare( $sql ) };
eval {
$sth->bind_param( 2, 'bar' );
$sth->bind_param( 1, 'baz', SQL_VARCHAR );
$sth->execute();
};
ok( ! $@, 'Parameters bound to statement handle with bind_param() and executed' );
eval {
$sth->bind_param( 2, 'foo', { TYPE => SQL_VARCHAR } );
$sth->bind_param( 1, 'qux' );
$sth->execute();
};
ok( ! $@, 'Parameters bound to statement handle with bind_param() and executed' );
my $executionHistory = $sth->{mock_execution_history};
is_deeply(
$executionHistory,
[
{
params => [ 'baz', 'bar' ],
attrs => [ SQL_VARCHAR, undef ],
}, {
params => [ 'qux', 'foo' ],
attrs => [ undef, { TYPE => SQL_VARCHAR } ],
}
],
"mock_execution_history should list the parameters and their attributes for each execution"
);
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 9;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -29,3 +32,5 @@ my $sql = 'SELECT * FROM foo WHERE bar = ? AND baz = ?';
is( $a_params->[1], 'bar',
'Statement handle stored bound inline parameter (attribute)' );
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 43;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -104,3 +107,5 @@ sub check_resultset {
}
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 25;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -161,3 +164,4 @@ $dbh->{mock_add_resultset} = {
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 23;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -71,3 +74,5 @@ ok($@, '... we got the exception');
like($sth_fetch->errstr,
qr/^No connection present/,
'... fetching row against inactive db throws expected exception' );
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 68;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -145,4 +148,6 @@ BEGIN {
$st_track->is_finished('nothing');
is($st_track->is_finished(), 'no', '... our statement is no longer finished');
}
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 22;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -50,3 +53,5 @@ isa_ok($next, 'DBD::Mock::StatementTrack');
is($next->statement, "INSERT INTO nothing (nothing) VALUES('nada')", '... its our old insert statement too');
ok(!defined($i->next()), '... now nothing in the iterator');
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 16;
use Test::More;
BEGIN {
use_ok( 'DBD::Mock' => qw(Pool) );
......@@ -68,3 +71,5 @@ BEGIN {
ok($dbh->disconnect(), '... not really disconnecting, just returning true');
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 55;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -353,3 +356,5 @@ use DBI;
# Shuts up warning when object is destroyed
undef $dbh->{mock_session};
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 29;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -192,3 +195,5 @@ BEGIN {
# Shuts up warning when object is destroyed
undef $dbh->{mock_session};
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 28;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -176,3 +179,5 @@ BEGIN {
ok($dbh->{mock_can_fetch}==-95, "$dbh->{mock_can_fetch} should be -95");
}
}
done_testing();
use 5.006;
use 5.008;
use strict;
use warnings;
use Test::More tests => 11;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -112,3 +112,5 @@ is_deeply(
$dbh->selectall_hashref($items_sql, [], "Checking selectall_hashref with empty array of keys."),
{ %{$not_coco_hash} },
'... selectall_hashref with empty array of keys');
done_testing();
use 5.006;
use 5.008;
use strict;
use warnings;
use Test::More tests => 12;
use Test::More;
use DBI;
......@@ -30,7 +30,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
}
{
my $sth = $dbh->prepare('INSERT INTO Baz (foo, bar) values (?, ?)');
my $sth = $dbh->prepare('INSERT IGNORE INTO Baz (foo, bar) values (?, ?)');
$sth->execute(90, 41);
is($dbh->{mock_last_insert_id}, 345, '... got the right insert id');
......@@ -44,3 +44,5 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
is($dbh->{mock_last_insert_id}, 347, '... got the right insert id');
is($dbh->last_insert_id((undef)x4), 347, '... got the right insert id from last_insert_id');
}
done_testing();
use 5.006;
use 5.008;
use strict;
use warnings;
use Test::More tests => 12;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -71,3 +71,4 @@ $sth->execute();
'bind_col implementation does not break selectall_* methods' );
}
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More tests => 5;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
......@@ -54,3 +56,5 @@ ok( $sth->execute, 'Execute using named parameters' );
$sth = $dbh->prepare('SELECT * FROM foo WHERE id = :id and active = :active');
ok( $sth->execute( '101', 'no' ), 'Execute using named parameters #2' );
done_testing();
use 5.006;
use 5.008;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::More tests => 6;
BEGIN {
use_ok('DBD::Mock');
......@@ -44,3 +45,5 @@ lives_ok(
ok( exists $row{'person.person_name'}, 'First column' );
ok( exists $row{'person.person_country'}, 'Second column' );
ok( exists $row{'person.person_id'}, 'Third column' );
done_testing();
use 5.006;
use 5.008;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use Test::More tests => 7;
BEGIN {
use_ok('DBD::Mock');
......@@ -52,3 +53,4 @@ lives_ok(
'Prepare two statements'
);
done_testing();
use 5.008;
use strict;
use warnings;
......@@ -31,4 +33,4 @@ my $sql = 'INSERT INTO staff (first_name, last_name, dept) VALUES(?, ?, ?)';
or diag $@;
}
done_testing;
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More;
......@@ -67,10 +70,10 @@ DBD::Mock::dr::set_connect_callbacks( sub {
$sth = $dbh->prepare('SELECT foo FROM bar');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
$rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
($result) = $sth->fetchrow_array();
is($result, undef, "... as we have reset the callbacks this SELECT shouldn't match a result set ");
......@@ -106,10 +109,10 @@ DBD::Mock::dr::add_connect_callbacks( sub {
$sth = $dbh->prepare('SELECT foo FROM bar');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
$rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
($result) = $sth->fetchrow_array();
is($result, 10, "... this should return a value as we've added its connect callback in");
......
use 5.008;
use strict;
use warnings;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
use_ok('DBI');
}
my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
subtest 'SELECTALL_ARRAYREF' => sub {
my $rows = [
[ '1', 'european', '42' ],
[ '27', 'african', '2' ],
];
$dbh->{mock_add_resultset} = {
sql => 'SELECT id, type, inventory_id FROM Swallow',
results => [
[ 'id', 'type', 'inventory_id' ],
@{ $rows },
]
};
my $results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow' );
is_deeply( $results, $rows, 'SELECTALL_ARRAYREF ref by default returns the rows from the result set' );
my $expectedResults = [
{
id => 1,
type => 'european',
inventory_id => 42,
}, {
id => 27,
type => 'african',
inventory_id => 2,
},
];
$results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow', { Slice => {} } );
is_deeply( $results, $expectedResults, 'SELECTALL_ARRAYREF ref with a slice defined should return each row as a hashref' );
$results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow', { Slice => { 'id' => 1 } } );
$expectedResults = [
{
id => 1,
}, {
id => 27,
},
];
is_deeply( $results, $expectedResults, 'SELECTALL_ARRAYREF ref with a slice defining column names should return each row as a hashref which only contains those columns' );
$expectedResults = [
[ 'european', 42 ],
[ 'african', 2],
];
$results = $dbh->selectall_arrayref( 'SELECT id, type, inventory_id FROM Swallow', { Columns => [2,3] } );
is_deeply( $results, $expectedResults, 'SELECTALL_ARRAYREF ref with Columns defined should return just those columns' );
};
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More;
BEGIN {
use_ok('DBI');
}
my $dbh = DBI->connect( 'dbi:Mock:', '', '' );
isa_ok($dbh, 'DBI::db');
my $columns = [ 'TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS' ];
my $fooTable = [ undef, 'testSchema', 'foo', 'TABLE', undef ];
my $barView = [ undef, 'testSchema', 'bar', 'VIEW', undef ];
my $bazTable = [ undef, 'testSchema2', 'baz', 'TABLE', 'comment' ];
my $fooResult = {
TABLE_CAT => undef,
TABLE_SCHEM => 'testSchema',
TABLE_NAME => 'foo',
TABLE_TYPE => 'TABLE',
REMARKS => undef,
};
my $barResult = {
TABLE_CAT => undef,
TABLE_SCHEM => 'testSchema',
TABLE_NAME => 'bar',
TABLE_TYPE => 'VIEW',
REMARKS => undef,
};
my $sth = $dbh->table_info( undef, 'testSchema', 'foo', undef );
is_deeply( $sth->fetchall_arrayref( {} ), [], "No mocked table info should result an empty set of results being returned" );
$dbh->{mock_add_table_info} = {
cataloge => undef,
schema => 'testSchema',
table => 'foo',
type => undef,
table_info => [ $columns, $fooTable ],
};
$dbh->{mock_add_table_info} = {
cataloge => undef,
schema => 'testSchema',
table => undef,
type => 'VIEW',
table_info => [ $columns, $barView ],
};
$dbh->{mock_add_table_info} = {
cataloge => undef,
schema => 'testSchema',
table => undef,
type => undef,
table_info => [ $columns, $fooTable, $barView ],
};
$sth = $dbh->table_info( undef, 'testSchema', undef, 'VIEW' );
is_deeply( $sth->fetchall_arrayref( {} ), [ $barResult ], "The matching mock results should be returned" );
$sth = $dbh->table_info( undef, 'testSchema', undef, undef );
is_deeply( $sth->fetchall_arrayref( {} ), [ $fooResult, $barResult ], "Search based up on the schema parameter only, should return in the set of results we've already defined" );
$dbh->{mock_clear_table_info} = 1;
$sth = $dbh->table_info( undef, 'testSchema', 'foo', undef );
is_deeply( $sth->fetchall_arrayref( {} ), [], "Clearing the mocked table info should result in no results being returned until mock_add_table_info is used to populate the table_info again" );
$dbh->{mock_add_table_info} = {
schema => '%',
table_info => [
[ 'TABLE_CAT', 'TABLE_SCHEM', 'TABLE_NAME', 'TABLE_TYPE', 'REMARKS' ],
[ undef, 'testSchema', undef, undef, undef ],
[ undef, 'testSchema_2', undef, undef, undef ],
],
};
$sth = $dbh->table_info( undef, '%', undef, undef );
is_deeply( $sth->fetchall_arrayref( {} ), [
{
TABLE_CAT => undef,
TABLE_SCHEM => 'testSchema',
TABLE_NAME => undef,
TABLE_TYPE => undef,
REMARKS => undef,
}, {
TABLE_CAT => undef,
TABLE_SCHEM => 'testSchema_2',
TABLE_NAME => undef,
TABLE_TYPE => undef,
REMARKS => undef,
}
], "Mocking a search of schemas should return the records we've added" );
done_testing();
use 5.008;
use strict;
use warnings;
use Test::More;
......
use 5.008;
use strict;
use warnings;
use Test::More;
......
......@@ -2,9 +2,12 @@
# The bug that was reported did not appear, but it did expose
# another bug with consecutive executes()
use 5.008;
use strict;
use warnings;
use Test::More tests => 4;
use Test::More;
use_ok('DBI');
......@@ -36,3 +39,5 @@ eval {
# Shuts up warning when object is destroyed
undef $dbh->{mock_session};
done_testing();
#!/usr/bin/perl
use Test::More tests => 15;
use 5.008;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use DBI;
use DBD::Mock;
......@@ -125,3 +127,5 @@ while(@cases) {
} qr/\QSession states exhausted, only '$num_states' in DBD::Mock::Session\E/;
}
done_testing();
# this is bug RT #71438
use Test::More tests => 6;
use 5.008;
use strict;
use warnings;
use Test::More;
use DBI;
my $dbh = DBI->connect('dbi:Mock:', '', '', { PrintError => 0, RaiseError => 1});
......@@ -69,3 +69,5 @@ is_deeply(
$sth->fetchrow_hashref(),
undef
);
done_testing();
# This is test for bug rt#82243 - Bug with Regex in DBD::Mock::Session
use 5.008;
use strict;
use warnings;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
use_ok('DBI');
}
{
my $dbh = DBI->connect('dbi:Mock:', '', '', { RaiseError => 1, PrintError => 0 });
isa_ok($dbh, 'DBI::db');
my $session = DBD::Mock::Session->new((
{
statement => 'SELECT bar FROM foo WHERE baz = ?',
bound_params => [ qr/^125$/ ],
results => [[ 'bar' ], [ 15 ]]
},
));
isa_ok($session, 'DBD::Mock::Session');
$dbh->{mock_session} = $session;
my $sth = $dbh->prepare('SELECT bar FROM foo WHERE baz = ?');
$sth->execute(125);
my ($result) = $sth->fetchrow_array();
is($result, 15, 'Regex matching on bound_params should work as expected.');
# Shuts up warning when object is destroyed
undef $dbh->{mock_session};
}
done_testing();
#!/usr/bin/perl
use Test::More tests => 3;
use 5.008;
use strict;
use warnings;
use Test::More;
use Test::Exception;
use DBI;
use DBD::Mock;
......@@ -43,3 +45,5 @@ throws_ok {
ok $sth->execute(@$params),
} qr/\QSession states exhausted, only '1' in DBD::Mock::Session\E/,
"fails on executing one too many times";
done_testing();