The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;
use DBI;

use vars qw($test_dsn $test_user $test_password);
require "t/lib.pl";

my $tb = Test::More->builder;
binmode $tb->failure_output, ":utf8";
binmode $tb->todo_output,    ":utf8";

my $dbh = DbiTestConnect($test_dsn, $test_user, $test_password, { RaiseError => 1, AutoCommit => 0, mysql_server_prepare_disable_fallback => 1 });

plan tests => 288*2;

$dbh->do("CREATE TEMPORARY TABLE t(i INT)");

foreach my $mysql_enable_utf8 (0, 1) {
    $dbh->{mysql_enable_utf8} = $mysql_enable_utf8;
    foreach my $mysql_server_prepare (0, 1) {
        $dbh->{mysql_server_prepare} = $mysql_server_prepare;
        foreach my $val ('1', 1, 1.0, 1.1, undef, 'XX', "\N{U+100}") {
            next if defined $val and (my $tmp1 = $val) eq "\N{U+100}" and not $mysql_enable_utf8;
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func = '$dbh->do(' . $statement_str . ', {}, ' . (defined $param_str ? $param_str : 'undef')  . ')';
                $dbh->do($statement, {}, $param);
                is(tied($statement)->{fetch}, 1, "$func processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func does not process set magic on statement");
                is(tied($param)->{fetch}, 1, "$func processes get magic on param only once");
                is(tied($param)->{store}, 0, "$func does not process set magic on param");
            }
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func = '$dbh->selectall_arrayref(' . $statement_str . ', {}, ' . (defined $param_str ? $param_str : 'undef')  . ')';
                $dbh->selectall_arrayref($statement, {}, $param);
                is(tied($statement)->{fetch}, 1, "$func processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func does not process set magic on statement");
                is(tied($param)->{fetch}, 1, "$func processes get magic on param only once");
                is(tied($param)->{store}, 0, "$func does not process set magic on param");
            }
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func1 = '$dbh->prepare(' . $statement_str . ')';
                my $func2 = '$sth->execute(' . (defined $param_str ? $param_str : 'undef')  . ')';
                my $sth = $dbh->prepare($statement);
                $sth->execute($param);
                $sth->finish();
                is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
                is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
                is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
            }
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func1 = '$dbh->prepare(' . $statement_str . ')';
                my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef')  . ')';
                my $sth = $dbh->prepare($statement);
                $sth->bind_param(1, $param);
                $sth->execute();
                $sth->finish();
                is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
                is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
                is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
            }
            next if defined $val and (my $tmp2 = $val) !~ /^[\d.]+$/;
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func1 = '$dbh->prepare(' . $statement_str . ')';
                my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef')  . ', DBI::SQL_INTEGER)';
                my $sth = $dbh->prepare($statement);
                $sth->bind_param(1, $param, DBI::SQL_INTEGER);
                $sth->execute();
                $sth->finish();
                is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
                SKIP: {
                    skip('Passing magic scalar to bind_param() with DBI::SQL_INTEGER process get magic more times prior to perl 5.15.4', 1) if $] < 5.015004;
                    is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
                }
                is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
            }
            {
                my $param_str = $val;
                tie my $param, 'TieScalarCounter', $param_str;
                my $statement_str = "SELECT * FROM t WHERE i = " . $dbh->quote($param_str) . " OR i = ?";
                tie my $statement, 'TieScalarCounter', $statement_str;
                my $func1 = '$dbh->prepare(' . $statement_str . ')';
                my $func2 = '$sth->bind_param(1, ' . (defined $param_str ? $param_str : 'undef')  . ', DBI::SQL_FLOAT)';
                my $sth = $dbh->prepare($statement);
                $sth->bind_param(1, $param, DBI::SQL_FLOAT);
                $sth->execute();
                $sth->finish();
                is(tied($statement)->{fetch}, 1, "$func1 processes get magic on statement only once");
                is(tied($statement)->{store}, 0, "$func1 does not process set magic on statement");
                SKIP: {
                    skip('Passing magic scalar to bind_param() with DBI::SQL_FLOAT process get magic more times prior to perl 5.15.4', 1) if $] < 5.015004;
                    is(tied($param)->{fetch}, 1, "$func2 processes get magic on param only once");
                }
                is(tied($param)->{store}, 0, "$func2 does not process set magic on param");
            }
        }
    }
}

$dbh->disconnect();

package TieScalarCounter;

sub TIESCALAR {
    my ($class, $value) = @_;
    return bless { fetch => 0, store => 0, value => $value }, $class;
}

sub FETCH {
    my ($self) = @_;
    $self->{fetch}++;
    return $self->{value};
}

sub STORE {
    my ($self, $value) = @_;
    $self->{store}++;
    $self->{value} = $value;
}