#!perl -w
use strict;
## ----------------------------------------------------------------------------
## 26array_bind.t
## By Alexander V Alekseev
## and John Scoles, The Pythian Group
## 
## ----------------------------------------------------------------------------
##  Checking bind_param_inout to an varchar2_table and number_table
##  Checking bind_param_inout_array with execute_array
## 
## ----------------------------------------------------------------------------
use strict;
use warnings;
use Encode;
use Devel::Peek;
use DBI;
use DBD::Oracle qw(:ora_types ORA_OCI);
use Test::More tests => 15;
unshift @INC ,'t';
require 'nchar_test_lib.pl';
use Data::Dumper;
$Data::Dumper::Useqq=1;
my $dbh;
my $utf8_charset = (ORA_OCI >= 9.2) ? 'AL32UTF8' : 'UTF8';
my $eight_bit_charset = 'WE8ISO8859P1';
sub db_connect($) {
    my $utf8 = shift;
    # Make sure we really are overriding the environment settings.
    my ($charset, $ncharset);
    if ($utf8) {
        set_nls_lang_charset($eight_bit_charset);
        set_nls_nchar($eight_bit_charset);
        $charset = $utf8_charset;
        $ncharset = $utf8_charset;
    }
    else {
        set_nls_lang_charset($utf8_charset);
        set_nls_nchar($utf8_charset);
        $charset = $eight_bit_charset;
        $ncharset = $eight_bit_charset;
    }
    my $dsn = oracle_test_dsn();
    my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
    my $p = {
        AutoCommit => 1,
        PrintError => 1,
        FetchHashKeyName => 'NAME_lc',
        ora_envhp  => 0, # force fresh environment (with current NLS env vars)
    };
    $p->{ora_charset} = $charset if $charset;
    $p->{ora_ncharset} = $ncharset if $ncharset;
    my $dbh = DBI->connect($dsn, $dbuser, '', $p);
    return $dbh;
}
sub test_varchar2_table_3_tests($){
        my $dbh=shift;
        my $statement='
        DECLARE
                tbl     SYS.DBMS_SQL.VARCHAR2_TABLE;
        BEGIN
                tbl := :mytable;
                :cc := tbl.count();
                tbl(1) := \'def\';
                tbl(2) := \'ijk\';
                :mytable := tbl;
        END;
        ';
        my $sth=$dbh->prepare( $statement );
        if( ! defined($sth) ){
                BAIL_OUT("Prapare(varchar2) error: ".$dbh->errstr);
        }
        my @arr=( "abc", "cde","lalala" );
        if( not $sth->bind_param_inout(":mytable", \\@arr, 5, {
                                ora_type => ORA_VARCHAR2_TABLE,
                                ora_maxarray_numentries => 2
                        }
                ) ){
                BAIL_OUT("bind  :mytable (VARCHAR2) error: ".$dbh->errstr);
        }
        my $cc;
        if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
                BAIL_OUT("bind :cc (at VARCHAR2) error: ".$dbh->errstr);
        }
        if( not $sth->execute() ){
                BAIL_OUT("Execute (at VARCHAR2) failed: ".$dbh->errstr);
        }
        #       print   "Result: cc=",$cc,"\n",
        #       "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
        #Result: cc=2, l=3
        #        arr=$VAR1 = [
        #          'def',
        #          'ijk'
        #        ];
        #
         
        ok( $cc == 2, "VARCHAR2_TABLE input count correctness");
        ok( scalar(@arr) == 2,"VARCHAR2_TABLE output count correctness");
        ok( (($arr[0] eq 'def') and ($arr[1] eq 'ijk')) , "VARCHAR2_TABLE output content") or
                diag( "arr[0]='",$arr[0],"', arr[1]='",$arr[1],"', arr=", Data::Dumper::Dumper(\@arr));
}
sub test_number_table_3_tests($){
        my $dbh=shift;
        my $statement='
        DECLARE
                tbl     SYS.DBMS_SQL.NUMBER_TABLE;
        BEGIN
                tbl := :mytable;
                :cc := tbl.count();
                tbl(4) := -1;
                tbl(5) := -2;
                :mytable := tbl;
        END;
        ';
        my $sth=$dbh->prepare( $statement );
        if( ! defined($sth) ){
                BAIL_OUT("Prapare(NUMBER_TABLE) error: ".$dbh->errstr);
        }
        my @arr=( 1,"2E0","3.5" );
        # note, that ora_internal_type defaults to SQLT_FLT for ORA_NUMBER_TABLE .
        if( not $sth->bind_param_inout(":mytable", \\@arr, 10, {
                                ora_type => ORA_NUMBER_TABLE,
                                ora_maxarray_numentries => (scalar(@arr)+2),
                                ora_internal_type => SQLT_INT
                        }
                ) )
        {
                BAIL_OUT("bind(NUMBER_TABLE) :mytable error: ".$dbh->errstr);
        }
        my $cc=undef;
        if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
                BAIL_OUT("bind(NUMBER_TABLE) :cc error: ".$dbh->errstr);
        }
        if( not $sth->execute() ){
                BAIL_OUT("Execute(NUMBER_TABLE) failed: ".$dbh->errstr);
        }
        # print "Result: cc=",$cc,"\n",
        # "\tarr=",Data::Dumper::Dumper(\@arr),"\n";
        #Result: cc=3
        #        arr=$VAR1 = [
        #          '5',
        #          '8',
        #          '3.5',
        #          '-1',
        #          '-2'
        #        ];
        ok( $cc == 3, "NUMBER_TABLE input count correctness");
        ok( scalar(@arr) == 5,"NUMBER_TABLE output count correctness");
        my $result=1;
        my @r=(1, 2, 3, -1, -2);
        for( my $i=0 ; $i< scalar(@arr) ; $i++){
                if( $r[$i] != $arr[$i] ){
                        $result=0;
                        last;
                }
        }
        ok( $result , "NUMBER_TABLE output content") or
                diag( "arr=", Data::Dumper::Dumper(\@arr),"\nThough must be: ",Data::Dumper::Dumper(\@r));
}
sub test_inout_array_tests($){
        my $dbh=shift;
        $dbh->do("create table array_in_out_test (id number(12,0), name varchar2(20), value varchar2(2000))");
        $dbh->do("create sequence seq_array_in_out_test start with 1");
        $dbh->do("
                create or replace trigger trg_array_in_out_testst 
                before insert
                on array_in_out_test
                for each row
                DECLARE  
                        iCounter array_in_out_test.id%TYPE;  
                BEGIN  
                        if INSERTING THEN  
                                Select seq_array_in_out_test.nextval INTO iCounter FROM Dual;  
                                :new.id := iCounter;  
                        END IF;  
                END;
        ");
         
        my @in_array1=('one','two','three','four','five');
        my @in_array2=('5','4','3','2','1');
        my @out_array;
        my @tuple_status;
         
        my $sql = "insert into array_in_out_test (name, value) values (?,?) returning id into ?" ;
        my $sth = $dbh->prepare($sql);
         
        $sth->bind_param_array(1,\@in_array1 );
        $sth->bind_param_array(2,\@in_array2);
        ok ( $sth->bind_param_inout_array(3,\@out_array,0,{ora_type => ORA_VARCHAR2}),'... bind_param_inout_array should return false');
         
        ok ( $sth->execute_array({ArrayTupleStatus=>\@tuple_status}),'... execute_array should return false');
        cmp_ok(scalar (@tuple_status), '==',5 , '... we should have 19 tuple_status');
        cmp_ok(scalar (@out_array), '==',5 , '... we should have 5 out_array');
        cmp_ok($out_array[0], '==', 1,'... out values should match 1');
        cmp_ok($out_array[1], '==', 2,'... out values should match 2');
        cmp_ok($out_array[2], '==', 3,'... out values should match 3');
        cmp_ok($out_array[3], '==', 4,'... out values should match 3');
        cmp_ok($out_array[4], '==', 5,'... out values should match 5');
        $dbh->do("drop table array_in_out_test") or warn $dbh->errstr;
        $dbh->do("drop sequence seq_array_in_out_test") or die $dbh->errstr;
         
}
SKIP: {
    $dbh = db_connect(0);
    plan skip_all => "Not connected to oracle" if not $dbh;
    test_varchar2_table_3_tests($dbh);
    test_number_table_3_tests($dbh);
    test_inout_array_tests($dbh);
     
};
END {
    eval {
        local $dbh->{PrintError} = 0;
    };
}
+1;