#!/usr/bin/perl -w -I./t

## ----------------------------------------------------------------------------
## 26exe_array.t this is a completly new one 
## By Martin J. Evans orgianlly called 70execute_array.t for the ODBC DBD driver
## and adatped into DBD::Oracle (in a very minor way) by John Scoles, The Pythian Group
## ----------------------------------------------------------------------------
## loads of execute_array and execute_for_fetch tests
## tests both insert and update and row fetching
## with RaiseError on and off and AutoCommit on and off
## ----------------------------------------------------------------------------

use Test::More;
use strict;
use Data::Dumper;
require 'nchar_test_lib.pl';

$| = 1;


my $table = 'PERL_DBD_execute_array';
my $table2 = 'PERL_DBD_execute_array2';
my @captured_error;                  # values captured in error handler


# create a database handle
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
$ENV{NLS_NCHAR} = "US7ASCII";
$ENV{NLS_LANG} = "AMERICAN";

my $dbh;
my @p1 = (1,2,3,4,5);
my @p2 = qw(one two three four five);
my $fetch_row = 0;

use DBI qw(:sql_types);

eval {
    $dbh = DBI->connect($dsn, $dbuser, '', {PrintError => 0});
};

if (!$dbh) {
    plan skip_all => "Unable to connect to Oracle";
}
#$dbh->{PrintError} = 1;
my $has_test_nowarnings = 1;
eval "require Test::NoWarnings";
$has_test_nowarnings = undef if $@;
use_ok('Data::Dumper');

END {
    if ($dbh) {
        drop_table_local($dbh);
    }
    Test::NoWarnings::had_no_warnings()
          if ($has_test_nowarnings);
    done_testing();
}

sub error_handler
{
    @captured_error = @_;
    note("***** error handler called *****");
    0;                          # pass errors on
}

sub create_table_local
{
    my $dbh = shift;

    eval {
        $dbh->do(qq/create table $table (a int primary key, b char(20))/);
    };
    if ($@) {
        diag("Failed to create test table $table - $@");
        return 0;
    }
    eval {
        $dbh->do(qq/create table $table2 (a int primary key, b char(20))/);
    };
    if ($@) {
        diag("Failed to create test table $table2 - $@");
        return 0;
    }
    my $sth = $dbh->prepare(qq/insert into $table2 values(?,?)/);
    for (my $row = 0; $row < @p1; $row++) {
        $sth->execute($p1[$row], $p2[$row]);
    }
    1;
}

sub drop_table_local
{
    my $dbh = shift;

    eval {
        local $dbh->{PrintError} = 0;
        local $dbh->{PrintWarn} = 0;
        $dbh->do(qq/drop table $table/);
        $dbh->do(qq/drop table $table2/);
    };
    note("Table dropped");
}

# clear the named table of rows
sub clear_table
{
    $_[0]->do(qq/delete from $_[1]/);
}

# check $table contains the data in $c1, $c2 which are arrayrefs of values
sub check_data
{
    my ($dbh, $c1, $c2) = @_;

    my $data = $dbh->selectall_arrayref(qq/select * from $table order by a/);
    my $row = 0;
    foreach (@$data) {
        is($_->[0], $c1->[$row], "row $row p1 data");
        is($_->[1], $c2->[$row], "row $row p2 data");
        $row++;
    }
}

sub check_tuple_status
{
    my ($tsts, $expected) = @_;

    note(Data::Dumper->Dump([$tsts], [qw(ArrayTupleStatus)]));
    my $row = 0;
    foreach my $s (@$tsts) {
        if (ref($expected->[$row])) {
            is(ref($s), 'ARRAY', 'array in array tuple status');
            is(scalar(@$s), 3, '3 elements in array tuple status error');
        } else {
            if ($s == -1) {
                pass("row $row tuple status unknown");
            } else {
                is($s, $expected->[$row], "row $row tuple status");
            }
        }
        $row++
    }
}

# insert might return 'mas' which means the caller said the test
# required Multiple Active Statements and the driver appeared to not
# support MAS.
sub insert
{
    my ($dbh, $sth, $ref) = @_;

    die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH'));
    note("insert " . join(", ", map {"$_ = ". DBI::neat($ref->{$_})} keys %$ref ));
    # DBD::Oracle supports MAS don't compensate for it not
    if ($ref->{requires_mas} && $dbh->{Driver}->{Name} eq 'Oracle') {
        delete $ref->{requires_mas};
    }
    @captured_error = ();

    if ($ref->{raise}) {
        $sth->{RaiseError} = 1;
    } else {
        $sth->{RaiseError} = 0;
    }

    my (@tuple_status, $sts, $total_affected);
    $sts = 999999;              # to ensure it is overwritten
    $total_affected = 999998;
    if ($ref->{array_context}) {
        eval {
            if ($ref->{params}) {
                ($sts, $total_affected) =
                    $sth->execute_array({ArrayTupleStatus => \@tuple_status},
                                        @{$ref->{params}});
            } elsif ($ref->{fetch}) {
                ($sts, $total_affected) =
                    $sth->execute_array(
                        {ArrayTupleStatus => \@tuple_status,
                         ArrayTupleFetch => $ref->{fetch}});
            } else {
                ($sts, $total_affected) =
                    $sth->execute_array({ArrayTupleStatus => \@tuple_status});
            }
        };
    } else {
        eval {
            if ($ref->{params}) {
                $sts =
                    $sth->execute_array({ArrayTupleStatus => \@tuple_status},
                                        @{$ref->{params}});
            } else {
                $sts =
                    $sth->execute_array({ArrayTupleStatus => \@tuple_status});
            }
        };
    }
    if ($ref->{error} && $ref->{raise}) {
        ok($@, 'error in execute_array eval');
    } else {
        if ($ref->{requires_mas} && $@) {
            diag("\nThis test died with $@");
            diag("It requires multiple active statement support in the driver and I cannot easily determine if your driver supports MAS. Ignoring the rest of this test.");
            foreach (@tuple_status) {
                if (ref($_)) {
                    diag(join(",", @$_));
                }
            }
            return 'mas';
        }
        ok(!$@, 'no error in execute_array eval') or note($@);
    }
    $dbh->commit if $ref->{commit};

    if (!$ref->{raise} || ($ref->{error} == 0)) {
        if (exists($ref->{sts})) {
            is($sts, $ref->{sts},
               "execute_array returned " . DBI::neat($sts) . " rows executed");
        }
        if (exists($ref->{affected}) && $ref->{array_context}) {
            is($total_affected, $ref->{affected},
               "total affected " . DBI::neat($total_affected))
        }
    }
    if ($ref->{raise}) {
        if ($ref->{error}) {
            ok(scalar(@captured_error) > 0, "error captured");
        } else {
            is(scalar(@captured_error), 0, "no error captured");
        }
    }
    if ($ref->{sts}) {
        is(scalar(@tuple_status), (($ref->{sts} eq '0E0') ? 0 : $ref->{sts}),
           "$ref->{sts} rows in tuple_status");
    }
    if ($ref->{tuple}) {
        check_tuple_status(\@tuple_status, $ref->{tuple});
    }
    return;
}
# simple test on ensure execute_array with no errors:
# o checks returned status and affected is correct
# o checks ArrayTupleStatus is correct
# o checks no error is raised
# o checks rows are inserted
# o run twice with AutoCommit on/off
# o checks if less values are specified for one parameter the right number
#   of rows are still inserted and NULLs are placed in the missing rows
# checks binding via bind_param_array and adding params to execute_array
# checks binding no parameters at all
sub simple
{
    my ($dbh, $ref) = @_;

    note('simple tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref ));

    note("  all param arrays the same size");
    foreach my $commit (1,0) {
        note("    Autocommit: $commit");
        clear_table($dbh, $table);
        $dbh->begin_work if !$commit;

        my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
        $sth->bind_param_array(1, \@p1);
        $sth->bind_param_array(2, \@p2);
        insert($dbh, $sth,
               { commit => !$commit, error => 0, sts => 5, affected => 5,
                 tuple => [1, 1, 1, 1, 1], %$ref});
        check_data($dbh, \@p1, \@p2);
    }

    note "  Not all param arrays the same size";
    clear_table($dbh, $table);
    my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);

    $sth->bind_param_array(1, \@p1);
    $sth->bind_param_array(2, [qw(one)]);
    insert($dbh, $sth, {commit => 0, error => 0,
                        raise => 1, sts => 5, affected => 5,
                        tuple => [1, 1, 1, 1, 1], %$ref});
    check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);

    note "  Not all param arrays the same size with bind on execute_array";
    clear_table($dbh, $table);
    $sth = $dbh->prepare(qq/insert into $table values(?,?)/);

    insert($dbh, $sth, {commit => 0, error => 0,
                        raise => 1, sts => 5, affected => 5,
                        tuple => [1, 1, 1, 1, 1], %$ref,
                        params => [\@p1, [qw(one)]]});
    check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);

    note "  no parameters";
    clear_table($dbh, $table);
    $sth = $dbh->prepare(qq/insert into $table values(?,?)/);

    insert($dbh, $sth, {commit => 0, error => 0,
                        raise => 1, sts => '0E0', affected => 0,
                        tuple => [], %$ref,
                        params => [[], []]});
    check_data($dbh, \@p1, ['one', undef, undef, undef, undef]);
}

# error test to ensure correct behavior for execute_array when it errors:
# o execute_array of 5 inserts with last one failing
#  o check it raises an error
#  o check caught error is passed on from handler for eval
#  o check returned status and affected rows
#  o check ArrayTupleStatus
#  o check valid inserts are inserted
#  o execute_array of 5 inserts with 2nd last one failing
#  o check it raises an error
#  o check caught error is passed on from handler for eval
#  o check returned status and affected rows
#  o check ArrayTupleStatus
#  o check valid inserts are inserted
sub error
{
    my ($dbh, $ref) = @_;

    die "need hashref arg" if (!$ref || (ref($ref) ne 'HASH'));

    note('error tests ' . join(", ", map {"$_ = $ref->{$_}"} keys %$ref ));
    {
        note("Last row in error");

        clear_table($dbh, $table);
        my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
        my @pe1 = @p1;
        $pe1[-1] = 1;
        $sth->bind_param_array(1, \@pe1);
        $sth->bind_param_array(2, \@p2);
        insert($dbh, $sth, {commit => 0, error => 1, sts => undef,
                            affected => undef, tuple => [1, 1, 1, 1, []],
                            %$ref});
        check_data($dbh, [@pe1[0..4]], [@p2[0..4]]);
    }

    {
        note("2nd last row in error");
        clear_table($dbh, $table);
        my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
        my @pe1 = @p1;
        $pe1[-2] = 1;
        $sth->bind_param_array(1, \@pe1);
        $sth->bind_param_array(2, \@p2);
        insert($dbh, $sth, {commit => 0, error => 1, sts => undef,
                            affected => undef, tuple => [1, 1, 1, [], 1], %$ref});
        check_data($dbh, [@pe1[0..2],$pe1[4]], [@p2[0..2], $p2[4]]);
    }
}

sub fetch_sub
{
    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 ($dbh, $ref) = @_;

    note("row_size via execute_for_fetch");

    $fetch_row = 0;
    clear_table($dbh, $table);
    my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
    insert($dbh, $sth,
           {commit => 0, error => 0, sts => 5, affected => 5,
            tuple => [1, 1, 1, 1, 1], %$ref,
            fetch => \&fetch_sub});

    # NOTE: I'd like to do the following test but it requires Multiple
    # Active Statements and 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.
    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/);
    ok($sth2->execute, 'execute on second table') or diag($sth2->errstr);
    ok($sth2->{Executed}, 'second statement is in executed state');
    my $res = 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);
    #my $res = $dbh->selectall_arrayref("select * from $table2");
    #print Dumper($res);
}

# test updates
sub update
{
    my ($dbh, $ref) = @_;

    note("update test");

    $fetch_row = 0;
    clear_table($dbh, $table);
    my $sth = $dbh->prepare(qq/insert into $table values(?,?)/);
    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);

    $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);
    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)]);

    $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-existant row
    $sth->bind_param_array(2, \@pe1);
    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)]);

    $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%']);
    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)]);


}

$dbh->{RaiseError} = 1;
$dbh->{PrintError} = 0;
$dbh->{ChopBlanks} = 1;
$dbh->{HandleError} = \&error_handler;
$dbh->{AutoCommit} = 1;

eval {drop_table_local($dbh)};

ok(create_table_local($dbh), "create test table") or exit 1;
simple($dbh, {array_context => 1, raise => 1});
simple($dbh, {array_context => 0, raise => 1});
error($dbh, {array_context => 1, raise => 1});
error($dbh, {array_context => 0, raise => 1});
error($dbh, {array_context => 1, raise => 0});
error($dbh, {array_context => 0, raise => 0});

row_wise($dbh, {array_context => 1, raise => 1});

update($dbh, {array_context => 1, raise => 1});