From:	byterock@cvs.perl.org	Date:	Fri Sep 12 11:04:49 2008
Subject:	[svn:dbd-oracle] r11772 - dbd-oracle/branches/utf8_ea

Author: byterock
Date: Fri Sep 12 10:04:47 2008
New Revision: 11772

Modified:
   dbd-oracle/branches/utf8_ea/dbdimp.c

Log:
with some debugging not for production or even test

Modified: dbd-oracle/branches/utf8_ea/dbdimp.c
==============================================================================
--- dbd-oracle/branches/utf8_ea/dbdimp.c	(original)
+++ dbd-oracle/branches/utf8_ea/dbdimp.c	Fri Sep 12 10:04:47 2008
@@ -375,8 +375,8 @@
     	DBD_ATTRIB_GET_IV(  attr, "dbd_verbose",  11, svp, dbd_verbose);
 	if (DBD_ATTRIB_TRUE(attr,"ora_verbose",11,svp))
     	DBD_ATTRIB_GET_IV(  attr, "ora_verbose",  11, svp, dbd_verbose);
-   
-  
+
+
     /* dbi_imp_data code adapted from DBD::mysql */
     if (DBIc_has(imp_dbh, DBIcf_IMPSET)) {
         /* dbi_imp_data from take_imp_data */
@@ -410,13 +410,13 @@
 		mg = mg_find(shared_dbh_priv_sv, PERL_MAGIC_shared_scalar) ;
 
 		shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ;  /*sharedsv_find(*shared_dbh_priv_sv) ;*/
-		
+
 		if (!shared_dbh_ssv)
 			croak ("value of ora_dbh_share must be a scalar that is shared") ;
 
 		shared_dbh 		= (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ;
 		shared_dbh_len 	= SvCUR((shared_dbh_ssv -> sv)) ;
-		
+
 		if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t))
 	    	croak ("Invalid value for ora_dbh_dup") ;
 
@@ -435,7 +435,7 @@
 #endif
 
     /* Check if we should re-use a ProC connection and not connect ourselves. */
-    
+
     DBD_ATTRIB_GET_IV(attr, "ora_use_proc_connection", 23,
 		      use_proc_connection_sv, use_proc_connection);
 
@@ -564,7 +564,7 @@
 	    attribute and ncharset controls the encoding for data with SQLCS_NCHAR
 	    form attribute.
 	    }*/
-				
+
             OCIEnvNlsCreate_log_stat( &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0,
 			charsetid, ncharsetid, status );
             if (status != OCI_SUCCESS) {
@@ -587,7 +587,7 @@
             }
 
             svp = DBD_ATTRIB_GET_SVP(attr, "ora_ncharset", 12); /*get the ncharset passed in by the user*/
-            
+
             if (svp) {
                 if (!SvPOK(*svp)) {
                     croak("ora_ncharset is not a string");
@@ -622,8 +622,8 @@
 	    /* XXX recent oracle docs recommend using OCIEnvCreate() instead of	*/
 	    /* OCIInitialize + OCIEnvInit, we'd need ifdef's for pre-OCIEnvNlsCreate */
 	    	OCIInitialize_log_stat(init_mode, 0, 0,0,0, status);
-	    
-	    
+
+
 	    	if (status != OCI_SUCCESS) {
 				oci_error(dbh, NULL, status,
 			    "OCIInitialize. Check Check ORACLE_HOME (Linux) env var  or PATH (Windows) and or NLS settings, permissions, etc");
@@ -655,7 +655,7 @@
 						err_hint = "SQLEnvGet failed to load ProC environment";
 		   			oci_error(dbh, (OCIError*)imp_dbh->envhp, status, err_hint);
 		   			return 0;
-				}		
+				}
 	    	}
 	    	else {
 				OCIEnvInit_log_stat( &imp_dbh->envhp, OCI_DEFAULT, 0, 0, status);
@@ -673,6 +673,9 @@
 
     OCIAttrGet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, &charsetid, (ub4)0 ,
 			OCI_ATTR_ENV_CHARSET_ID, imp_dbh->errhp, status);
+
+
+
     if (status != OCI_SUCCESS) {
 		oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_CHARSET_ID");
 		return 0;
@@ -690,14 +693,22 @@
     *  be distinct if NLS_LANG and NLS_NCHAR are both used.
     *  BTW: NLS_NCHAR is set as follows: NSL_LANG=AL32UTF8
     */
+
+
+
+
     if (DBIS->debug >= 3 || dbd_verbose >= 3) {
+		ub1      is_utf8;
         oratext  charsetname[OCI_NLS_MAXBUFSZ];
         oratext  ncharsetname[OCI_NLS_MAXBUFSZ];
+         OCIAttrGet_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, &is_utf8, 0 ,
+					OCI_ATTR_ENV_CHARSET_ID, imp_dbh->errhp, status);
+
        	OCINlsCharSetIdToName(imp_dbh->envhp,charsetname, sizeof(charsetname),charsetid );
        	OCINlsCharSetIdToName(imp_dbh->envhp,ncharsetname, sizeof(ncharsetname),ncharsetid );
      	PerlIO_printf(DBILOGFP,"       charset id=%d, name=%s, ncharset id=%d, name=%s"
-	    " (csid: utf8=%d al32utf8=%d)\n",
-	     charsetid,charsetname, ncharsetid,ncharsetname, utf8_csid, al32utf8_csid);
+	    " (csid: utf8=%d al32utf8=%d and this=%d)\n",
+	     charsetid,charsetname, ncharsetid,ncharsetname, utf8_csid, al32utf8_csid,is_utf8);
     }
 
 
@@ -777,7 +788,7 @@
 				OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR,  status);
 				OCIHandleFree_log_stat(imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
 			    OCIHandleFree_log_stat(imp_dbh->envhp, OCI_HTYPE_ENV, status);
-                 
+
 				return 0;
 	    	}
 
@@ -2259,8 +2270,8 @@
    		phs->maxlen  = ((IV)SvLEN(phs->sv)); /* avail buffer space (64bit safe) Logicaly maxlen should never change but it does why I know not*/
 
     }
-  	   
-    
+
+
     if (phs->maxlen < 0)		/* can happen with nulls	*/
 	  phs->maxlen = 0;
 
@@ -2308,15 +2319,15 @@
 			   (ub4)OCI_DEFAULT,
 			   status
 			   );
- 
+
  	if (status != OCI_SUCCESS) {
       oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
       return 0;
     }
- 
+
  	if (DBIS->debug >= 3 || dbd_verbose >=3)
 		PerlIO_printf(DBILOGFP, "    pp_rebind_ph_rset_in: END\n");
-		
+
     return 2;
 }
 
@@ -2348,11 +2359,11 @@
 	    phs->desc_t = OCI_HTYPE_STMT;
 	    OCIHandleAlloc_ok(imp_sth->envhp, &phs->desc_h, phs->desc_t, status);
 	}
-	
-	
+
+
 	phs->progv = (char*)&phs->desc_h;
 	phs->maxlen = 0;
-	
+
 	OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
 		(text*)phs->name, (sb4)strlen(phs->name),
 		phs->progv, 0,
@@ -2403,8 +2414,8 @@
 	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	*/
@@ -2537,8 +2548,8 @@
 		    PerlIO_printf(DBILOGFP, "      rebind %s done with ftype %d (%s)\n",
 			    phs->name, phs->ftype,sql_typecode_name(phs->ftype));
 		return 1;
-    } 
-    
+    }
+
     if (trace_level >= 3 || dbd_verbose >= 3 )
 		PerlIO_printf(DBILOGFP, "      bind %s as ftype %d (%s)\n",
 		phs->name, phs->ftype,sql_typecode_name(phs->ftype));
@@ -3103,7 +3114,7 @@
     ub1 csform;
     ub2 csid;
     int trace_level = DBIS->debug;
-  
+
     OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
             (text*)phs->name, (sb4)strlen(phs->name),
             0,
@@ -3128,7 +3139,7 @@
         oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
         return 0;
     }
-    
+
     /* copied and adapted from dbd_rebind_ph */
 	csform = phs->csform;
 	if (!csform && (utf8 & ARRAY_BIND_UTF8)) {
@@ -3137,14 +3148,14 @@
 			csform = SQLCS_IMPLICIT;
 		else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR))
 		     csform = SQLCS_NCHAR;   /* else leave csform == 0 */
-		
+
 		if (trace_level || dbd_verbose >= 1)
 			PerlIO_printf(DBILOGFP, "do_bind_array_exec() (2): rebinding %s with UTF8 value %s", phs->name,
 			(csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT" :
 			(csform == SQLCS_NCHAR)    ? "so setting csform=SQLCS_NCHAR" :
 			"but neither CHAR nor NCHAR are unicode\n");
 	}
-	
+
 	if (csform) {
 		/* set OCI_ATTR_CHARSET_FORM before we get the default OCI_ATTR_CHARSET_ID */
 		OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND,&csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status);
@@ -3153,37 +3164,41 @@
 			return 0;
 		}
 	}
-	
+
 	if (!phs->csid_orig) {      /* get the default csid Oracle would use */
 		OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0 ,
                 OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
 	}
-	
+
 	/* if app has specified a csid then use that, else use default */
+
+	PerlIO_printf(DBILOGFP, "csid =%d\n",phs->csid);
+	PerlIO_printf(DBILOGFP, "csid_orig =%d\n",phs->csid_orig);
 	csid = (phs->csid) ? phs->csid : phs->csid_orig;
-	
+
+    PerlIO_printf(DBILOGFP, "csid =%d\n",csid);
 	/* if data is utf8 but charset isn't then switch to utf8 csid if possible */
 	if ((utf8 & ARRAY_BIND_UTF8) && !CS_IS_UTF8(csid)) {
 		/* if the specified or default csid is not utf8 _compatible_ AND we have */
 		/* mixed utf8 and native (non-utf8) data, then it's a fatal problem */
 	    /* utf8 _compatible_ means, can be upgraded to utf8, ie. utf8 or ascii */
-	    if ((utf8 & ARRAY_BIND_NATIVE) && !CS_IS_UTF8_COMPATIBLE(csid)) {
-			croak("Can't mix utf8 and non-utf8 in array bind");
-	    }
-		csid = utf8_csid; /* not al32utf8_csid here on purpose */
+//	    if ((utf8 & ARRAY_BIND_NATIVE) && !CS_IS_UTF8_COMPATIBLE(csid)) {
+//			croak("Can't mix utf8 and non-utf8 in array bind");
+//	    }
+		//csid = utf8_csid; /* not al32utf8_csid here on purpose */
 	}
-	
-	if (trace_level >= 3 || dbd_verbose >= 3 )
+ PerlIO_printf(DBILOGFP, "csid after=%d\n",csid);
+	if (trace_level >= 3 || dbd_verbose <= 3 )
 		PerlIO_printf(DBILOGFP, "do_bind_array_exec(): bind %s <== [array of values] "
 			"(%s, %s, csid %d->%d->%d, ftype %d (%s), csform %d->%d, maxlen %lu, maxdata_size %lu)\n",
-			phs->name, 
+			phs->name,
 			(phs->is_inout) ? "inout" : "in",
 		    (utf8 ? "is-utf8" : "not-utf8"),
 	        phs->csid_orig, phs->csid, csid,
 	        phs->ftype,sql_typecode_name(phs->ftype), phs->csform, csform,
 	        (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
-	
-	
+
+
 	if (csid) {
 		OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND,
 			&csid, (ub4) 0, (ub4) OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
@@ -3243,7 +3258,7 @@
     STRLEN len;
     int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0;
     int *utf8_flgs;
-    
+
     if (debug >= 2  || dbd_verbose >=2)
  		PerlIO_printf(DBILOGFP, "  ora_st_execute_array %s count=%d (%s %s %s)...\n",
                       oci_stmt_type_name(imp_sth->stmt_type), exe_count,
@@ -3309,7 +3324,7 @@
 	utf8_flgs = safemalloc(param_count*sizeof(int));
     memset(phs, 0, param_count*sizeof(*phs));
     memset(utf8_flgs, 0, param_count*sizeof(int));
-    
+
 
    	for(j = 0; (unsigned int) j < exe_count; j++) {
 
@@ -3376,11 +3391,11 @@
 			/* update the utf8_flgs for this value */
 			if (SvUTF8(sv)) {
 				utf8_flgs[i] |= ARRAY_BIND_UTF8;
-			} 
+			}
 			else {
 				utf8_flgs[i] |= ARRAY_BIND_NATIVE;
 			}
-         
+
         	/* Do OCI bind calls on last iteration. */
         	if( ((unsigned int) j ) == exe_count - 1 ) {
         	    if(!do_bind_array_exec(sth, imp_sth, phs[i], utf8_flgs[i])) {
@@ -3392,7 +3407,7 @@
   	}
 	Safefree(phs);
 	Safefree(utf8_flgs);
-	
+
     /* Store array of bind typles, for use in OCIBindDynamic() callback. */
     imp_sth->bind_tuples = tuples_av;
     imp_sth->rowwise = (columns_av == NULL);