view release on metacpan or  search on metacpan

t/lib/ExecuteArray.pm  view on Meta::CPAN

    note("fetch_sub $fetch_row");
    if ($fetch_row == @p1) {
        note('returning undef');
        $fetch_row = 0;
        return;
    }

    return [$p1[$fetch_row], $p2[$fetch_row++]];
}

# test insertion via execute_array and ArrayTupleFetch
sub row_wise
{
    my ($self, $dbh, $ref) = @_;

    note("row_size via execute_for_fetch");

    # Populate the first table via a ArrayTupleFetch which points to a sub
    # returning rows
    $fetch_row = 0;             # reset fetch_sub to start with first row
    clear_table($dbh, $table);
    my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
    $self->insert($dbh, $sth,
                  {commit => 0, error => 0, sts => 5, affected => 5,
                   tuple => [1, 1, 1, 1, 1], %$ref,
                   fetch => \&fetch_sub});

    # NOTE: The following test requires Multiple Active Statements. Although
    # I can find ODBC drivers which do this it is not easy (if at all possible)
    # to know if an ODBC driver can handle MAS or not. If it errors the
    # driver probably does not have MAS so the error is ignored and a
    # diagnostic is output. Exceptions are DBD::Oracle which definitely does
    # support MAS.
    # The data pushed into the first table is retrieved via ArrayTupleFetch
    # from the second table by passing an executed select statement handle into
    # execute_array.
    note("row_size via select");
    clear_table($dbh, $table);
    $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
    my $sth2 = $dbh->prepare(qq/select * from $table2/);
    # some drivers issue warnings when mas fails and this causes
    # Test::NoWarnings to output something when we already found
    # the test failed and captured it.
    # e.g., some ODBC drivers cannot do MAS and this test is then expected to
    # fail but we ignore the failure. Unfortunately in failing DBD::ODBC will
    # issue a warning in addition to the fail
    $sth->{Warn} = 0;
    $sth->{Warn} = 0;
    ok($sth2->execute, 'execute on second table') or diag($sth2->errstr);
    ok($sth2->{Executed}, 'second statement is in executed state');
    my $res = $self->insert($dbh, $sth,
           {commit => 0, error => 0, sts => 5, affected => 5,
            tuple => [1, 1, 1, 1, 1], %$ref,
            fetch => $sth2, requires_mas => 1});
    return if $res && $res eq 'mas'; # aborted , does not seem to support MAS
    check_data($dbh, \@p1, \@p2);
}

# test updates
# updates are special as you can update more rows than there are parameter rows
sub update
{
    my ($self, $dbh, $ref) = @_;

    note("update test");

    # populate the first table with the default 5 rows using a ArrayTupleFetch
    $fetch_row = 0;
    clear_table($dbh, $table);
    my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
    $self->insert($dbh, $sth,
                  {commit => 0, error => 0, sts => 5, affected => 5,
                   tuple => [1, 1, 1, 1, 1], %$ref,
                   fetch => \&fetch_sub});
    check_data($dbh, \@p1, \@p2);

    # update all rows b column to 'fred' checking rows affected is 5
    $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/);
    # NOTE, this also checks you can pass a scalar to bind_param_array
    $sth->bind_param_array(1, 'fred');
    $sth->bind_param_array(2, \@p1);
    $self->insert($dbh, $sth,
                  {commit => 0, error => 0, sts => 5, affected => 5,
                   tuple => [1, 1, 1, 1, 1], %$ref});
    check_data($dbh, \@p1, [qw(fred fred fred fred fred)]);

    # update 4 rows column b to 'dave' checking rows affected is 4
    $sth = $dbh->prepare(qq/update $table set b = ? where a = ?/);
    # NOTE, this also checks you can pass a scalar to bind_param_array
    $sth->bind_param_array(1, 'dave');
    my @pe1 = @p1;
    $pe1[-1] = 10;              # non-existent row
    $sth->bind_param_array(2, \@pe1);
    $self->insert($dbh, $sth,
                  {commit => 0, error => 0, sts => 5, affected => 4,
                   tuple => [1, 1, 1, 1, '0E0'], %$ref});
    check_data($dbh, \@p1, [qw(dave dave dave dave fred)]);

    # now change all rows b column to 'pete' - this will change all 5
    # rows even though we have 2 rows of parameters so we can see if
    # the rows affected is > parameter rows
    $sth = $dbh->prepare(qq/update $table set b = ? where b like ?/);
    # NOTE, this also checks you can pass a scalar to bind_param_array
    $sth->bind_param_array(1, 'pete');
    $sth->bind_param_array(2, ['dave%', 'fred%']);
    $self->insert($dbh, $sth,
                  {commit => 0, error => 0, sts => 2, affected => 5,
                   tuple => [4, 1], %$ref});
    check_data($dbh, \@p1, [qw(pete pete pete pete pete)]);
}

sub enable_mars {
    my $dbh = shift;

    # this test uses multiple active statements
    # if we recognise the driver and it supports MAS enable it
    my $driver_name = $dbh->get_info(6) || '';
    if (($driver_name eq 'libessqlsrv.so') ||
            ($driver_name =~ /libsqlncli/)) {
        my $dsn = $ENV{DBI_DSN};
        if ($dsn !~ /^dbi:ODBC:DSN=/ && $dsn !~ /DRIVER=/i) {