The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w

use Test::More;

use DBI;
use Oraperl;
use Config;

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

$| = 1;

plan tests => 33;

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

unless($dbh) {
	BAILOUT("Unable to connect to Oracle ($DBI::errstr)\nTests skiped.\n");
	exit 0;
}

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

SKIP: {
	skip "not unix-like", 2 unless $Config{d_semctl};
	# basic check that we can fork subprocesses and wait for the status
	# after having connected to Oracle
	is system("exit 1;"), 1<<8, 'system exit 1 should return 256';
	is system("exit 0;"),    0, 'system exit 0 should return 0';
}


$sth = $dbh->prepare(q{
	/* also test preparse doesn't get confused by ? :1 */
        /* also test placeholder binding is case insensitive */
	select :a, :A from user_tables -- ? :1
});
ok($sth->{ParamValues});
is(keys %{$sth->{ParamValues}}, 1);
is($sth->{NUM_OF_PARAMS}, 1);
ok($sth->bind_param(':a', 'a value'));
ok($sth->execute);
ok($sth->{NUM_OF_FIELDS});
eval {
  local $SIG{__WARN__} = sub { die @_ }; # since DBI 1.43
  $p1=$sth->{NUM_OFFIELDS_typo};
};
ok($@ =~ /attribute/);
ok($sth->{Active});
ok($sth->finish);
ok(!$sth->{Active});

$sth = $dbh->prepare("select * from user_tables");
ok($sth->execute);
ok($sth->{Active});
1 while ($sth->fetch);	# fetch through to end
ok(!$sth->{Active});

# so following test works with other NLS settings/locations
ok($dbh->do("ALTER SESSION SET NLS_NUMERIC_CHARACTERS = '.,'"));

ok($tmp = $dbh->selectall_arrayref(q{
	select 1 * power(10,-130) "smallest?",
	       9.9999999999 * power(10,125) "biggest?"
	from dual
}));
my @tmp = @{$tmp->[0]};
#warn "@tmp"; $tmp[0]+=0; $tmp[1]+=0; warn "@tmp";
ok($tmp[0] <= 1.0000000000000000000000000000000001e-130, "tmp0=$tmp[0]");
ok($tmp[1] >= 9.99e+125, "tmp1=$tmp[1]");


my $warn='';
eval {
	local $SIG{__WARN__} = sub { $warn = $_[0] };
	$dbh->{RaiseError} = 1;
	$dbh->do("some invalid sql statement");
};
ok($@    =~ /DBD::Oracle::db do failed:/, "eval error: ``$@'' expected 'do failed:'");
#print "''$warn''";
ok($warn =~ /DBD::Oracle::db do failed:/, "warn error: ``$warn'' expected 'do failed:'");
ok($DBI::err);
ok($ora_errno);
is($ora_errno, $DBI::err);
$dbh->{RaiseError} = 0;

# ---

ok( $dbh->ping);
ok(!$ora_errno);	# ora_errno reset ok
ok(!$DBI::err);	# DBI::err  reset ok

$dbh->disconnect;
$dbh->{PrintError} = 0;
ok(!$dbh->ping);

my $ora_oci = DBD::Oracle::ORA_OCI(); # dualvar
printf "ORA_OCI = %d (%s)\n", $ora_oci, $ora_oci;
ok("$ora_oci");
ok($ora_oci >= 8);
my @ora_oci = split(/\./, $ora_oci,-1);
ok(scalar @ora_oci >= 2);
ok(scalar @ora_oci == grep { DBI::looks_like_number($_) } @ora_oci);
is($ora_oci[0], int($ora_oci));

exit 0;