1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
|
#!perl
# From: Jeffrey Horn <horn@cs.wisc.edu>
use strict;
use warnings;
use lib 't/lib';
use DBDOracleTestLib qw/ oracle_test_dsn db_handle /;
use Test::More;
use DBI;
use DBD::Oracle qw(ORA_RSET);
$| = 1;
my ( $limit, $tests );
my $dbh = db_handle( { PrintError => 0 } );
if ($dbh) {
# ORA-00900: invalid SQL statement
# ORA-06553: PLS-213: package STANDARD not accessible
my $tst =
$dbh->prepare(q{declare foo char(50); begin RAISE INVALID_NUMBER; end;});
if ( $dbh->err
&& ( $dbh->err == 900 || $dbh->err == 6553 || $dbh->err == 600 ) )
{
warn 'Your Oracle server doesn\'t support PL/SQL' if $dbh->err == 900;
warn 'Your Oracle PL/SQL is not properly installed'
if $dbh->err == 6553 || $dbh->err == 600;
plan skip_all => 'Server does not support pl/sql or not installed';
}
$limit = $dbh->selectrow_array(
q{SELECT value-2 FROM v$parameter WHERE name = 'open_cursors'});
# allow for our open and close cursor 'cursors'
$limit -= 2 if $limit && $limit >= 2;
unless ( defined $limit ) { # v$parameter open_cursors could be 0 :)
warn(
"Can't determine open_cursors from v\$parameter, so using default\n"
);
$limit = 1;
}
$limit = 100 if $limit > 100; # lets not be greedy or upset DBA's
$tests = 2 + 10 * $limit + 6;
plan tests => $tests;
note "Max cursors: $limit";
}
else {
plan skip_all => 'Unable to connect to Oracle';
}
my @cursors;
my @row;
note("opening cursors\n");
my $open_cursor = $dbh->prepare(qq{
BEGIN OPEN :kursor FOR
SELECT * FROM all_objects WHERE rownum < 5;
END;
}
);
ok( $open_cursor, 'open cursor' );
foreach ( 1 .. $limit ) {
note("opening cursor $_\n");
ok(
$open_cursor->bind_param_inout(
':kursor', \my $cursor, 0, { ora_type => ORA_RSET }
),
'open cursor bind param inout'
);
ok( $open_cursor->execute, 'open cursor execute' );
ok( !$open_cursor->{Active}, 'open cursor Active' );
ok( $cursor->{Active}, 'cursor Active' );
ok( $cursor->fetchrow_arrayref, 'cursor fetcharray' );
ok( $cursor->fetchrow_arrayref, 'cursor fetcharray' );
ok( $cursor->finish, 'cursor finish' ); # finish early
ok( !$cursor->{Active}, 'cursor not Active' );
push @cursors, $cursor;
}
note("closing cursors\n");
my $close_cursor = $dbh->prepare(qq{ BEGIN CLOSE :kursor; END; });
ok( $close_cursor, 'close cursor' );
foreach ( 1 .. @cursors ) {
print "closing cursor $_\n";
my $cursor = $cursors[ $_ - 1 ];
ok(
$close_cursor->bind_param(
':kursor', $cursor, { ora_type => ORA_RSET }
),
'close cursor bind param'
);
ok( $close_cursor->execute, 'close cursor execute' );
}
my $PLSQL = <<'PLSQL';
DECLARE
TYPE t IS REF CURSOR;
c t;
BEGIN
? := c;
END;
PLSQL
ok( my $sth1 = $dbh->prepare($PLSQL), 'prepare exec of proc for null cursor' );
ok( $sth1->bind_param_inout( 1, \my $cursor, 100, { ora_type => ORA_RSET } ),
'binding cursor for null cursor' );
ok( $sth1->execute, 'execute for null cursor' );
is( $cursor, undef, 'undef returned for null cursor' );
ok( $sth1->execute, 'execute 2 for null cursor' );
is( $cursor, undef, 'undef 2 returned for null cursor' );
|
