#!perl -w
sub ok ($$;$) {
my($n, $ok, $warn) = @_;
++$t;
die "sequence error, expected $n but actually $t"
if $n and $n != $t;
($ok) ? print "ok $t\n"
: print "# failed test $t at line ".(caller)[2]."\nnot ok $t\n";
if (!$ok && $warn) {
$warn = $DBI::errstr || "(DBI::errstr undefined)" if $warn eq '1';
warn "$warn\n";
}
}
use DBI;
unshift @INC ,'t';
require 'nchar_test_lib.pl';
$| = 1;
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
my $dbuser_2 = $ENV{ORACLE_USERID_2} || '';
sub give_up { warn @_ if @_; print "1..0\n"; exit 0; }
if ($dbuser_2 eq '') {
give_up("ORACLE_USERID_2 not defined. Tests skipped.\n");
}
# strip off @ on userid_2, as the reauth presumes current server
$dbuser_2 =~ s/@.*//;
(my $uid1 = uc $dbuser) =~ s:/.*::;
(my $uid2 = uc $dbuser_2) =~ s:/.*::;
if ($uid1 eq $uid2) {
give_up("ORACLE_USERID_2 not unique.\nTests skipped.\n")
}
my $dsn = oracle_test_dsn();
my $dbh = DBI->connect($dsn, $dbuser, '');
unless($dbh) {
give_up("Unable to connect to Oracle ($DBI::errstr)\nTests skipped.\n");
}
print "1..3\n";
ok(0, ($dbh->selectrow_array("SELECT USER FROM DUAL"))[0] eq $uid1 );
ok(0, $dbh->func($dbuser_2, '', 'reauthenticate'));
ok(0, ($dbh->selectrow_array("SELECT USER FROM DUAL"))[0] eq $uid2 );
$dbh->disconnect;