[svn:dbd-oracle] r15428 - dbd-oracle/branches/FAN

[email protected] Fri, 5 Oct 2012 08:56:13 -0700 (PDT)
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: byterock
Date: Fri Oct  5 08:56:09 2012
New Revision: 15428

Modified:
   dbd-oracle/branches/FAN/dbdimp.c
   dbd-oracle/branches/FAN/dbdimp.h
   dbd-oracle/branches/FAN/oci8.c

Log:
HA changes incorporating net little tricks from taf improvements

Modified: dbd-oracle/branches/FAN/dbdimp.c
==============================================================================
--- dbd-oracle/branches/FAN/dbdimp.c	(original)
+++ dbd-oracle/branches/FAN/dbdimp.c	Fri Oct  5 08:56:09 2012
@@ -437,25 +437,23 @@
 		OCIAttrSet_log_stat(imp_dbh->seshp,OCI_HTYPE_SESSION,(text*)"DBDO1.28",7,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
 	}
 
-   /* HA Events */
+    /* HA Events */
 
-	imp_dbh->using_ha = 0;
+	if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_ha_function",  15)) && SvOK(*svp)){
 
-	if (DBD_ATTRIB_TRUE(attr,"ora_ha_function",15,svp)){
-		imp_dbh->using_ha = 1;
+        if ((SvROK(*svp) && (SvTYPE(SvRV(*svp)) == SVt_PVCV)) ||
+            (SvPOK(*svp))) {
+            imp_dbh->ha_function = newSVsv(*svp);
+        } else {
+            croak("ora_ha_function needs to be a string or code reference");
+        }
 
-		if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_ha_function",  15)) && SvOK(*svp)) {
-			STRLEN  svp_len;
-
-			if (!SvPOK(*svp))
-				croak("ora_ha_function is not a string");
+        (void)hv_delete((HV*)SvRV(attr), "ora_ha_function", 15, G_DISCARD);
 
-			imp_dbh->ha_function = (char *) SvPV (*svp, svp_len );
-
-		}
 	}
 
 
+
 #endif /*ORA_OCI_112*/
 
 	if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_action", 10)) && SvOK(*svp)) {
@@ -935,20 +933,9 @@
 #ifdef ORA_OCI_112
 	/* set up HA evnets callback if requested */
 
-	if (imp_dbh->using_ha){
-
-		if (DBIS->debug >= 4 || dbd_verbose >= 4 ) {
-			PerlIO_printf(DBILOGFP,"Setting up HA Event Callback!");
-		}
-
-		status = reg_ha_callback(imp_dbh);
-
-		if (status != OCI_SUCCESS) {
-			oci_error(dbh, NULL, status,"Setting HA Event Callback Failed! ");
-			return 0;
-		}
+	if (imp_dbh->ha_function){
+       if (enable_ha(dbh,imp_dbh) == 0) return 0;
 	}
-
 #endif /* ORA_OCI_112 */
 	return 1;
 }
@@ -1128,13 +1115,22 @@
 
 #ifdef ORA_OCI_112
 
-		if (imp_dbh->using_ha){
-			ha_ctx_t *ctx = NULL;
-			ctx->function = NULL;
-			ctx->ctx_perl = NULL;
-			ctx->imp_dbh  = NULL;
-			OCIAttrSet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV,
-								ctx,0,OCI_ATTR_EVTCTX, imp_dbh->errhp , status);
+	if (imp_dbh->taf_function){
+            disable_taf(imp_dbh);
+		}
+
+        if (imp_dbh->taf_function) {
+            SvREFCNT_dec(imp_dbh->taf_function);
+            imp_dbh->taf_function = NULL;
+        }
+        if (imp_dbh->taf_ctx.dbh_ref) {
+            SvREFCNT_dec(SvRV(imp_dbh->taf_ctx.dbh_ref));
+            imp_dbh->taf_ctx.dbh_ref = NULL;
+        }
+
+		if (imp_dbh->ha_function){
+			disable_taf(imp_dbh);
+
 		}
 
 
@@ -4367,9 +4363,8 @@
 }
 
 static void
-dump_env_to_trace() {
+dump_env_to_trace(imp_dbh_t *imp_dbh) {
 	dTHX;
-	PerlIO *fp = DBILOGFP;
 	int i = 0;
 	char *p;
 
@@ -4381,10 +4376,51 @@
 #endif
 
 
-	PerlIO_printf(fp, "Environment variables:\n");
+	PerlIO_printf(DBIc_LOGPIO(imp_dbh), "Environment variables:\n");
 	do {
-	p = (char*)environ[i++];
-	PerlIO_printf(fp,"\t%s\n",p);
+        p = (char*)environ[i++];
+        PerlIO_printf(DBIc_LOGPIO(imp_dbh),"\t%s\n",p);
 	} while ((char*)environ[i] != '\0');
 }
 
+
+
+#ifdef ORA_OCI_112
+	/* HA functiosn only on 11+ */
+
+static void disable_ha(imp_dbh_t *imp_dbh) {
+	sword	status;
+
+   	ha_ctx_t *ctx = NULL;
+	ctx->function = NULL;
+	ctx->ctx_perl = NULL;
+	ctx->imp_dbh  = NULL;
+
+	OCIAttrSet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV,ctx,0,OCI_ATTR_EVTCTX, imp_dbh->errhp , status);
+
+	return;
+
+}
+
+static int enable_ha
+    SV *dbh,
+    imp_dbh_t *imp_dbh) {
+
+	if (DBIS->debug >= 4 || dbd_verbose >= 4 ) {
+		PerlIO_printf(DBILOGFP,"Setting up HA Event Callback!");
+	}
+
+	status = reg_ha_callback(imp_dbh);
+
+	if (status != OCI_SUCCESS) {
+		oci_error(dbh, NULL, status,"Setting HA Event Callback Failed! ");
+		return 0;
+	}
+
+   	return 1;
+
+}
+
+#endif /* ORA_OCI_112 */
+
+

Modified: dbd-oracle/branches/FAN/dbdimp.h
==============================================================================
--- dbd-oracle/branches/FAN/dbdimp.h	(original)
+++ dbd-oracle/branches/FAN/dbdimp.h	Fri Oct  5 08:56:09 2012
@@ -13,11 +13,12 @@
 typedef struct ha_ctx_st ha_ctx_t;
 
 struct ha_ctx_st {
-	PerlInterpreter *ctx_perl;
-	imp_dbh_t	*imp_dbh;
-	char 		*function;
+	PerlInterpreter *ctx_perl; /* perl context */
+	SV   *function; /* user's FAN function  */
+	SV   *dbh_ref;  /* present DBH handle */
 };
 
+
 /*--------------------------TAF Callback Structure ---------------------*/
 
 typedef struct taf_callback_st taf_callback_t;
@@ -69,8 +70,8 @@
 	ub4			pool_incr;
 	char		*driver_name;/*driver name user defined*/
 	ub4			driver_namel;
-	bool		using_ha; /*HA events */
-	char		*ha_function; /*HA function */
+	SV		    *ha_function; /*HA function */
+	ha_ctx_t    ha_ctx;       /*HA context  */
 #endif
 	bool		using_taf; /*TAF stuff*/
 	char		*taf_function; /*User supplied TAF function*/

Modified: dbd-oracle/branches/FAN/oci8.c
==============================================================================
--- dbd-oracle/branches/FAN/oci8.c	(original)
+++ dbd-oracle/branches/FAN/oci8.c	Fri Oct  5 08:56:09 2012
@@ -1310,6 +1310,7 @@
 
 
 
+
 void
 ha_cbk( dvoid *ha_ctx, OCIEvent *eventhp)
 {
@@ -1393,33 +1394,31 @@
 
 	hv_store(ha_event,"Instances",9,newRV_noinc((SV*)servers),0);
 	XPUSHs(sv_2mortal(newRV((SV*)ha_event)));
+    XPUSHs(SvRV(ctx->dbh_ref));
 	PUTBACK;
 	call_pv(ctx->function, G_DISCARD);
 
 }
 
-/*   HA or High Availability Callback */
-/*   Works like this.  The function below is registered on the cluster,*/
-/*   when a node on a cluster goes up or down then messages are propagated */
-/*   to the other nodes on the cluster.  Used for load balancing are reconnecting. */
-/*   Not very useful to perl as you cannot do much but monitor events as this */
-/*   is using threaded perl and you go not have a DB handle to play with */
 
 sb4
-reg_ha_callback( imp_dbh_t *imp_dbh)
+reg_ha_callback(SV *dbh,  imp_dbh_t *imp_dbh)
 {
 	dTHX;
 	sword status;
 	ha_ctx_t  *ctx = NULL;
-	Newz(1, ctx, 1, ha_ctx_t);
-	ctx->function = (char*)safemalloc(strlen(imp_dbh->ha_function));
-	ctx->ctx_perl = my_perl;
-	ctx->imp_dbh  = imp_dbh;
+
+	imp_dbh->ha_ctx.function = imp_dbh->taf_function;
+	imp_dbh->ha_ctx.ctx_perl = my_perl;
+	imp_dbh->ha_ctx.dbh_ref  = dbh;
+    ctx = &imp_dbh->ha_ctx;
+
 
 	if (dbd_verbose >= 5 ) {
-		PerlIO_printf(DBILOGFP, " Register HA callback %s\n",imp_dbh->ha_function);
+		PerlIO_printf(DBILOGFP, " In reg_ha_callback " );
 	}
 
+
 	OCIAttrSet_log_stat(imp_dbh->envhp, (ub4) OCI_HTYPE_ENV,(dvoid *)ha_cbk ,(ub4)0,(ub4)OCI_ATTR_EVTCBK, imp_dbh->errhp, status);
 	OCIAttrSet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV,ctx,0,OCI_ATTR_EVTCTX, imp_dbh->errhp , status);