The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!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;
use DBD::Oracle qw(ORA_RSET);
use strict;

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

$| = 1;

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

unless ($dbh) {
	warn "Unable to connect to Oracle as $dbuser ($DBI::errstr)\nTests skipped.\n";
	print "1..0\n";
	exit 0;
}

my $tests = 16;

print "1..$tests\n";

# ref cursors may be slow due to oracle bug 3735785
# believed fixed in
#	 9.2.0.6 (Server Patch Set) 
#	10.1.0.4 (Server Patch Set) 
#	10.2.0.1 (Base Release)

ok( 1,
  my $outer = $dbh->prepare(q{
    SELECT object_name, CURSOR(SELECT object_name FROM dual)
    FROM all_objects WHERE rownum <= 5
  })
);
ok( 2, $outer->{ora_types}[1] == ORA_RSET);
ok( 3, $outer->execute);
ok( 4, my @row1 = $outer->fetchrow_array);
my $inner1 = $row1[1];
ok( 5, ref $inner1 eq 'DBI::st');
ok( 6, $inner1->{Active});
ok( 7, my @row1_1 = $inner1->fetchrow_array);
ok( 8, $row1[0] eq $row1_1[0]);
ok( 9, $inner1->{Active});
ok(10, my @row2 = $outer->fetchrow_array);
ok(11, !$inner1->{Active});
ok(12, !$inner1->fetch);
ok(13, $dbh->err == -1);
ok(14, $dbh->errstr =~ / defunct /);
ok(15, $outer->finish);
ok(16, $dbh->{ActiveKids} == 0);


#########################################################################
# Fetch speed test: START
#########################################################################

$dbh->{RaiseError} = 1;

sub timed_fetch {
  my ($rs,$caption) = @_;
  my $row_count = 0;
  my $tm_start = DBI::dbi_time();
  $row_count++ while $rs->fetch;
  my $elapsed = DBI::dbi_time() - $tm_start;
  print "Fetched $row_count rows ($caption): $elapsed secs.\n";
  return $elapsed;
}

##################################################
# regular select
##################################################
my $sql1 = q{
    SELECT object_name
    FROM (SELECT object_name FROM all_objects WHERE ROWNUM<=70),
	 (SELECT           1 FROM all_objects WHERE ROWNUM<=70)
};
$outer = $dbh->prepare($sql1);
$outer->execute();
my $dur_std = timed_fetch($outer,'select');

##################################################
# nested cursor
##################################################
$outer = $dbh->prepare("SELECT CURSOR($sql1) FROM DUAL");
$outer->execute();
my $ref_csr = $outer->fetchrow_arrayref->[0];
my $dur_ref = timed_fetch($ref_csr,'nested cursor');

#########################################################################
# Fetch speed test: END
#########################################################################

exit 0;