#!perl -w
use Test::More;
use DBI;
use DBD::Oracle qw(:ora_types ORA_OCI);
use Data::Dumper;
use Math::BigInt;
use strict;

unshift @INC ,'t';
require 'nchar_test_lib.pl';

$| = 1;

my @test_sets = (
	[ "CHAR(10)",     10 ],
	[ "VARCHAR(10)",  10 ],
	[ "VARCHAR2(10)", 10 ],
);

# Set size of test data (in 10KB units)
#	Minimum value 3 (else tests fail because of assumptions)
#	Normal  value 8 (to test 64KB threshold well)
my $sz = 8;

my $tests = 3;
my $tests_per_set = 11;
$tests += @test_sets * $tests_per_set;

my $t = 0;
my $failed = 0;
my %ocibug;
my $table = "dbd_ora__drop_me" . ($ENV{DBD_ORACLE_SEQ}||'');


my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
my $dbh = DBI->connect($dsn, $dbuser, '', {
                           PrintError => 0,
                       });

if ($dbh) {
    plan tests=>$tests;
} else {
    plan skip_all => "Unable to connect to oracle\n";
}

# test simple select statements with [utf8]

my $utf8_test = ($] >= 5.006)
	&& client_ochar_is_utf8() # for correct output (utf8 bind vars should be fine regardless)
	&& ($dbh->ora_can_unicode() & 2);
diag("Including unicode data in test") if $utf8_test;

unless(create_test_table("str CHAR(10)", 1)) {
    BAIL_OUT("Unable to create test table ($DBI::errstr)\n");
    print "1..0\n";
    exit 0;
}

my($sth, $p1, $p2, $tmp, @tmp);

foreach (@test_sets) {
    run_select_tests( @$_ );
}

my $ora_server_version = $dbh->func("ora_server_version");
SKIP: {
    skip "Oracle < 10", 1 if ($ora_server_version->[0] < 10);
    my $data = $dbh->selectrow_array(q!
       select to_dsinterval(?) from dual
       !, {}, "1 07:00:00");
    ok ((defined $data and $data eq '+000000001 07:00:00.000000000'),
        "ds_interval");
  }

if (0) {
    # UNION ALL causes Oracle 9 (not 8) to describe col1 as zero length
    # causing "ORA-24345: A Truncation or null fetch error occurred" error
    # Looks like an Oracle bug
    $dbh->trace(9);
    ok 0, $sth = $dbh->prepare(qq{
	SELECT :HeadCrncy FROM DUAL
	UNION ALL
	SELECT :HeadCrncy FROM DUAL});
    $dbh->trace(0);
    ok 0, $sth->execute("EUR");
    ok 0, $tmp = $sth->fetchall_arrayref;
    use Data::Dumper;
    die Dumper $tmp;
}


# $dbh->{USER} is just there so it works for old DBI's before Username was added
my @pk = $dbh->primary_key(undef, $dbh->{USER}||$dbh->{Username}, uc $table);
ok(@pk, 'primary key on table');
is(join(",",@pk), 'DT,IDX', 'DT,IDX');

exit 0;

END {
    $dbh->do(qq{ drop table $table }) if $dbh;
}

sub run_select_tests {
  my ($type_name, $field_len) = @_;

  my $data0;
  if ($utf8_test) {
    $data0 = eval q{ "0\x{263A}xyX" }; #this includes the smiley from perlunicode (lab) BTW: it is busted
  } else {
    $data0 = "0\177x\0X";
  }
  my $data1 = "1234567890";
  my $data2 = "2bcdefabcd";

 SKIP: {
      if (!create_test_table("lng $type_name", 1)) {
          # typically OCI 8 client talking to Oracle 7 database
          diag("Unable to create test table for '$type_name' data ($DBI::err)");
          skip $tests_per_set;
      }

      $sth = $dbh->prepare("insert into $table values (?, ?, SYSDATE)");
      ok($sth, "prepare for insert of $type_name");
      ok($sth->execute(40, $data0), "insert 8bit or utf8");
      ok($sth->execute(Math::BigInt->new(41), $data1), 'bind overloaded value');
      ok($sth->execute(42, $data2), "insert data2");

      ok(!$sth->execute(43, "12345678901234567890"), 'insert string too long');

      ok($sth = $dbh->prepare("select * from $table order by idx"),
         "prepare select ordered by idx");
      ok($sth->execute, "execute");
      # allow for padded blanks
      $sth->{ChopBlanks} = 1;
      ok($tmp = $sth->fetchall_arrayref, 'fetchall');
      my $dif;
      if ($utf8_test) {
      	$dif = DBI::data_diff($tmp->[0][1], $data0);
         ok(!defined($dif) || $dif eq '', 'first row matches');
        diag($dif) if $dif;
      } else {
        is($tmp->[0][1], $data0, 'first row matches');
      }
      is($tmp->[1][1], $data1, 'second row matches');
      is($tmp->[2][1], $data2, 'third row matches');

  }
} # end of run_select_tests

# end.


sub create_test_table {
    my ($fields, $drop) = @_;
    my $sql = qq{create table $table (
	idx integer,
	$fields,
	dt date,
	primary key (dt, idx)
    )};
    $dbh->do(qq{ drop table $table }) if $drop;
    $dbh->do($sql);
    if ($dbh->err && $dbh->err==955) {
	$dbh->do(qq{ drop table $table });
	warn "Unexpectedly had to drop old test table '$table'\n" unless $dbh->err;
	$dbh->do($sql);
    }
    return 0 if $dbh->err;
    return 1;
}

__END__