New upstream version 1.58

11 files changed, 303 insertions, 24 deletions

diff --git a/Changes b/Changes
index f347f3f..f313f77 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,9 @@
 Revision history for Perl extension DBD::Mock.
 
+1.58 2020-11-02T13:34:48Z
+    - Added the ability for mock result sets to set custom attributes for
+      statement handles. Thanks to Erik Huelsmann for testing the new feature.
+
 1.57 2020-09-18T06:57:48Z
     - Fixed bug rt133358 t/016_mock_add_resultset_test.t fails (with older DBI)
 
diff --git a/MANIFEST b/MANIFEST
index e61e5c3..d4c5792 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -49,6 +49,7 @@ t/030_st_execute_array.t
 t/031_setup_callbacks.t
 t/032_selectall_arrayref.t
 t/033_table_info.t
+t/034_custom_attributes.t
 t/998_pod.t
 t/999_pod_coverage.t
 t/bug_015602.t
diff --git a/META.json b/META.json
index b2996b8..a896d59 100644
--- a/META.json
+++ b/META.json
@@ -61,7 +61,7 @@
    "provides" : {
       "DBD::Mock" : {
          "file" : "lib/DBD/Mock.pm",
-         "version" : "1.57"
+         "version" : "1.58"
       },
       "DBD::Mock::Pool" : {
          "file" : "lib/DBD/Mock/Pool.pm"
@@ -96,7 +96,7 @@
          "web" : "https://gitlab.com/scrapheap/DBD-Mock"
       }
    },
-   "version" : "1.57",
+   "version" : "1.58",
    "x_authority" : "cpan:JLCOOPER",
    "x_contributors" : [
       "Bernhard Graf <GRAF@cpan.org>",
diff --git a/META.yml b/META.yml
index 41f7246..a751cf8 100644
--- a/META.yml
+++ b/META.yml
@@ -31,7 +31,7 @@ no_index:
 provides:
   DBD::Mock:
     file: lib/DBD/Mock.pm
-    version: '1.57'
+    version: '1.58'
   DBD::Mock::Pool:
     file: lib/DBD/Mock/Pool.pm
   DBD::Mock::Pool::db:
@@ -55,7 +55,7 @@ requires:
 resources:
   homepage: https://gitlab.com/scrapheap/DBD-Mock
   repository: git://gitlab.com/scrapheap/DBD-Mock.git
-version: '1.57'
+version: '1.58'
 x_authority: cpan:JLCOOPER
 x_contributors:
   - 'Bernhard Graf <GRAF@cpan.org>'
diff --git a/README.md b/README.md
index d393816..a2d1053 100644
--- a/README.md
+++ b/README.md
@@ -1225,6 +1225,66 @@ great caution (if at all).
             },
         };
 
+- Result Set Custom Attributes
+
+    If you're mocking a database driver that has it's own custom attributes
+    attached to its statement handles then you can use the result sets
+    `prepare_attributes` and `execute_attributes` options.
+
+    The `prepare_attributes` option takes a hashref that maps statement handle
+    attribute names to their values.  The attributes are set at the point that
+    the statement is prepared.
+
+        $dbh->{mock_add_resultset} = {
+            sql => 'SELECT foo FROM bar',
+            prepare_attributes => {
+                sqlite_unprepared_statements => '   ',
+            },
+            results => [[ 'foo' ], [ 10 ]]
+        };
+
+    The `execute_attributes` option also takes a hashref that maps statement
+    handle attribute names to their values, however these will only be set when the
+    statement is executed.
+
+        $dbh->{mock_add_resultset} = {
+            sql => 'SELECT foo FROM bar',
+            execute_attributes => {
+                syb_result_type => 1,
+            },
+            results => [[ 'foo' ], [ 10 ]]
+        };
+
+    If an attribute is also present in the `prepare_attributes` option then the
+    `prepare_attributes` version will take precedence up to the point the
+    statement handle is executed, at which point the `execute_attributes` version
+    will take precedence.
+
+    It is also possible to set `execute_attributes` from a result set's callback
+    by returning them under the `execute_attributes` key in your callback's
+    response.
+
+        $dbh->{mock_add_resultset} = {
+            sql => 'SELECT baz FROM qux',
+            callback => sub {
+                my @bound_params = @_;
+
+                my %result = (
+                    fields => [ 'baz'],
+                    rows => [],
+                    execute_attributes => {
+                        foo => 'bar'
+                    },
+                );
+
+                return %result;
+            }
+        };
+
+    If a result set has an `execute_attributes` option and a callback that also
+    returns an `execute_attributes` key then the callback's `execute_attributes`
+    value will take precedence.
+
 # BUGS
 
 - Odd `$dbh` attribute behavior
@@ -1278,6 +1338,8 @@ methods and tests.
 - Thanks to Tomas Zemresfor the unit test in RT #71438.
 - Thanks to Bernhard Graf for multiple patches fixing a range of issues
 and adding a new _One Shot Failure_ feature to `mock_add_resultset`.
+- Thanks to Erik Huelsmann for testing the new result set custom attributes
+feature.
 
 # COPYRIGHT
 
diff --git a/lib/DBD/Mock.pm b/lib/DBD/Mock.pm
index c1cf14b..4106860 100644
--- a/lib/DBD/Mock.pm
+++ b/lib/DBD/Mock.pm
@@ -30,7 +30,7 @@ sub import {
       if ( @_ && lc( $_[0] ) eq "pool" );
 }
 
-our $VERSION = '1.57';
+our $VERSION = '1.58';
 
 our $drh    = undef;    # will hold driver handle
 our $err    = 0;        # will hold any error codes
@@ -1422,6 +1422,66 @@ the C<last_insert_id>.
         },
     };
 
+=item Result Set Custom Attributes
+
+If you're mocking a database driver that has it's own custom attributes
+attached to its statement handles then you can use the result sets
+C<prepare_attributes> and C<execute_attributes> options.
+
+The C<prepare_attributes> option takes a hashref that maps statement handle
+attribute names to their values.  The attributes are set at the point that
+the statement is prepared.
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT foo FROM bar',
+        prepare_attributes => {
+            sqlite_unprepared_statements => '   ',
+        },
+        results => [[ 'foo' ], [ 10 ]]
+    };
+
+
+The C<execute_attributes> option also takes a hashref that maps statement
+handle attribute names to their values, however these will only be set when the
+statement is executed.
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT foo FROM bar',
+        execute_attributes => {
+            syb_result_type => 1,
+        },
+        results => [[ 'foo' ], [ 10 ]]
+    };
+
+If an attribute is also present in the C<prepare_attributes> option then the
+C<prepare_attributes> version will take precedence up to the point the
+statement handle is executed, at which point the C<execute_attributes> version
+will take precedence.
+
+It is also possible to set C<execute_attributes> from a result set's callback
+by returning them under the C<execute_attributes> key in your callback's
+response.
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT baz FROM qux',
+        callback => sub {
+            my @bound_params = @_;
+
+            my %result = (
+                fields => [ 'baz'],
+                rows => [],
+                execute_attributes => {
+                    foo => 'bar'
+                },
+            );
+
+            return %result;
+        }
+    };
+
+If a result set has an C<execute_attributes> option and a callback that also
+returns an C<execute_attributes> key then the callback's C<execute_attributes>
+value will take precedence.
 
 =back
 
@@ -1499,6 +1559,9 @@ C<mock_can_execute>, and C<mock_can_fetch> features.
 =item Thanks to Bernhard Graf for multiple patches fixing a range of issues
 and adding a new I<One Shot Failure> feature to C<mock_add_resultset>.
 
+=item Thanks to Erik Huelsmann for testing the new result set custom attributes
+feature.
+
 =back
 
 =head1 COPYRIGHT
diff --git a/lib/DBD/Mock/StatementTrack.pm b/lib/DBD/Mock/StatementTrack.pm
index 60fae31..a5a53d2 100644
--- a/lib/DBD/Mock/StatementTrack.pm
+++ b/lib/DBD/Mock/StatementTrack.pm
@@ -8,13 +8,15 @@ sub new {
 
     # these params have default values
     # but can be overridden
-    $params{return_data}       ||= [];
-    $params{fields}            ||= $DBD::Mock::DefaultFieldsToUndef ? undef : [];
-    $params{bound_params}      ||= [];
-    $params{bound_param_attrs} ||= [];
-    $params{statement}         ||= "";
-    $params{failure}           ||= undef;
-    $params{callback}          ||= undef;
+    $params{return_data}        ||= [];
+    $params{fields}             ||= $DBD::Mock::DefaultFieldsToUndef ? undef : [];
+    $params{bound_params}       ||= [];
+    $params{bound_param_attrs}  ||= [];
+    $params{statement}          ||= "";
+    $params{failure}            ||= undef;
+    $params{callback}           ||= undef;
+    $params{driver_attributes}  ||= {};
+    $params{execute_attributes} ||= {};
 
     # these params should never be overridden
     # and should always start out in a default
@@ -131,6 +133,8 @@ sub mark_executed {
     $self->is_executed('yes');
     $self->current_record_num(0);
 
+    $self->{driver_attributes} = { %{ $self->{driver_attributes} }, %{ $self->{execute_attributes} } };
+
     if (ref $self->{callback} eq "CODE") {
         my %recordSet = $self->{callback}->(@{ $self->{bound_params} });
 
@@ -145,6 +149,10 @@ sub mark_executed {
         if (defined $recordSet{last_insert_id}) {
             $self->{last_insert_id} = $recordSet{last_insert_id};
         }
+
+        if (defined $recordSet{execute_attributes}) {
+            $self->{driver_attributes} = { %{ $self->{driver_attributes} }, %{ $recordSet{execute_attributes} } };
+        }
     }
 }
 
diff --git a/lib/DBD/Mock/db.pm b/lib/DBD/Mock/db.pm
index 80ba29d..ea63bf7 100644
--- a/lib/DBD/Mock/db.pm
+++ b/lib/DBD/Mock/db.pm
@@ -110,7 +110,7 @@ sub prepare {
     else {
         # If we have available resultsets seed the tracker with one
 
-        my ($rs, $callback, $failure);
+        my ($rs, $callback, $failure, $prepare_attributes, $execute_attributes);
 
         if ( my $all_rs = $dbh->{mock_rs} ) {
             if ( my $by_name = defined $all_rs->{named}{$statement} ? $all_rs->{named}{$statement} : first { $statement =~ m/$_->{regexp}/ } @{ $all_rs->{matching} } ) {
@@ -118,12 +118,16 @@ sub prepare {
                 $rs = [ @{ $by_name->{results} } ];
                 $callback = $by_name->{callback};
                 $failure = $by_name->{failure};
+                $prepare_attributes = $by_name->{prepare_attributes};
+                $execute_attributes = $by_name->{execute_attributes};
             }
             else {
                 $rs = shift @{ $all_rs->{ordered} };
                 if (ref($rs) eq 'HASH') {
                     $callback = $rs->{callback};
                     $failure = $rs->{failure};
+                    $prepare_attributes = $rs->{prepare_attributes};
+                    $execute_attributes = $rs->{execute_attributes};
                     $rs = [ @{ $rs->{results} } ];
                 }
             }
@@ -131,10 +135,12 @@ sub prepare {
 
         if ( ref($rs) eq 'ARRAY' && ( scalar( @{$rs} ) > 0 || $callback ) ) {
             my $fields = shift @{$rs};
-            $track_params{return_data} = $rs;
-            $track_params{fields}      = $fields;
-            $track_params{callback}    = $callback;
-            $track_params{failure}     = $failure;
+            $track_params{return_data}        = $rs;
+            $track_params{fields}             = $fields;
+            $track_params{callback}           = $callback;
+            $track_params{failure}            = $failure;
+            $track_params{driver_attributes}  = $prepare_attributes;
+            $track_params{execute_attributes} = $execute_attributes;
 
             if( $fields ) {
                 $sth->STORE( NAME          => $fields );
@@ -157,7 +163,6 @@ sub prepare {
     }
 
     # This history object will track everything done to the statement
-
     my $history = DBD::Mock::StatementTrack->new(%track_params);
     $sth->STORE( mock_my_history => $history );
 
@@ -370,6 +375,8 @@ sub STORE {
                     results => \@copied_values,
                     callback => $value->{callback},
                     failure => ref($value->{failure}) ? [ @{ $value->{failure} } ] : undef,
+                    prepare_attributes => $value->{prepare_attributes},
+                    execute_attributes => $value->{execute_attributes},
                 };
             }
             elsif ( ref $name eq "Regexp" ) {
@@ -378,6 +385,8 @@ sub STORE {
                     results => \@copied_values,
                     callback => $value->{callback},
                     failure => ref($value->{failure}) ? [ @{ $value->{failure} } ] : undef,
+                    prepare_attributes => $value->{prepare_attributes},
+                    execute_attributes => $value->{execute_attributes},
                 };
                 # either replace existing match or push
                 grep { $_->{regexp} eq $name && ($_ = $matching) } @{ $dbh->{mock_rs}{matching} }
@@ -388,6 +397,8 @@ sub STORE {
                     results => \@copied_values,
                     callback => $value->{callback},
                     failure => ref($value->{failure}) ? [ @{ $value->{failure} } ] : undef,
+                    prepare_attributes => $value->{prepare_attributes},
+                    execute_attributes => $value->{execute_attributes},
                 };
             }
         }
diff --git a/lib/DBD/Mock/st.pm b/lib/DBD/Mock/st.pm
index 44229d3..9c2c691 100644
--- a/lib/DBD/Mock/st.pm
+++ b/lib/DBD/Mock/st.pm
@@ -361,6 +361,9 @@ sub FETCH {
     elsif ( $attrib eq 'Active' ) {
         return $tracker->is_active;
     }
+    elsif ( exists $tracker->{driver_attributes}->{$attrib} ) {
+        return $tracker->{driver_attributes}->{$attrib};
+    }
     elsif ( $attrib !~ /^mock/ ) {
         if ( $sth->{Database}->{mock_attribute_aliases} ) {
             if (
diff --git a/t/025_mock_last_insert_id.t b/t/025_mock_last_insert_id.t
index 10b398c..b13be48 100644
--- a/t/025_mock_last_insert_id.t
+++ b/t/025_mock_last_insert_id.t
@@ -21,7 +21,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
     is($dbh->last_insert_id((undef)x4), 123, "... got the right insert id from the database's last_insert_id");
 
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 123, "... got the right insert id from the statement handle's last_insert_id");
     }
@@ -30,7 +30,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
     is($dbh->{mock_last_insert_id}, 124, '... got the right insert id');
     is($dbh->last_insert_id((undef)x4), 124, "... got the right insert id from the database handle's last_insert_id");
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 124, "... got the right insert id from the statement handle's last_insert_id");
     }
@@ -39,7 +39,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
     is($dbh->{mock_last_insert_id}, 125, '... got the right insert id');
     is($dbh->last_insert_id((undef)x4), 125, "... got the right insert id from the database handle's last_insert_id");
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 125, "... got the right insert id from the statement handle's last_insert_id");
     }
@@ -52,7 +52,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
     is($dbh->{mock_last_insert_id}, 345, '... got the right insert id');
     is($dbh->last_insert_id((undef)x4), 345, "... got the right insert id from the database handle's last_insert_id");
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 345, "... got the right insert id from the statement handle's last_insert_id");
     }
@@ -61,7 +61,7 @@ $dbh->{mock_start_insert_id} = ['Baz', 345];
     is($dbh->{mock_last_insert_id}, 346, '... got the right insert id');
     is($dbh->last_insert_id((undef)x4), 346, "... got the right insert id from the database handle's last_insert_id");
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 346, "... got the right insert id from the statement handle's last_insert_id");
     }
@@ -70,7 +70,7 @@ $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 the database handle's last_insert_id");
     SKIP: {
-        skip "Version of DBI::st doesn't support last_insert_id" unless $sth->can('last_insert_id');
+        skip "Version of DBI::st doesn't support last_insert_id", 1 unless $sth->can('last_insert_id');
 
         is($sth->last_insert_id((undef)x4), 347, "... got the right insert id from the statement handle's last_insert_id");
     }
diff --git a/t/034_custom_attributes.t b/t/034_custom_attributes.t
new file mode 100644
index 0000000..d52088f
--- /dev/null
+++ b/t/034_custom_attributes.t
@@ -0,0 +1,127 @@
+use 5.008;
+
+use strict;
+use warnings;
+
+use Test::More;
+
+BEGIN {
+    use_ok('DBD::Mock');  
+    use_ok('DBI');
+}
+
+
+{
+    my $dbh = DBI->connect('dbi:Mock:', '', '');
+    isa_ok($dbh, 'DBI::db');
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT baz FROM qux',
+        prepare_attributes => {
+            foo => 'bar'
+        },
+        results => [[ 'baz' ], [ 10 ]]
+    };
+
+    my $sth = $dbh->prepare('SELECT baz FROM qux');
+    isa_ok($sth, 'DBI::st');
+
+    is( $sth->{foo}, 'bar', "our custom prepare_attribute should be set after the prepare" );
+
+    my $rows = $sth->execute();
+    is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
+
+    is( $sth->{foo}, 'bar', "our custom prepare_attribute should persist after the execute if nothing's changed it" );
+}
+
+{
+    my $dbh = DBI->connect('dbi:Mock:', '', '');
+    isa_ok($dbh, 'DBI::db');
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT baz FROM qux',
+        execute_attributes => {
+            foo => 'bar'
+        },
+        results => [[ 'baz' ], [ 10 ]]
+    };
+
+    my $sth = $dbh->prepare('SELECT baz FROM qux');
+    isa_ok($sth, 'DBI::st');
+
+    is( $sth->{foo}, undef, "our custom execute_attribute should be undefined until we execute the statement" );
+
+    my $rows = $sth->execute();
+    is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
+
+    is( $sth->{foo}, 'bar', "our custom execute_attribute should be present after the statements executed" );
+}
+
+{
+    my $dbh = DBI->connect('dbi:Mock:', '', '');
+    isa_ok($dbh, 'DBI::db');
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT baz FROM qux',
+        execute_attributes => {
+            foo => 'should be overwritten',
+        },
+        callback => sub {
+            my @bound_params = @_;
+
+            my %result = (
+                fields => [ 'baz'],
+                rows => [],
+                last_insert_id => 99,
+                execute_attributes => {
+                    foo => 'bar'
+                },
+            );
+
+            return %result;
+        },
+        results => [[ 'baz' ], [ 10 ]]
+    };
+
+    my $sth = $dbh->prepare('SELECT baz FROM qux');
+    isa_ok($sth, 'DBI::st');
+
+    is( $sth->{foo}, undef, "our custom execute_attribute should be undefined until we execute the statement" );
+
+    my $rows = $sth->execute();
+    is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
+
+    is( $sth->{foo}, 'bar', "our custom execute_attribute should be present after the statements executed" );
+}
+
+
+{
+    my $dbh = DBI->connect('dbi:Mock:', '', '');
+    isa_ok($dbh, 'DBI::db');
+
+    $dbh->{mock_add_resultset} = {
+        sql => 'SELECT baz FROM qux',
+        prepare_attributes => {
+            foo => 'prepare_bar',
+            qux => 'prepare_quz',
+        },
+        execute_attributes => {
+            foo => 'execute_bar'
+        },
+        results => [[ 'baz' ], [ 10 ]]
+    };
+
+    my $sth = $dbh->prepare('SELECT baz FROM qux');
+    isa_ok($sth, 'DBI::st');
+
+    is( $sth->{foo}, 'prepare_bar', "our custom prepare_attribute should be present after the statement has been defined" );
+    is( $sth->{qux}, 'prepare_quz', "our custom prepare_attribute should be present after the statement has been defined" );
+
+    my $rows = $sth->execute();
+    is($rows, '0E0', '... got back 0E0 for rows with a SELECT statement');
+
+    is( $sth->{foo}, 'execute_bar', "our custom execute_attribute should take precedence over the the prepare one after the statements executed" );
+    is( $sth->{qux}, 'prepare_quz', "our custom prepare_attribute should still be present after the statement has been executed if there's no matching execute_attributes entry" );
+}
+
+done_testing();