[svn:dbd-oracle] r14574 - in dbd-oracle/trunk: . t

[email protected] Tue, 14 Dec 2010 16:41:56 -0800 (PST)
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: byterock
Date: Tue Dec 14 16:41:56 2010
New Revision: 14574

Modified:
   dbd-oracle/trunk/Oracle.h
   dbd-oracle/trunk/Oracle.pm
   dbd-oracle/trunk/Oracle.xs
   dbd-oracle/trunk/dbdimp.c
   dbd-oracle/trunk/oci.def
   dbd-oracle/trunk/oci8.c
   dbd-oracle/trunk/t/14threads.t

Log:
first round of changes to trunk for perl 5.13 PL_ added where found

Modified: dbd-oracle/trunk/Oracle.h
==============================================================================
--- dbd-oracle/trunk/Oracle.h	(original)
+++ dbd-oracle/trunk/Oracle.h	Tue Dec 14 16:41:56 2010
@@ -45,8 +45,6 @@
 
 #define NEED_DBIXS_VERSION 93
 
-#define PERL_POLLUTE
-
 #define PERL_NO_GET_CONTEXT  /*for Threaded Perl */
 
 #include <DBIXS.h>		/* installed by the DBI module	*/

Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm	(original)
+++ dbd-oracle/trunk/Oracle.pm	Tue Dec 14 16:41:56 2010
@@ -7,7 +7,7 @@
 
 require 5.006;
 
-$DBD::Oracle::VERSION = '1.26';
+$DBD::Oracle::VERSION = '1.27';
 
 my $ORACLE_ENV  = ($^O eq 'VMS') ? 'ORA_ROOT' : 'ORACLE_HOME';
 

Modified: dbd-oracle/trunk/Oracle.xs
==============================================================================
--- dbd-oracle/trunk/Oracle.xs	(original)
+++ dbd-oracle/trunk/Oracle.xs	Tue Dec 14 16:41:56 2010
@@ -173,7 +173,7 @@
 		}
 	}
 	ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE, maxlen)
-		? &sv_yes : &sv_no;
+		? &PL_sv_yes : &PL_sv_no;
 }
 
 
@@ -220,7 +220,7 @@
 		neatsvpv(DBIc_ERR(imp_sth),0), neatsvpv(DBIc_ERRSTR(imp_sth),0));
 
 void
-ora_execute_array(sth, tuples, exe_count, tuples_status, cols=&sv_undef)
+ora_execute_array(sth, tuples, exe_count, tuples_status, cols=&PL_sv_undef)
 	SV *		sth
 	SV *		tuples
 	IV		 exe_count
@@ -251,7 +251,7 @@
 	SV *		sth
 	CODE:
 	D_imp_sth(sth);
-	ST(0) = dbd_st_cancel(sth, imp_sth) ? &sv_yes : &sv_no;
+	ST(0) = dbd_st_cancel(sth, imp_sth) ? &PL_sv_yes : &PL_sv_no;
 
 
 MODULE = DBD::Oracle	PACKAGE = DBD::Oracle::db
@@ -293,7 +293,7 @@
 	char *	pwd
 	CODE:
 	D_imp_dbh(dbh);
-	ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &sv_yes : &sv_no;
+	ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &PL_sv_yes : &PL_sv_no;
 
 void
 ora_lob_write(dbh, locator, offset, data)
@@ -321,7 +321,7 @@
 	 OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 		return;
 	}
 #ifdef OCI_ATTR_CHARSET_ID
@@ -329,7 +329,7 @@
 	OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status );
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 		return;
 	}
 #endif /* OCI_ATTR_CHARSET_ID */
@@ -343,10 +343,10 @@
 		(ub2)0, csform , status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 	}
 	else {
-	ST(0) = &sv_yes;
+	ST(0) = &PL_sv_yes;
 	}
 
 void
@@ -377,7 +377,7 @@
 	OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 		return;
 	}
 #ifdef OCI_ATTR_CHARSET_ID
@@ -385,7 +385,7 @@
 	OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid, status );
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 		return;
 	}
 #endif /* OCI_ATTR_CHARSET_ID */
@@ -397,10 +397,10 @@
 				   csid, csform, status);
 	if (status != OCI_SUCCESS) {
 	   oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend");
-	   ST(0) = &sv_undef;
+	   ST(0) = &PL_sv_undef;
 	}
 	else {
-	   ST(0) = &sv_yes;
+	   ST(0) = &PL_sv_yes;
 	}
 
 
@@ -434,7 +434,7 @@
 	OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
-	dest_sv = &sv_undef;
+	dest_sv = &PL_sv_undef;
 		return;
 	}
 	OCILobRead_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator,
@@ -443,7 +443,7 @@
 		0, 0, (ub2)0, csform, status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobRead");
-		dest_sv = &sv_undef;
+		dest_sv = &PL_sv_undef;
 	}
 	else {
 		SvCUR(dest_sv) = amtp; /* always bytes here */
@@ -468,10 +468,10 @@
 	OCILobTrim_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, length, status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 	}
 	else {
-	ST(0) = &sv_yes;
+	ST(0) = &PL_sv_yes;
 	}
 
 void
@@ -486,7 +486,7 @@
 	OCILobLocatorIsInit_log_stat(imp_dbh->envhp,imp_dbh->errhp,locator,&is_init,status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobLocatorIsInit ora_lob_is_init");
-	    ST(0) = &sv_undef;
+	    ST(0) = &PL_sv_undef;
 	}
 	else {
 	    ST(0) = sv_2mortal(newSVuv(is_init));
@@ -504,7 +504,7 @@
 	OCILobGetLength_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &len, status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength ora_lob_length");
-	ST(0) = &sv_undef;
+	ST(0) = &PL_sv_undef;
 	}
 	else {
 	ST(0) = sv_2mortal(newSVuv(len));
@@ -523,7 +523,7 @@
 	OCILobGetChunkSize_log_stat(imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status);
 	if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCILobGetChunkSize");
-		ST(0) = &sv_undef;
+		ST(0) = &PL_sv_undef;
 	}
 	else {
 		ST(0) = sv_2mortal(newSVuv(chunk_size));

Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c	(original)
+++ dbd-oracle/trunk/dbdimp.c	Tue Dec 14 16:41:56 2010
@@ -212,7 +212,7 @@
 	dTHR;
 	dTHX;
 	/* The disconnect_all concept is flawed and needs more work */
-	if (!dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
+	if (!PL_dirty && !SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) {
 	DBIh_SET_ERR_CHAR(drh, (imp_xxh_t*)imp_drh, Nullch, 1, "disconnect_all not implemented", Nullch, Nullch);
 	return FALSE;
 	}
@@ -438,6 +438,7 @@
 				PerlIO_printf(DBILOGFP, "dbd_db_login6 skip connect\n");
 			/* tell our parent we've adopted an active child */
 			++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh));
+
 			return 1;
 		}
 		/* not ACTIVE so connect not skipped */
@@ -1265,7 +1266,7 @@
 		(void)SvREFCNT_inc(retsv);	/* so sv_2mortal won't free it	*/
 	}
 
-	if (retsv == &sv_yes || retsv == &sv_no)
+	if (retsv == &PL_sv_yes || retsv == &PL_sv_no)
 		return retsv; /* no need to mortalize yes or no */
 
 	return sv_2mortal(retsv);
@@ -1391,7 +1392,7 @@
 	phs_tpl.imp_sth = imp_sth;
 	phs_tpl.ftype  = imp_dbh->ph_type;
 	phs_tpl.csform = imp_dbh->ph_csform;
-	phs_tpl.sv = &sv_undef;
+	phs_tpl.sv = &PL_sv_undef;
 
 	src  = statement;
 	dest = imp_sth->statement;
@@ -2429,7 +2430,7 @@
 	if (!SvPOK(phs->sv)) {	/* normalizations for special cases	*/
 		if (SvOK(phs->sv)) {	/* ie a number, convert to string ASAP	*/
 			if (!(SvROK(phs->sv) && phs->is_inout))
-				sv_2pv(phs->sv, &na);
+				sv_2pv(phs->sv, &PL_na);
 		}
 		else /* ensure we're at least an SVt_PV (so SvPVX etc work)	*/
 			if(SvUPGRADE(phs->sv, SVt_PV)){} /* For gcc not to warn on unused result)*/;
@@ -2443,8 +2444,8 @@
 			PerlIO_printf(DBILOGFP, "NULL, ");
 		PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ",(long)SvCUR(phs->sv),(long)SvLEN(phs->sv),(long)phs->maxlen);
 		PerlIO_printf(DBILOGFP, "ptype %d(%s), otype %d %s)\n",(int)SvTYPE(phs->sv), sql_typecode_name(phs->ftype),phs->ftype,(phs->is_inout) ? ", inout" : "");
-		
-		
+
+
 	}
 
 	/* At the moment we always do sv_setsv() and rebind.	*/
@@ -2970,7 +2971,7 @@
 		/* This value is not a string, but a binary structure phs_st instead. */
 	phs = (phs_t*)(void*)SvPVX(*phs_svp);	/* placeholder struct	*/
 
-	if (phs->sv == &sv_undef) {	/* first bind for this placeholder	*/
+	if (phs->sv == &PL_sv_undef) {	/* first bind for this placeholder	*/
 		phs->is_inout = is_inout;
 		if (is_inout) {
 			/* phs->sv assigned in the code below */
@@ -3067,11 +3068,11 @@
 	phs->maxlen = maxlen;		/* 0 if not inout		*/
 
 	if (!is_inout) {	/* normal bind so take a (new) copy of current value	*/
-		if (phs->sv == &sv_undef)	/* (first time bind) */
+		if (phs->sv == &PL_sv_undef)	/* (first time bind) */
 			phs->sv = newSV(0);
 		sv_setsv(phs->sv, newvalue);
 		if (SvAMAGIC(phs->sv)) /* overloaded. XXX hack, logic ought to be pushed deeper */
-			sv_pvn_force(phs->sv, &na);
+			sv_pvn_force(phs->sv, &PL_na);
 	}
 	else if (newvalue != phs->sv) {
 		if (phs->sv)
@@ -3472,7 +3473,7 @@
 	phs_t *phs;
 {
 	dTHX;
-	if (phs->sv == &sv_undef) { /* first bind for this placeholder  */
+	if (phs->sv == &PL_sv_undef) { /* first bind for this placeholder  */
 		phs->is_inout = 0;
 		phs->maxlen = 1;
 		/* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
@@ -3846,7 +3847,7 @@
 		if (fbh->fetch_cleanup) fbh->fetch_cleanup(sth, fbh);
 	}
 
-	if (dirty)			/* don't walk on the wild side	*/
+	if (PL_dirty)			/* don't walk on the wild side	*/
 		return 1;
 
 	if (!DBIc_ACTIVE(imp_dbh))		/* no longer connected	*/
@@ -3963,10 +3964,10 @@
 
 	if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
 		PerlIO_printf(DBIc_LOGPIO(imp_sth), "	dbd_st_destroy %s\n",
-		(dirty) ? "(OCIHandleFree skipped during global destruction)" :
+		(PL_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 */
+	if (!PL_dirty) { /* XXX not ideal, leak may be a problem in some cases */
 		if (!imp_sth->nested_cursor) {
 			OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
 			if (status != OCI_SUCCESS)
@@ -4001,7 +4002,7 @@
 		I32 retlen;
 		hv_iterinit(hv);
 		while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
-			if (sv != &sv_undef) {
+			if (sv != &PL_sv_undef) {
 			  	phs_t *phs = (phs_t*)(void*)SvPVX(sv);
 				if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB)
 					ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h);
@@ -4059,7 +4060,7 @@
 	/* we can't return Nullsv here because the xs code will	*/
 	/* then just pass the attribute name to DBI for FETCH.	*/
 		croak("Describe failed during %s->FETCH(%s): %ld: %s",
-			SvPV(sth,na), key, (long)SvIV(DBIc_ERR(imp_sth)),
+			SvPV(sth,PL_na), key, (long)SvIV(DBIc_ERR(imp_sth)),
 			SvPV(DBIc_ERRSTR(imp_sth),lna)
 		);
 	}

Modified: dbd-oracle/trunk/oci.def
==============================================================================
--- dbd-oracle/trunk/oci.def	(original)
+++ dbd-oracle/trunk/oci.def	Tue Dec 14 16:41:56 2010
@@ -381,4 +381,10 @@
 OCIDateTimeToText
 OCIIntervalToText
 OCIDateTimeGetTimeZoneOffset
+OCIPing
+OCISessionRelease
+OCISessionPoolDestroy
+OCISessionPoolCreate
+OCISessionGet
+OCISessionPoolDestroy
 

Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c	(original)
+++ dbd-oracle/trunk/oci8.c	Tue Dec 14 16:41:56 2010
@@ -347,7 +347,7 @@
 #endif
 	}
 	sv = sv_2mortal(newSViv((IV)hdtype));
-	return SvPV(sv,na);
+	return SvPV(sv,PL_na);
 }
 
 /*used to look up the name of a csform value
@@ -368,7 +368,7 @@
 	}
 
 	sv = sv_2mortal(newSViv((IV)attr));
-	return SvPV(sv,na);
+	return SvPV(sv,PL_na);
 }
 
 /*used to look up the name of a OCI_DTYPE_PARAM Attribute Types
@@ -399,7 +399,7 @@
 	}
 
 	sv = sv_2mortal(newSViv((IV)attr));
-	return SvPV(sv,na);
+	return SvPV(sv,PL_na);
 
 }
 
@@ -691,7 +691,7 @@
 
 	}
 	sv = sv_2mortal(newSViv((IV)attr));
-	return SvPV(sv,na);
+	return SvPV(sv,PL_na);
 }
 
 /*used to look up the name of a fetchtype constant
@@ -712,7 +712,7 @@
 		case OCI_FETCH_RELATIVE:	return "OCI_FETCH_RELATIVE";
 	}
 	sv = sv_2mortal(newSViv((IV)fetchtype));
-	return SvPV(sv,na);
+	return SvPV(sv,PL_na);
 }
 
 
@@ -799,7 +799,7 @@
 		errcode = (status != 0) ? status : -10000;
 
 	sv_setiv(errcode_sv, errcode);
-	DBIh_SET_ERR_SV(h, imp_xxh, errcode_sv, errstr_sv, &sv_undef, &sv_undef);
+	DBIh_SET_ERR_SV(h, imp_xxh, errcode_sv, errstr_sv, &PL_sv_undef, &PL_sv_undef);
 	return 0; /* always returns 0 */
 
 }
@@ -827,7 +827,7 @@
 	sv_insert(sqlsv, parse_error_offset, 0, "<*>", 3);
 	sv_catsv(msgsv, sqlsv);
 	sv_catpv(msgsv, "'");
-	return SvPV(msgsv,na);
+	return SvPV(msgsv,PL_na);
 #else
 	imp_sth = imp_sth; /* not unused */
 	return msg;
@@ -1465,7 +1465,7 @@
 	if (!SvPOK(phs->sv)) {	 /* normalizations for special cases	 */
 		if (SvOK(phs->sv)) {	/* ie a number, convert to string ASAP  */
 			if (!(SvROK(phs->sv) && phs->is_inout))
-				sv_2pv(phs->sv, &na);
+				sv_2pv(phs->sv, &PL_na);
 		}
 		else { /* ensure we're at least an SVt_PV (so SvPVX etc work)	 */
 			if(SvUPGRADE(phs->sv, SVt_PV)){} /* For GCC not to warn on unused result */
@@ -2337,7 +2337,7 @@
 				}
 
 				if (attr_null_status==OCI_IND_NULL){
-					 av_push(list,  &sv_undef);
+					 av_push(list,  &PL_sv_undef);
 				} else {
 					if (fld->typecode == OCI_TYPECODE_OBJECT || fld->typecode == OCI_TYPECODE_VARRAY || fld->typecode == OCI_TYPECODE_TABLE || fld->typecode == OCI_TYPECODE_NAMEDCOLLECTION){
 
@@ -2374,7 +2374,7 @@
 						/*not really an error just no data
 						oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterCreate");*/
 						status = OCI_SUCCESS;
-						av_push(list,  &sv_undef);
+						av_push(list,  &PL_sv_undef);
 						return 0;
 					}
 					for(eoc = FALSE;!OCIIterNext(fbh->imp_sth->envhp, fbh->imp_sth->errhp, itr,
@@ -2383,7 +2383,7 @@
 					{
 
 						if (*element_null==OCI_IND_NULL){
-							av_push(list,  &sv_undef);
+							av_push(list,  &PL_sv_undef);
 						} else {
 							if (obj->element_typecode == OCI_TYPECODE_OBJECT || obj->element_typecode == OCI_TYPECODE_VARRAY || obj->element_typecode== OCI_TYPECODE_TABLE || obj->element_typecode== OCI_TYPECODE_NAMEDCOLLECTION){
 								fld->value = newAV();
@@ -2892,7 +2892,7 @@
 	obj->full_type_name = newSVpv((char*)schema_name, schema_namel);
 	sv_catpvn(obj->full_type_name, ".", 1);
 	sv_catpvn(obj->full_type_name, (char*)type_name, type_namel);
-	obj->type_name = (text*)SvPV(obj->full_type_name,na);
+	obj->type_name = (text*)SvPV(obj->full_type_name,PL_na);
 
 	/*we need to know its type code*/
 
@@ -3457,7 +3457,7 @@
 				p = "Field %d has an Oracle type (%d) which is not explicitly supported%s";
 				if (DBIS->debug >= 1 || dbd_verbose >= 3 )
 					PerlIO_printf(DBILOGFP, p, i, fbh->dbtype, "\n");
-				if (dowarn)
+				if (PL_dowarn)
 					warn(p, i, fbh->dbtype, "");
 				break;
 		}
@@ -4201,7 +4201,7 @@
 		int matched = 0;
 		phs_t *phs = (phs_t*)(void*)SvPVX(sv);
 
-		if (sv == &sv_undef || !phs)
+		if (sv == &PL_sv_undef || !phs)
 			croak("panic: unbound params");
 
 		if (phs->ftype != SQLT_CLOB && phs->ftype != SQLT_BLOB)
@@ -4212,9 +4212,9 @@
 		while( (sv = hv_iternextsv(lob_cols_hv, &p, &j)) != NULL ) {
 			char sql_field[200];
 			if (phs->ora_field) {	/* must match this phs by field name	*/
-				char *ora_field_name = SvPV(phs->ora_field,na);
+				char *ora_field_name = SvPV(phs->ora_field,PL_na);
 				if (SvCUR(phs->ora_field) != SvCUR(sv)
-					|| ibcmp(ora_field_name, SvPV(sv,na), (I32)SvCUR(sv) ) )
+					|| ibcmp(ora_field_name, SvPV(sv,PL_na), (I32)SvCUR(sv) ) )
 					continue;
 			}
 			else {			/* basic dumb match by type		*/

Modified: dbd-oracle/trunk/t/14threads.t
==============================================================================
--- dbd-oracle/trunk/t/14threads.t	(original)
+++ dbd-oracle/trunk/t/14threads.t	Tue Dec 14 16:41:56 2010
@@ -29,6 +29,7 @@
 unshift @INC, 't';
 require 'nchar_test_lib.pl';
 
+
 my $last_session : shared;
 our @pool : shared;
 
@@ -55,11 +56,13 @@
             free_dbh_to_pool($dbh);
         }
     )->join;
+   
+
 }
 
 # TESTS: 1
 is scalar(@pool), 1, 'one imp_data in pool';
-
+ 
 # get two sessions in same thread
 # TESTS: 2
 threads->create(