#!perl -w
use strict;

use strict;
use warnings;

use Encode;
use Devel::Peek;

use DBI;
use DBD::Oracle qw(:ora_types ORA_OCI);

use Test::More tests => 6;

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));
}
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);
};

END {
    eval {
        local $dbh->{PrintError} = 0;
    };
}


+1;
