| cjardine@cvs.perl.org 2005-06-03, 8:27 pm |
| Author: cjardine
Date: Mon May 9 04:12:42 2005
New Revision: 1044
Added:
dbd-oracle/trunk/t/55nested.t
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
Log:
Added support for nested cursors in select lists.
Changed "Binding Cursors" section of docs, clarifying examples.
Modified: dbd-oracle/trunk/Changes
====================
====================
====================
==================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Mon May 9 04:12:42 2005
@@ -8,9 +8,11 @@
Changed Makefile.PL to improve build rule detection.
Changed README.vms re logical name tables thanks to Jakob Snoer.
Changed README.aix thanks to Stephen de Vries.
+ Changed "Binding Cursors" section of docs, clarifying examples.
Added VMS logical name checks to Makefile.PL thanks to Jakob Snoer.
Added "Trailing Spaces" section to docs thanks to Michael A Chase.
+ Added support for nested cursors in select lists.
=head1 Changes in DBD-Oracle 1.16 (svn rev 515) 22nd October 2004
Modified: dbd-oracle/trunk/Oracle.pm
====================
====================
====================
==================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Mon May 9 04:12:42 2005
@@ -2415,13 +2415,14 @@
=head1 Binding Cursors
-Cursors can be returned from PL/SQL blocks. Either from stored
-procedure OUT parameters or from direct C<OPEN> statements, as show below:
+Cursors can be returned from PL/SQL blocks, either from stored
+functions (or procedures with OUT parameters) or
+from direct C<OPEN> statements, as shown below:
use DBI;
use DBD::Oracle qw(:ora_types);
- $dbh = DBI->connect(...);
- $sth1 = $dbh->prepare(q{
+ my $dbh = DBI->connect(...);
+ my $sth1 = $dbh->prepare(q{
BEGIN OPEN :cursor FOR
SELECT table_name, tablespace_name
FROM user_tables WHERE tablespace_name = :space;
@@ -2432,7 +2433,7 @@
$sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
$sth1->execute;
# $sth2 is now a valid DBI statement handle for the cursor
- while ( @row = $sth2->fetchrow_array ) { ... }
+ while ( my @row = $sth2->fetchrow_array ) { ... }
The only special requirement is the use of C<bind_param_inout()> with an
attribute hash parameter that specifies C<ora_type> as C<ORA_RSET>.
@@ -2440,36 +2441,125 @@
"ORA-06550: line X, column Y: PLS-00306: wrong number or types of
arguments in call to ...".
-Here's an alternative form using a function that returns a cursor:
+Here's an alternative form using a function that returns a cursor.
+This example uses the pre-defined weak (or generic) REF CURSOR type
+SYS_REFCURSOR. This is an Oracle 9 feature. For Oracle 8, you must
+create your own REF CURSOR type in a package (see the C<curref.pl>
+script mentioned at the end of this section).
# Create the function that returns a cursor
- $sth1 = $dbh->prepare(q{
- CREATE OR REPLACE FUNCTION sp_ListEmp RETURN types.cursorType
- AS l_cursor types.cursorType;
- BEGIN
- OPEN l_cursor FOR select ename, empno from emp order by ename;
- RETURN l_cursor;
- END;
+ $dbh->do(q{
+ CREATE OR REPLACE FUNCTION sp_ListEmp RETURN SYS_REFCURSOR
+ AS l_cursor SYS_REFCURSOR;
+ BEGIN
+ OPEN l_cursor FOR select ename, empno from emp
+ ORDER BY ename;
+ RETURN l_cursor;
+ END;
});
- # CREATE is executed in prepare().
# Use the function that returns a cursor
- $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
+ my $sth1 = $dbh->prepare(q{BEGIN :cursor := sp_ListEmp; END;});
my $sth2;
$sth1->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
$sth1->execute;
# $sth2 is now a valid DBI statement handle for the cursor
- while ( @row = $sth2->fetchrow_array ) { ... }
+ while ( my @row = $sth2->fetchrow_array ) { ... }
-To close the cursor you (currently) need to do this:
+A cursor obtained from PL/SQL as above may be passed back to PL/SQL
+by binding for input, as shown in this example, which explicitly
+closes a cursor:
- $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;");
- $sth3->bind_param_inout(":cursor", \$sth2, 0, { ora_type => ORA_RSET } );
+ my $sth3 = $dbh->prepare("BEGIN CLOSE :cursor; END;");
+ $sth3->bind_param(":cursor", $sth2, { ora_type => ORA_RSET } );
$sth3->execute;
+It is not normally necessary to close a cursor
+explicitly in this way. Oracle will close the cursor automatically
+at the first client-server interaction after the cursor statement handle is
+destroyed. An explicit close may be desirable if the reference to
+the cursor handle from the PL/SQL statement handle delays the destruction
+of the cursor handle for too long. This reference remains until the
+PL/SQL handle is re-bound, re-executed or destroyed.
+
See the C<curref.pl> script in the Oracle.ex directory in the DBD::Oracle
source distribution for a complete working example.
+=head1 Fetching Nested Cursors
+
+Oracle supports the use of select list expressions of type REF CURSOR.
+These may be explicit cursor expressions - C<CURSOR(SELECT ...)>, or
+calls to PL/SQL functions which return REF CURSOR values. The values
+of these expressions are known as nested cursors.
+
+The value returned to a Perl program when a nested cursor is fetched
+is a statement handle. This statement handle is ready to be fetched from.
+It should not (indeed, must not) be executed.
+
+Oracle imposes a restriction on the order of fetching when nested
+cursors are used. Suppose C<$sth1> is a handle for a select statement
+involving nested cursors, and C<$sth2> is a nested cursor handle fetched
+from C<$sth1>. C<$sth2> can only be fetched from while C<$sth1> is
+still active, and the row containing C<$sth2> is still current in C<$sth1>.
+Any attempt to fetch another row from C<$sth1> renders all nested cursor
+handles previously fetched from C<$sth1> defunct.
+
+Fetching from such a defunct handle results in an error with the message
+C<ERROR nested cursor is defunct (parent row is no longer current)>.
+
+This means that the C<fetchall...> or C<selectall...> methods are not useful
+for queries returning nested cursors. By the time such a method returns,
+all the nested cursor handles it has fetched will be defunct.
+
+It is necessary to use an explicit fetch loop, and to do all the
+fetching of nested cursors within the loop, as the following example
+shows:
+
+ use DBI;
+ my $dbh = DBI->connect(...);
+ my $sth = $dbh->prepare(q{
+ SELECT dname, CURSOR(
+ SELECT ename FROM emp
+ WHERE emp.deptno = dept.deptno
+ ORDER BY ename
+ ) FROM dept ORDER BY dname
+ });
+ $sth->execute;
+ while ( my ($dname, $nested) = $sth->fetchrow_array ) {
+ print "$dname\n";
+ while ( my ($ename) = $nested->fetchrow_array ) {
+ print " $ename\n";
+ }
+ }
+
+
+The cursor returned by the function C<sp_ListEmp> defined in the
+previous section can be fetched as a nested cursor as follows:
+
+ my $sth = $dbh->prepare(q{SELECT sp_ListEmp FROM dual});
+ $sth->execute;
+ my ($nested) = $sth->fetchrow_array;
+ while ( my @row = $nested->fetchrow_array ) { ... }
+
+=head2 Pre-fetching Nested Cursors
+
+By default, DBD::Oracle pre-fetches rows in order to reduce the number of
+round trips to the server. For queries which do not involve nested cursors,
+the number of pre-fetched rows is controlled by the DBI database handle
+attribute C<RowCacheSize> (q.v.).
+
+In Oracle, server side open cursors are a controlled resource, limited in
+number, on a per session basis, to the value of the initialization
+parameter C<OPEN_CURSORS>. Nested cursors count towards ths limit.
+Each nested cursor in the current row counts 1, as does
+each nested cursor in a pre-fetched row. Defunct nested cursors do not count.
+
+An Oracle specific database handle attribute, C< ora_max_nested_curso
rs>,
+further controls pre-fetching for queries involving nested cursors. For
+each statement handle, the total number of nested cursors in pre-fetched
+rows is limited to the value of this parameter. The default value
+is 0, which disables pre-fetching for queries involving nested cursors.
+
=head1 Returning A Value from an INSERT
Oracle supports an extended SQL insert syntax which will return one
Modified: dbd-oracle/trunk/dbdimp.c
====================
====================
====================
==================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Mon May 9 04:12:42 2005
@@ -763,6 +763,9 @@
else if (kl==12 && strEQ(key, "RowCacheSize")) {
imp_dbh->RowCacheSize = SvIV(valuesv);
}
+ else if (kl==22 && strEQ(key, " ora_max_nested_curso
rs")) {
+ imp_dbh->max_nested_cursors = SvIV(valuesv);
+ }
else if (kl==11 && strEQ(key, "ora_ph_type")) {
if (SvIV(valuesv)!=1 && SvIV(valuesv)!=5 && SvIV(valuesv)!=96 && SvIV(valuesv)!=97)
warn("ora_ph_type must be 1 (VARCHAR2), 5 (STRING), 96 (CHAR), or 97 (CHARZ)");
@@ -801,6 +804,9 @@
else if (kl==12 && strEQ(key, "RowCacheSize")) {
retsv = newSViv(imp_dbh->RowCacheSize);
}
+ else if (kl==22 && strEQ(key, " ora_max_nested_curso
rs")) {
+ retsv = newSViv(imp_dbh-> max_nested_cursors);
+ }
else if (kl==11 && strEQ(key, "ora_ph_type")) {
retsv = newSViv(imp_dbh->ph_type);
}
@@ -1610,6 +1616,15 @@
PerlIO_printf(DBILOG
FP, " dbd_st_execute %s (out%d, lob%d)...\n",
oci_stmt_type_name(i
mp_sth->stmt_type), outparams, imp_sth->has_lobs);
+ /* Don't attempt execute for nested cursor. It would be meaningless,
+ and Oracle code has been seen to core dump */
+ if (imp_sth->nested_cursor) {
+ oci_error(sth, NULL, OCI_ERROR,
+ "explicit execute forbidden for nested cursor");
+ return -2;
+ }
+
+
if (outparams) { /* check validity of bind_param_inout SV's */
int i = outparams;
while(--i >= 0) {
@@ -1798,6 +1813,9 @@
dTHR;
D_imp_dbh_from_sth;
sword status;
+ int num_fields = DBIc_NUM_FIELDS(imp_
sth);
+ int i;
+
if (DBIc_DBISTATE(imp_s
th)->debug >= 6)
PerlIO_printf(DBIc_L
OGPIO(imp_sth), " dbd_st_finish\n");
@@ -1812,8 +1830,10 @@
/* Turn off ACTIVE here regardless of errors below. */
DBIc_ACTIVE_off(imp_
sth);
- if (imp_sth->disable_finish) /* see ref cursors */
- return 1;
+ for(i=0; i < num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh);
+ }
if (dirty) /* don't walk on the wild side */
return 1;
@@ -1884,14 +1904,23 @@
sword status;
dTHX ;
+ /* Don't free the OCI statement handle for a nested cursor. It will
+ be reused by Oracle on the next fetch. Indeed, we never
+ free these handles. Experiment shows that Oracle frees them
+ when they are no longer needed.
+ */
+
if (DBIc_DBISTATE(imp_s
th)->debug >= 6)
PerlIO_printf(DBIc_L
OGPIO(imp_sth), " dbd_st_destroy %s\n",
- (dirty) ? "(OCIHandleFree skipped during global destruction)" : "");
+ (dirty) ? "(OCIHandleFree skipped during global destruction)" :
+ (imp_sth->nested_cursor) ?"(OCIHandleFree skipped for nested cursor)" : "");
if (!dirty) { /* XXX not ideal, leak may be a problem in some cases */
- OCIHandleFree_log_s
tat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
- if (status != OCI_SUCCESS)
- oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
+ if (!imp_sth->nested_cursor) {
+ OCIHandleFree_log_st
at(imp_sth->stmhp, OCI_HTYPE_STMT, status);
+ if (status != OCI_SUCCESS)
+ oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
+ }
}
/* Free off contents of imp_sth */
Modified: dbd-oracle/trunk/dbdimp.h
====================
====================
====================
==================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Mon May 9 04:12:42 2005
@@ -88,6 +88,7 @@
int ph_type; /* default oratype for placeholders */
ub1 ph_csform; /* default charset for placeholders */
int parse_error_offset;
/* position in statement of last error */
+ int max_nested_cursors; /* limit on cached nested cursors per stmt */
};
#define DBH_DUP_OFF sizeof(dbih_dbc_t)
@@ -110,7 +111,7 @@
U16 auto_lob;
int has_lobs;
lob_refetch_t *lob_refetch;
- int disable_finish; /* fetched cursors can core dump in finish */
+ int nested_cursor; /* cursors fetched from SELECTs */
/* Input Details */
char *statement; /* sql (see sth_scan) */
@@ -157,6 +158,7 @@
void *desc_h; /* descriptor if needed (LOBs etc) */
ub4 desc_t; /* OCI type of descriptorh */
int (*fetch_func) _((SV *sth, imp_fbh_t *fbh, SV *dest_sv));
+ void (*fetch_cleanup) _((SV *sth, imp_fbh_t *fbh));
ub2 dbtype; /* actual type of field (see ftype) */
ub2 dbsize;
Modified: dbd-oracle/trunk/oci8.c
====================
====================
====================
==================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Mon May 9 04:12:42 2005
@@ -575,6 +575,92 @@
/* ------ */
+static void
+fetch_cleanup_rset(
SV *sth, imp_fbh_t *fbh)
+{
+ SV *sth_nested = (SV *)fbh->special;
+ fbh->special = NULL;
+
+ if (sth_nested) {
+ dTHR;
+ D_impdata(imp_sth_
nested, imp_sth_t, sth_nested);
+ int fields = DBIc_NUM_FIELDS(imp_
sth_nested);
+ int i;
+ for(i=0; i < fields; ++i) {
+ imp_fbh_t *fbh_nested = &imp_sth_nested->fbh[i];
+ if (fbh_nested->fetch_cleanup)
+ fbh_nested-> fetch_cleanup(sth_ne
sted, fbh_nested);
+ }
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOG
FP,
+ " fetch_cleanup_rset - deactivating handle %s (defunct nested cursor)\n",
+ neatsvpv(sth_neste
d, 0));
+
+ DBIc_ACTIVE_off(im
p_sth_nested);
+ SvREFCNT_dec(sth_n
ested);
+ }
+}
+
+static int
+fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+{
+ OCIStmt *stmhp_nested = ((OCIStmt **)fbh->fb_ary->abuf)[0];
+
+ dTHR;
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth;
+ dSP;
+ HV *init_attr = newHV();
+ int count;
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBIL
OGFP,
+ " fetch_func_rset - allocating handle for cursor nested within %s ...\n",
+ neatsvpv(sth, 0));
+
+ ENTER; SAVETMPS; PUSHMARK(SP);
+ XPUSHs(sv_2mortal(ne
wRV((SV*)DBIc_MY_H(i
mp_dbh))));
+ XPUSHs(sv_2mortal(ne
wRV((SV*)init_attr))
);
+ PUTBACK;
+ count = perl_call_pv("DBI::_new_sth", G_ARRAY);
+ SPAGAIN;
+ if (count != 2)
+ croak("panic: DBI::_new_sth returned %d values instead of 2", count);
+ POPs;
+ sv_setsv(dest_sv, POPs);
+ SvREFCNT_dec(init_at
tr);
+ PUTBACK; FREETMPS; LEAVE;
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBIL
OGFP,
+ " fetch_func_rset - ... allocated %s for nested cursor\n",
+ neatsvpv(dest_sv, 0));
+
+ fbh->special = (void *)newSVsv(dest_sv);
+
+ {
+ D_impdata(imp_sth_
nested, imp_sth_t, dest_sv);
+ imp_sth_nested->envhp = imp_sth->envhp;
+ imp_sth_nested->errhp = imp_sth->errhp;
+ imp_sth_nested->srvhp = imp_sth->srvhp;
+ imp_sth_nested->svchp = imp_sth->svchp;
+
+ imp_sth_nested->stmhp = stmhp_nested;
+ imp_sth_nested->nested_cursor = 1;
+
+ imp_sth_nested->stmt_type = OCI_STMT_SELECT;
+
+ DBIc_IMPSET_on(imp
_sth_nested);
+
+ DBIc_ACTIVE_on(imp
_sth_nested); /* So describe won't do an execute */
+
+ if (!dbd_describe(dest_
sv, imp_sth_nested)) return 0;
+ }
+
+ return 1;
+}
+/* ------ */
+
int
dbd_rebind_ph_rset(S
V *sth, imp_sth_t *imp_sth, phs_t *phs)
@@ -1032,6 +1118,7 @@
int num_errors = 0;
int has_longs = 0;
int est_width = 0; /* estimated avg row width (for cache) */
+ int nested_cursors = 0;
ub4 i = 0;
sword status;
@@ -1205,6 +1292,14 @@
break;
#endif
+ case 116: /* RSET */
+ fbh->ftype = fbh->dbtype;
+ fbh->disize = sizeof(OCIStmt *);
+ fbh->fetch_func = fetch_func_rset;
+ fbh->fetch_cleanup = fetch_cleanup_rset;
+ nested_cursors++;
+ break;
+
case 182: /* INTERVAL YEAR TO MONTH */
case 183: /* INTERVAL DAY TO SECOND */
case 187: /* TIMESTAMP */
@@ -1256,6 +1351,10 @@
ub4 cache_mem = 0; /* so memory isn't the limit */
ub4 cache_rows = calc_cache_rows((int
)num_fields,
est_width, imp_sth->cache_rows, has_longs);
+ if (nested_cursors) {
+ int row_limit = imp_dbh->max_nested_cursors / nested_cursors;
+ if (cache_rows > row_limit) cache_rows = row_limit;
+ }
imp_sth->cache_rows = cache_rows; /* record updated value */
OCIAttrSet_log_stat(
imp_sth->stmhp, OCI_HTYPE_STMT,
&cache_mem, sizeof(cache_mem), OCI_ATTR_PREFETCH_ME
MORY,
@@ -1271,6 +1370,10 @@
else { /* set cache size by memory */
ub4 cache_mem = -imp_sth->cache_rows; /* cache_mem always +ve here */
ub4 cache_rows = 100000; /* set high so memory is the limit */
+ if (nested_cursors) {
+ int row_limit = imp_dbh->max_nested_cursors / nested_cursors;
+ if (cache_rows > row_limit) cache_rows = row_limit;
+ }
OCIAttrSet_log_stat(
imp_sth->stmhp, OCI_HTYPE_STMT,
&cache_rows, sizeof(cache_rows), OCI_ATTR_PREFETCH_RO
WS,
imp_sth->errhp, status);
@@ -1299,6 +1402,12 @@
fbh->fb_ary = fb_ary_alloc(define_
len, 1);
fb_ary = fbh->fb_ary;
+ if (fbh->ftype == 116) { /* RSET */
+ OCIHandleAlloc_ok(im
p_sth->envhp,
+ (dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
+ OCI_HTYPE_STMT, status);
+ }
+
OCIDefineByPos_log_s
tat(imp_sth->stmhp, &fbh->defnp,
imp_sth->errhp, (ub4) i,
(fbh->desc_h) ? (dvoid*)&fbh->desc_h : (dvoid*)fb_ary->abuf,
@@ -1356,11 +1465,17 @@
/* that dbd_describe() executed sucessfuly so the memory buffers */
/* are allocated and bound. */
if ( !DBIc_ACTIVE(imp_sth
) ) {
- oci_error(sth, NULL, OCI_ERROR,
+ oci_error(sth, NULL, OCI_ERROR, imp_sth->nested_cursor ?
+ "nested cursor is defunct (parent row is no longer current)" :
"no statement executing (perhaps you need to call execute first)");
return Nullav;
}
+ for(i=0; i < num_fields; ++i) {
+ imp_fbh_t *fbh = &imp_sth->fbh[i];
+ if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh);
+ }
+
if (ora_fetchtest && DBIc_ROW_COUNT(imp_s
th)>0) {
--ora_fetchtest; /* trick for testing performance */
status = OCI_SUCCESS;
Added: dbd-oracle/trunk/t/55nested.t
====================
====================
====================
==================
--- (empty file)
+++ dbd-oracle/trunk/t/55nested.t Mon May 9 04:12:42 2005
@@ -0,0 +1,61 @@
+#!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;
+
+$| = 1;
+
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh = DBI-> connect('dbi:Oracle:
', $dbuser, '', { PrintError => 0 });
+
+unless ($dbh) {
+ warn "Unable to connect to Oracle as $dbuser ($DBI::errstr)\nTest
s skipped.\n";
+ print "1..0\n";
+ exit 0;
+}
+
+my $tests = 16;
+
+print "1..$tests\n";
+
+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);
+
+$dbh->disconnect;
+
+exit 0;
+
|