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.
DBD::Oracle-1.16 does not support queries using nested cursors.
It produces the following reasonable warning message at (pre-)execute
time before dumping core at fetch time:
Field [...] has an Oracle type (116) which is not explicitly supported
The patch below adds support for these queries to DBD::Oracle.
This patch is against the 1.16 distribution. If it is deemed
acceptable in principle, I will be happy to re-work it against
the latest development version.
--
Charles Jardine - Computing Service, University of Cambridge
[EMAIL PROTECTED] Tel: +44 1223 334506, Fax: +44 1223 334679
diff -r -u -N DBD-Oracle-1.16/Oracle.pm DBD-Oracle-1.16-nested/Oracle.pm
--- DBD-Oracle-1.16/Oracle.pm 2004-10-21 20:07:53.000000000 +0100
+++ DBD-Oracle-1.16-nested/Oracle.pm 2005-05-02 12:51:52.138587000 +0100
@@ -2447,6 +2447,78 @@
See the C<curref.pl> script in the Oracle.ex directory in the DBD::Oracle
source distribution for a complete working example.
+=head1 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 from nested cursors within the loop, as the following example
+shows:
+
+ use DBI;
+ my $dbh = DBI->connect(...);
+ my $sth = $dbh->prepare(q{
+ SELECT ename, CURSOR(
+ SELECT ename FROM emp WHERE mgr = mgr.empno
+ ) FROM emp mgr
+ });
+ $sth->execute;
+ while ( my ($mgr, $nested) = $sth->fetchrow_array ) {
+ print "$mgr\n";
+ while ( my ($emp) = $nested->fetchrow_array ) {
+ print " $emp\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_cursors>,
+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
diff -r -u -N DBD-Oracle-1.16/dbdimp.c DBD-Oracle-1.16-nested/dbdimp.c
--- DBD-Oracle-1.16/dbdimp.c 2004-10-18 09:25:11.000000000 +0100
+++ DBD-Oracle-1.16-nested/dbdimp.c 2005-04-27 11:19:41.249418000 +0100
@@ -766,6 +766,9 @@
else if (kl==12 && strEQ(key, "RowCacheSize")) {
imp_dbh->RowCacheSize = SvIV(valuesv);
}
+ else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) {
+ 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)");
@@ -804,6 +807,9 @@
else if (kl==12 && strEQ(key, "RowCacheSize")) {
retsv = newSViv(imp_dbh->RowCacheSize);
}
+ else if (kl==22 && strEQ(key, "ora_max_nested_cursors")) {
+ 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(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
oci_stmt_type_name(imp_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_sth)->debug >= 6)
PerlIO_printf(DBIc_LOGPIO(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_sth)->debug >= 6)
PerlIO_printf(DBIc_LOGPIO(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_stat(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_stat(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 */
diff -r -u -N DBD-Oracle-1.16/dbdimp.h DBD-Oracle-1.16-nested/dbdimp.h
--- DBD-Oracle-1.16/dbdimp.h 2004-10-19 22:43:24.000000000 +0100
+++ DBD-Oracle-1.16-nested/dbdimp.h 2005-04-27 11:20:22.489833000 +0100
@@ -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;
diff -r -u -N DBD-Oracle-1.16/oci8.c DBD-Oracle-1.16-nested/oci8.c
--- DBD-Oracle-1.16/oci8.c 2004-10-21 10:17:51.000000000 +0100
+++ DBD-Oracle-1.16-nested/oci8.c 2005-05-02 14:03:56.355251000 +0100
@@ -575,6 +575,81 @@
/* ------ */
+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_nested, fbh_nested);
+ }
+ DBIc_ACTIVE_off(imp_sth_nested);
+ SvREFCNT_dec(sth_nested);
+ }
+}
+
+static int
+fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+{
+ OCIStmt *stmhp_nested = ((OCIStmt **)fbh->fb_ary->abuf)[0];
+
+ D_imp_sth(sth);
+ D_imp_dbh_from_sth;
+ dSP;
+ HV *init_attr = newHV();
+ int count;
+
+ ENTER; SAVETMPS; PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh))));
+ XPUSHs(sv_2mortal(newRV((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_attr);
+ PUTBACK; FREETMPS; LEAVE;
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP,
+ " 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(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
@@ -1032,6 +1107,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 +1281,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 +1340,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_MEMORY,
@@ -1271,6 +1359,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_ROWS,
imp_sth->errhp, status);
@@ -1299,6 +1391,12 @@
fbh->fb_ary = fb_ary_alloc(define_len, 1);
fb_ary = fbh->fb_ary;
+ if (fbh->ftype == 116) { /* RSET */
+ OCIHandleAlloc_ok(imp_sth->envhp,
+ (dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
+ OCI_HTYPE_STMT, status);
+ }
+
OCIDefineByPos_log_stat(imp_sth->stmhp, &fbh->defnp,
imp_sth->errhp, (ub4) i,
(fbh->desc_h) ? (dvoid*)&fbh->desc_h : (dvoid*)fb_ary->abuf,
@@ -1360,11 +1458,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_sth)>0) {
--ora_fetchtest; /* trick for testing performance */
status = OCI_SUCCESS;
diff -r -u -N DBD-Oracle-1.16/t/55nested.t DBD-Oracle-1.16-nested/t/55nested.t
--- DBD-Oracle-1.16/t/55nested.t 1970-01-01 01:00:00.000000000 +0100
+++ DBD-Oracle-1.16-nested/t/55nested.t 2005-05-02 13:35:09.336523000 +0100
@@ -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)\nTests
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;
+
