...
 
Commits (20)
image: perl:latest
before_script:
- cpanm Minilla Test::Pod Test::Pod::Coverage
stages:
- test
unitTests:
unitTestsLatest:
image: perl:latest
stage: test
script:
- cpanm Module::Build::Tiny Test::Pod Test::Pod::Coverage
- cpanm --installdeps .
- perl Build.PL
- perl Build
- REPORT_TEST_ENVIRONMENT=1 perl Build test
unitTestsV5.8:
image: rsrchboy/perlbrew-base:latest
stage: test
script:
- minil test
- perlbrew init
- source /usr/local/perlbrew/etc/bashrc
- perlbrew install-patchperl
- perlbrew --notest install perl-5.8.5
- perlbrew switch perl-5.8.5
- cpanm Module::Build::Tiny Test::Pod Test::Pod::Coverage List::Util@1.28
- cpanm --installdeps .
- perl Build.PL
- perl Build
- REPORT_TEST_ENVIRONMENT=1 perl Build test
# Contributing to the DBD::Mock module
If you'd like to contribute to the DBD::Mock module then I suggest you
use one of the following ways:
* Post a ticket to the [RT](https://rt.cpan.org/Public/Dist/Display.html?Name=DBD-Mock)
queue for the module.
* Raise an issue in the [GitLab project](https://gitlab.com/scrapheap/DBD-Mock/issues)
* If you have actual code to commit then make a Merge Request to the [GitLab project](https://gitlab.com/scrapheap/DBD-Mock)
......@@ -2,18 +2,29 @@ Revision history for Perl extension DBD::Mock.
{{$NEXT}}
1.47 2019-09-06T10:03:39Z
- Applied Max Carey's patch from rt86294 adding support for
nested keys to fetchall_hashref
- Added experimental Connection Callbacks feature
- Fixed build for Perl v5.8
1.46 2019-09-04T12:02:08Z
- Added git-repo url to meta-data
- Fixed bug rt70587 Spelling Mistake
- Added regex support to mock_add_resultset
1.43
1.45 October 22, 2012
- Extended DBD::Mock::Session functionality
- Added bind_param_array() to mocked statements
- Added execute_array() to mocked statements
1.43 August 29, 2011
- Segregated into different packages
- Removed code coverage from POD
- Fixed bug rt49537 Basic support for named parameters
- Fixed bug rt70421 Build.PL now contains Test::Exception
1.42
1.42 August 7, 2011
- Fixed bug rt66815 DBD::Mock::Session error clobbered
- Fixed bug rt69460 Info on META.yml is outdated
- Fixed bug rt69055 Spelling mistakes in POD
......
......@@ -67,12 +67,13 @@
"web" : "https://gitlab.com/scrapheap/DBD-Mock"
}
},
"version" : "1.46",
"version" : "1.47",
"x_authority" : "cpan:JLCOOPER",
"x_contributors" : [
"Chisel <CHISEL@cpan.org>",
"Dave Rolsky <DROLSKY@cpan.org>",
"Gines R <ginesr@gmail.com>",
"Max Carey <MHC@cpan.org>",
"gregor herrmann <gregoa@debian.org>",
"wu-lee <git.wu-lee@noodlefactory.co.uk>"
],
......
......@@ -735,6 +735,56 @@ All functionality listed here is highly experimental and should be used with gre
Right now only MySQL is supported by this feature, and even that support is very minimal. Currently the MySQL `$dbh` and `$sth` attributes 'mysql\_insertid' are aliased to the `$dbh` attribute 'mock\_last\_insert\_id'. It is possible to add more aliases though, using the `DBD::Mock:_set_mock_attribute_aliases` function (see the source code for details).
- Connection Callbacks
This feature allows you to define callbacks that get executed when `DBI->connect` is called.
To set a series of callbacks you use the `DBD::Mock::dr::set_connect_callbacks` function
use DBD::Mock::dr;
DBD::Mock::dr::set_connect_callbacks( sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
} );
To set more than one callback to you can either simply add extra callbacks to your call to `DBD::Mock::dr::set_connect_callbacks`
DBD::Mock::dr::set_connect_callbacks(
sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
},
sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
}
);
Or you can extend the existing set of callbacks with another using the `DBD::Mock::dr::add_connect_callbacks` function
DBD::Mock::dr::add_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT bar FROM foo',
results => [[ 'bar' ], [ 50 ]]
};
} );
# BUGS
- Odd $dbh attribute behavior
......
......@@ -30,7 +30,7 @@ sub import {
if ( @_ && lc( $_[0] ) eq "pool" );
}
our $VERSION = '1.46';
our $VERSION = '1.47';
our $drh = undef; # will hold driver handle
our $err = 0; # will hold any error codes
......@@ -909,6 +909,57 @@ The 'MySQL' in the DSN will be picked up and the MySQL specific attribute aliasi
Right now only MySQL is supported by this feature, and even that support is very minimal. Currently the MySQL C<$dbh> and C<$sth> attributes 'mysql_insertid' are aliased to the C<$dbh> attribute 'mock_last_insert_id'. It is possible to add more aliases though, using the C<DBD::Mock:_set_mock_attribute_aliases> function (see the source code for details).
=item Connection Callbacks
This feature allows you to define callbacks that get executed when C<< DBI->connect >> is called.
To set a series of callbacks you use the C<DBD::Mock::dr::set_connect_callbacks> function
use DBD::Mock::dr;
DBD::Mock::dr::set_connect_callbacks( sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
} );
To set more than one callback to you can either simply add extra callbacks to your call to C<DBD::Mock::dr::set_connect_callbacks>
DBD::Mock::dr::set_connect_callbacks(
sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
},
sub {
my ( $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
}
);
Or you can extend the existing set of callbacks with another using the C<DBD::Mock::dr::add_connect_callbacks> function
DBD::Mock::dr::add_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT bar FROM foo',
results => [[ 'bar' ], [ 50 ]]
};
} );
=back
=head1 BUGS
......
......@@ -86,7 +86,7 @@ sub prepare {
my $rs;
if ( my $all_rs = $dbh->{mock_rs} ) {
if ( my $by_name = $all_rs->{named}{$statement} // first { $statement =~ m/$_->{regexp}/ } @{ $all_rs->{matching} } ) {
if ( my $by_name = defined $all_rs->{named}{$statement} ? $all_rs->{named}{$statement} : first { $statement =~ m/$_->{regexp}/ } @{ $all_rs->{matching} } ) {
# We want to copy this, because it is meant to be reusable
$rs = [ @{ $by_name->{results} } ];
if ( exists $by_name->{failure} ) {
......
......@@ -5,6 +5,9 @@ use warnings;
our $imp_data_size = 0;
my @connect_callbacks;
sub connect {
my ( $drh, $dbname, $user, $auth, $attributes ) = @_;
if ( $drh->{'mock_connect_fail'} == 1 ) {
......@@ -38,6 +41,10 @@ sub connect {
my $dbh = DBI::_new_dbh( $drh, { Name => $dbname } )
|| return;
foreach my $callback (@connect_callbacks) {
$callback->( $dbh, $dbname, $user, $auth, $attributes );
}
return $dbh;
}
......@@ -102,4 +109,12 @@ sub disconnect_all {
sub DESTROY { undef }
sub set_connect_callbacks {
@connect_callbacks = map { die "connect callbacks needs to be a reference to a function " unless ref $_ eq "CODE"; $_ } @_;
}
sub add_connect_callbacks {
push @connect_callbacks, map { die "connect callbacks needs to be a reference to a function " unless ref $_ eq "CODE"; $_ } @_;
}
1;
......@@ -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);
# get the case conversion to use for hash key names (NAME/NAME_lc/NAME_uc)
my $hash_key_name = $sth->{Database}->FETCH('FetchHashKeyName') || 'NAME';
# check if $keyfield is not an integer
if ( !( $keyfield =~ /^-?\d+$/ ) ) {
my $found = 0;
# get a hashref mapping field names to their corresponding indexes. indexes
# start at zero
my $names_hash = $sth->FETCH("${hash_key_name}_hash");
# search for index of item that matches $keyfield
foreach my $index ( 0 .. scalar( @{$fields} ) ) {
if ( $fields->[$index] eq $keyfield ) {
$found++;
# 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;
# now make the keyfield the index
$keyfield = $index;
my $num_fields = $sth->FETCH('NUM_OF_FIELDS');
# and jump out of the loop :)
last;
}
# 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, 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};
}
# populate the hash
$rethash->{ $record->[$keyfield] } =
{ map { $_ => shift(@values) } @{$fields} };
# 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;
......
......@@ -5,3 +5,7 @@ use Test::More tests => 1;
BEGIN {
use_ok( 'DBD::Mock' );
}
if ( $ENV{REPORT_TEST_ENVIRONMENT} ) {
warn "\n\nperl $^V ($^O)\n\n";
}
......@@ -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');
......@@ -81,15 +81,34 @@ my $dbh = DBI->connect( 'DBI:Mock:', '', '' );
}
is_deeply(
$dbh->selectall_hashref($items_sql, 'id', "Checking selectall_hashref with named key."),
{ '2' => $coco_hash,
'42' => $not_coco_hash,
},
'... selectall_hashref worked correctly');
$dbh->selectall_hashref($items_sql, 'id', "Checking selectall_hashref with named key."),
{ '2' => $coco_hash,
'42' => $not_coco_hash,
},
'... selectall_hashref with named key');
is_deeply(
$dbh->selectall_hashref($items_sql, 1, "Checking selectall_hashref with named key."),
{ 'coconuts' => $coco_hash,
'not coconuts' => $not_coco_hash,
},
'... selectall_hashref worked correctly');
$dbh->selectall_hashref($items_sql, 2, "Checking selectall_hashref with numeric key."),
{ 'coconuts' => $coco_hash,
'not coconuts' => $not_coco_hash,
},
'... selectall_hashref with numeric key');
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 with array of named keys');
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 with array of numeric keys');
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');
use strict;
use Test::More;
BEGIN {
use_ok('DBD::Mock');
use_ok('DBD::Mock::dr');
use_ok('DBI');
}
my ( $dsn, $user, $password, $attributes );
DBD::Mock::dr::set_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
} );
{
my $dbh = DBI->connect('dbi:Mock:', '', '');
isa_ok($dbh, 'DBI::db');
my $sth = $dbh->prepare('SELECT foo FROM bar');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
is($result, 10, '... got the result we expected');
$sth->finish();
}
# now let's check that we can reset the callbacks
DBD::Mock::dr::set_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT bar FROM foo',
results => [[ 'bar' ], [ 50 ]]
};
} );
{
my $dbh = DBI->connect('dbi:Mock:', '', '');
isa_ok($dbh, 'DBI::db');
my $sth = $dbh->prepare('SELECT bar FROM foo');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
is($result, 50, '... got the result we expected');
$sth->finish();
$sth = $dbh->prepare('SELECT foo FROM bar');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
is($result, undef, "... as we have reset the callbacks this SELECT shouldn't match a result set ");
$sth->finish();
}
# add_connect_callbacks adds a new callback to the list
DBD::Mock::dr::add_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
$dbh->{mock_add_resultset} = {
sql => 'SELECT foo FROM bar',
results => [[ 'foo' ], [ 10 ]]
};
} );
{
my $dbh = DBI->connect('dbi:Mock:', '', '');
isa_ok($dbh, 'DBI::db');
my $sth = $dbh->prepare('SELECT bar FROM foo');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
is($result, 50, '... got the result we expected');
$sth->finish();
$sth = $dbh->prepare('SELECT foo FROM bar');
isa_ok($sth, 'DBI::st');
my $rows = $sth->execute();
is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
my ($result) = $sth->fetchrow_array();
is($result, 10, "... this should return a value as we've added its connect callback in");
$sth->finish();
}
DBD::Mock::dr::set_connect_callbacks( sub {
( my $dbh, $dsn, $user, $password, $attributes ) = @_;
} );
{
my $dbh = DBI->connect('dbi:Mock:database=TEST_DATABASE;hostname=localhost', 'TEST_USER', 'TEST_PASSWORD', { customAttribute => 1 });
isa_ok($dbh, 'DBI::db');
is ( $dsn, "database=TEST_DATABASE;hostname=localhost", "The database from the DSN should be passed through to the callback" );
is ( $user, "TEST_USER", "The username should be passed through to the callback" );
is ( $password, "TEST_PASSWORD", "The password should be passed through to the callback" );
is ( ref $attributes, "HASH", "The attributes passed through to the callback should be a hash reference" );
is ( $attributes->{customAttribute}, 1, "The custom attribute should be passed through to the callback" );
}
done_testing();