[svn:dbd-oracle] r15557 - in dbd-oracle/trunk: . lib/DBD t

[email protected] Thu, 17 Jan 2013 12:13:58 -0800 (PST)
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: mjevans
Date: Thu Jan 17 12:13:58 2013
New Revision: 15557

Modified:
   dbd-oracle/trunk/Changes
   dbd-oracle/trunk/dbdimp.c
   dbd-oracle/trunk/lib/DBD/Oracle.pm
   dbd-oracle/trunk/ocitrace.h
   dbd-oracle/trunk/t/50cursor.t

Log:
Fix RT46628 and 82663 - output cursors which are never opened cause errors
added test case to 50cursor.t


Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes	(original)
+++ dbd-oracle/trunk/Changes	Thu Jan 17 12:13:58 2013
@@ -1,7 +1,24 @@
 Revision history for DBD::Oracle
 
+NEXTVERSION
+
+  [BUG FIXES]
+
+  - fix RT46628 - bind_param_inout ORA_RSET causes MSWin32 access
+    violation and RT82663 - Errors if a returned SYS_REFCURSOR is not
+    opened (Martin J. Evans)
+
+    If a procedure/function returns a SYS_REFCURSOR which was never opened
+    DBD::Oracle magics a DBI statement handle into existence and attempts
+    to describe it (which fails). This change examines a returned
+    SYS_REFCURSOR and if it it is initialised but not executed does not
+    create a DBI statement handle and returns undef instead. So now if you
+    have a procedure/function which returns a SYS_REFCURSOR and never open
+    it you'll get undef back instead of a useless statement handle.
+    Extended 50cursor.t test to check the above fix.
+
 1.56      2013-01-08
-  - fix t/26exe_array.t in the case of no db connection (RT82506, 
+  - fix t/26exe_array.t in the case of no db connection (RT82506,
     reported by Peter Rabbitson)
 
 1.54      2013-01-03
@@ -10,7 +27,7 @@
 1.53_00      2012-12-18
 
   [BUG FIXES]
-  - Fix RT69350 - 31lob.t was using $lob after destroying its parent $sth 
+  - Fix RT69350 - 31lob.t was using $lob after destroying its parent $sth
         (Rob Davies)
 
   - Fix memory leak in execute_array (John Scoles, Pierre-Alain Blanc)

Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c	(original)
+++ dbd-oracle/trunk/dbdimp.c	Thu Jan 17 12:13:58 2013
@@ -227,7 +227,7 @@
 		fbh->dbtype, fbh->ftype, (long)fbh->dbsize,(long)fbh->disize,
 		fbh->prec, fbh->scale);
 	if (fbh->fb_ary) {
-	PerlIO_printf(DBIc_LOGPIO(imp_sth), "	  out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n",
+        PerlIO_printf(DBIc_LOGPIO(imp_sth), "	  out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n",
 		fbh->ftype, fbh->fb_ary->bufl, fbh->fb_ary->aindp[aidx],
 		fbh->fb_ary->arlen[aidx], fbh->fb_ary->arcode[aidx]);
 	}
@@ -2665,11 +2665,7 @@
 {
     dTHX;
 
-	if (pre_exec) {	/* pre-execute - allocate a statement handle */
-		dSP;
-		D_imp_dbh_from_sth;
-		HV *init_attr = newHV();
-		int count;
+	if (pre_exec) {	/* pre-execute - throw away previous descriptor and rebind */
 		sword status;
 
 		if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
@@ -2691,7 +2687,6 @@
 			OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t, status);
 		 }
 
-
 		phs->progv = (char*)&phs->desc_h;
 		phs->maxlen = 0;
 
@@ -2701,6 +2696,11 @@
 			phs->progv,
 			0,
 			(ub2)phs->ftype,
+            /* I, MJE have no evidence that passing an indicator to this func
+               causes ORA-01001 (invalid cursor) errors. Also, without it
+               you cannot test the indicator to check we have a valid output
+               parameter. However, it would seem when you do specify an
+               indicator it always comes back as 0 so it is useless. */
 			NULL, /* using &phs->indp triggers ORA-01001 errors! */
 			NULL,
 			0,
@@ -2714,6 +2714,51 @@
 			return 0;
 		}
 
+        /*
+          NOTE: The code used to magic a DBI stmt handle into existence
+          here before even knowing if the output parameter was going to
+          be a valid open cursor. The code to do this moved to post execute
+          below. See RT 82663 - Errors if a returned SYS_REFCURSOR is not opened
+        */
+	}
+	else {		/* post-execute - setup the statement handle */
+		dTHR;
+		dSP;
+		D_imp_dbh_from_sth;
+		HV *init_attr = newHV();
+		int count;
+        ub4 stmt_state = 99;
+        sword status;
+		SV * sth_csr;
+
+        /* Before we go to the bother of attempting to allocate a new sth
+           for this cursor make sure the Oracle sth is executed i.e.,
+           the returned cursor may never have been opened */
+        OCIAttrGet_stmhp_stat2(imp_sth, (OCIStmt*)phs->desc_h, &stmt_state, 0,
+                               OCI_ATTR_STMT_STATE, status);
+        if (status != OCI_SUCCESS) {
+            oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_STMT_STATE");
+            return 0;
+        }
+        if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
+            /* initialized=1, executed=2, end of fetch=3 */
+            PerlIO_printf(
+                DBIc_LOGPIO(imp_sth),
+                "	returned cursor/statement state: %u, indicator=%d\n",
+                stmt_state, phs->indp2);
+        }
+
+        /* We seem to get an indp of 0 even for a cursor which was never
+           opened and set to NULL. If this is the case we check the stmt state
+           and find the cursor is initialized but not executed - there is no
+           point in going any further if it is not executed - just return undef.
+           See RT 82663 */
+        if (stmt_state == OCI_STMT_STATE_INITIALIZED) {
+            phs->sv = newSV(0);                 /* undef */
+            return 1;
+        }
+
+        /* Now we know we have an executed cursor create a new sth */
 		ENTER;
 		SAVETMPS;
 		PUSHMARK(SP);
@@ -2738,11 +2783,7 @@
                 "   pp_exec_rset   bind %s - allocated %s...\n",
                 phs->name, neatsvpv(phs->sv, 0));
 
-	}
-	else {		/* post-execute - setup the statement handle */
-		dTHR;
-		SV * sth_csr = phs->sv;
-		D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
+        sth_csr = phs->sv;
 
 		if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
 			PerlIO_printf(
@@ -2750,32 +2791,36 @@
                 "	   bind %s - initialising new %s for cursor 0x%lx...\n",
                 phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv);
 
-		/* copy appropriate handles and atributes from parent statement	*/
-		imp_sth_csr->envhp		= imp_sth->envhp;
-		imp_sth_csr->errhp		= imp_sth->errhp;
-		imp_sth_csr->srvhp		= imp_sth->srvhp;
-		imp_sth_csr->svchp		= imp_sth->svchp;
-		imp_sth_csr->auto_lob	= imp_sth->auto_lob;
-		imp_sth_csr->pers_lob	= imp_sth->pers_lob;
-		imp_sth_csr->clbk_lob	= imp_sth->clbk_lob;
-		imp_sth_csr->piece_size	= imp_sth->piece_size;
-		imp_sth_csr->piece_lob	= imp_sth->piece_lob;
-		imp_sth_csr->is_child	= 1; /*no prefetching on a cursor or sp*/
-
-
-		 /* assign statement handle from placeholder descriptor	*/
-		imp_sth_csr->stmhp = (OCIStmt*)phs->desc_h;
-		phs->desc_h = NULL;		  /* tell phs that we own it now	*/
-
-	 /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */
-		imp_sth_csr->stmt_type = OCI_STMT_SELECT;
- 		DBIc_IMPSET_on(imp_sth_csr);
-
-	 /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */
-		DBIc_ACTIVE_on(imp_sth_csr);
-		if (!dbd_describe(sth_csr, imp_sth_csr)) {
-			return 0;
-		}
+        {
+            D_impdata(imp_sth_csr, imp_sth_t, sth_csr); /* TO_DO */
+
+            /* copy appropriate handles and atributes from parent statement	*/
+            imp_sth_csr->envhp		= imp_sth->envhp;
+            imp_sth_csr->errhp		= imp_sth->errhp;
+            imp_sth_csr->srvhp		= imp_sth->srvhp;
+            imp_sth_csr->svchp		= imp_sth->svchp;
+            imp_sth_csr->auto_lob	= imp_sth->auto_lob;
+            imp_sth_csr->pers_lob	= imp_sth->pers_lob;
+            imp_sth_csr->clbk_lob	= imp_sth->clbk_lob;
+            imp_sth_csr->piece_size	= imp_sth->piece_size;
+            imp_sth_csr->piece_lob	= imp_sth->piece_lob;
+            imp_sth_csr->is_child	= 1; /*no prefetching on a cursor or sp*/
+
+
+            /* assign statement handle from placeholder descriptor	*/
+            imp_sth_csr->stmhp = (OCIStmt*)phs->desc_h;
+            phs->desc_h = NULL;		  /* tell phs that we own it now	*/
+
+            /* force stmt_type since OCIAttrGet(OCI_ATTR_STMT_TYPE) doesn't work! */
+            imp_sth_csr->stmt_type = OCI_STMT_SELECT;
+            DBIc_IMPSET_on(imp_sth_csr);
+
+            /* set ACTIVE so dbd_describe doesn't do explicit OCI describe */
+            DBIc_ACTIVE_on(imp_sth_csr);
+            if (!dbd_describe(sth_csr, imp_sth_csr)) {
+                return 0;
+            }
+        }
 	}
 
 	return 1;
@@ -3477,7 +3522,7 @@
 				PerlIO_printf(
                     DBIc_LOGPIO(imp_sth),
 					"dbd_st_execute(): Analyzing inout  a parameter '%s"
-                    "of type=%d  name=%s'\n",
+                    " of type=%d  name=%s'\n",
 					phs->name,phs->ftype,sql_typecode_name(phs->ftype));
 			}
 			if( phs->ftype == ORA_VARCHAR2_TABLE ){

Modified: dbd-oracle/trunk/lib/DBD/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/lib/DBD/Oracle.pm	(original)
+++ dbd-oracle/trunk/lib/DBD/Oracle.pm	Thu Jan 17 12:13:58 2013
@@ -4984,14 +4984,24 @@
   $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
+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.
 
+NOTE: From DBD::Oracle 1.57 functions or procedures returning
+SYS_REFCURSORs which have not been opened (are still in the
+initialised state) will return undef for the cursor statement handle
+e.g., in the example above if the sp_ListEmp function simply returned l_cursor
+instead of opening it. This means you can have a function/procedure
+which can elect to open the cursor or not, Before this change if you called
+a function/procedure which returned a SYS_REFCURSOR which was not opened
+DBD::Oracle would error in the execute for a OCIAttrGet on the uninitialised
+cursor.
+
 See the C<curref.pl> script in the Oracle.ex directory in the DBD::Oracle
 source distribution for a complete working example.
 

Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h	(original)
+++ dbd-oracle/trunk/ocitrace.h	Thu Jan 17 12:13:58 2013
@@ -317,6 +317,10 @@
 	OCIAttrGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT,         \
 		(void*)(p1), (l), (a), imp_sth->errhp, stat)
 
+#define OCIAttrGet_stmhp_stat2(imp_sth, stmhp, p1, l, a, stat)              \
+	OCIAttrGet_log_stat(imp_sth, stmhp, OCI_HTYPE_STMT,         \
+		(void*)(p1), (l), (a), imp_sth->errhp, stat)
+
 #define OCIAttrSet_log_stat(impxxh,th,ht,ah,s1,a,eh,stat)   \
 	stat=OCIAttrSet(th,ht,ah,s1,a,eh);				\
 	(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \

Modified: dbd-oracle/trunk/t/50cursor.t
==============================================================================
--- dbd-oracle/trunk/t/50cursor.t	(original)
+++ dbd-oracle/trunk/t/50cursor.t	Thu Jan 17 12:13:58 2013
@@ -37,7 +37,7 @@
         $limit = 1;
     }
     $limit = 100 if $limit > 100; # lets not be greedy or upset DBA's
-    $tests = 2 + 10 * $limit;
+    $tests = 2 + 10 * $limit + 7;
 
     plan tests => $tests;
 
@@ -83,6 +83,35 @@
 	ok($close_cursor->execute, 'close cursor execute');
 }
 
+$dbh->{RaiseError} = 1;
+eval {
+    $dbh->do(<<'EOT');
+create or replace procedure dbd_oracle_test(aref out sys_refcursor) as
+begin
+   aref := NULL;
+end;
+EOT
+};
+
+my $ev = $@;
+diag($ev) if $@;
+SKIP: {
+    skip 'failed to create proc for test so skipping', 5 if $ev;
+
+    local $dbh->{RaiseError} = 0;
+
+    ok(my $sth1 = $dbh->prepare(q/begin dbd_oracle_test(?); end;/),
+       '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');
+    ok($dbh->do(q/drop procedure dbd_oracle_test/),
+      'drop dbd_oracle_test proc');
+};
+
 $dbh->disconnect;
 
 exit 0;