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

[email protected]
Newsgroups perl.dbd.oracle.changes
Message-ID <[email protected]>
Author: byterock
Date: Fri Oct 17 07:22:39 2008
New Revision: 11987

Modified:
   dbd-oracle/trunk/Changes
   dbd-oracle/trunk/Oracle.pm
   dbd-oracle/trunk/dbdimp.c
   dbd-oracle/trunk/dbdimp.h
   dbd-oracle/trunk/oci8.c
   dbd-oracle/trunk/t/26exe_array.t

Log:
Patch for UTF-8 and bind_param_array from David Mansfield

Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes	(original)
+++ dbd-oracle/trunk/Changes	Fri Oct 17 07:22:39 2008
@@ -1,3 +1,7 @@
+=head1 Changes in DBD-Oracle 1.23(svn rev #####)  
+  Patch for UTF8 check on execute_array from David Mansfield and a little by John Scoles
+  
+  
 =head1 Changes in DBD-Oracle 1.22(svn rev 11618)  1st Aug 2008 
   Patch to remove compiler warnings from H.Merijn Brand
   Patch to Makfile for 64bit boxes from Alex Laslavic

Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm	(original)
+++ dbd-oracle/trunk/Oracle.pm	Fri Oct 17 07:22:39 2008
@@ -2054,6 +2054,15 @@
 
    $dbh->{ora_ph_csform} = SQLCS_NCHAR; # default for all future placeholders
 
+Binding with bind_param_array and execute_array is also UTF-8 compatible in the same way.  If you attempt to 
+insert UTF-8 data into a non UTF-8 Oracle instance or with an non UTF-8 NCHAR or NVARCHAR the insert
+will still happen but a error code of 0 will be returned with the following warning; 
+  
+  DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#1. This may result in corrupt data. 
+  The Query charset id=1, name=US7ASCII
+
+The warning will report the parameter number and the NCHAR setting that the query is running.
+  
 B<Sending Data using SQL>
 
 Oracle assumes the SQL statement is in the default client character

Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c	(original)
+++ dbd-oracle/trunk/dbdimp.c	Fri Oct 17 07:22:39 2008
@@ -43,8 +43,15 @@
 int is_extproc = 0;
 int dbd_verbose = 0; /* DBD only debugging*/
 
+/* bitflag constants for figuring out how to handle utf8 for array binds */
+#define ARRAY_BIND_NATIVE 0x01
+#define ARRAY_BIND_UTF8   0x02
+#define ARRAY_BIND_MIXED  (ARRAY_BIND_NATIVE|ARRAY_BIND_UTF8)
+
+
 ub2 charsetid = 0;
 ub2 ncharsetid = 0;
+ub2 us7ascii_csid = 1;
 ub2 utf8_csid = 871;
 ub2 al32utf8_csid = 873;
 ub2 al16utf16_csid = 2000;
@@ -369,8 +376,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 */
@@ -404,13 +411,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") ;
 
@@ -429,7 +436,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);
 
@@ -558,7 +565,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) {
@@ -581,7 +588,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");
@@ -616,8 +623,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");
@@ -649,7 +656,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);
@@ -771,7 +778,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;
 	    	}
 
@@ -2253,8 +2260,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;
 
@@ -2302,15 +2309,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;
 }
 
@@ -2342,11 +2349,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,
@@ -2397,8 +2404,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	*/
@@ -2531,8 +2538,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));
@@ -3086,13 +3093,20 @@
 }
 
 static int
-do_bind_array_exec(sth, imp_sth, phs)
+do_bind_array_exec(sth, imp_sth, phs,utf8,parma_index,tuples_utf8_av,tuples_status_av)
     SV *sth;
     imp_sth_t *imp_sth;
     phs_t *phs;
-{
+    int utf8;
+    AV *tuples_utf8_av,*tuples_status_av;
+    int parma_index;
+    {
 	dTHX;
     sword status;
+    ub1 csform;
+	ub2 csid;
+	int trace_level = DBIS->debug;
+    int i;
     OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
             (text*)phs->name, (sb4)strlen(phs->name),
             0,
@@ -3117,6 +3131,87 @@
         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)) {
+		/* try to default csform to avoid translation through non-unicode */
+		if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))                /* prefer IMPLICIT */
+			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);
+		if ( status != OCI_SUCCESS ) {
+			oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_FORM)"));
+			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 */
+	csid = (phs->csid) ? phs->csid : phs->csid_orig;
+
+	/* 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_NOT_UTF8(csid)) {
+				oratext  charsetname[OCI_NLS_MAXBUFSZ];
+				OCINlsCharSetIdToName(imp_sth->envhp,charsetname, sizeof(charsetname),csid );
+
+				for(i=0;i<av_len(tuples_utf8_av)+1;i++){
+					SV *err_svs[2];
+					SV *item;
+					item=*(av_fetch(tuples_utf8_av,i,0));
+					err_svs[0] = newSViv((IV)0);
+        			err_svs[1] = newSVpvf("DBD Oracle Warning: You have mixed utf8 and non-utf8 in an array bind in parameter#%d. This may result in corrupt data. The Query charset id=%d, name=%s",parma_index+1,csid,charsetname);
+        		    av_store(tuples_status_av,SvIV(item),newRV_noinc((SV *)(av_make(2, err_svs))));
+        		}
+        		/*av_store(tuples_status_av,tuple_index,
+                     newRV_noinc((SV *)(av_make(2, err_svs))));
+*/
+
+
+		}
+	    csid = utf8_csid; /* not al32utf8_csid here on purpose */
+	}
+
+	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->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);
+		if ( status != OCI_SUCCESS ) {
+			oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)"));
+			return 0;
+		}
+	}
+
     return 1;
 }
 
@@ -3153,7 +3248,7 @@
     D_imp_dbh_from_sth;
     sword status, exe_status;
     int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
-    AV *tuples_av, *tuples_status_av, *columns_av;
+    AV *tuples_av, *tuples_status_av, *columns_av,*tuples_utf8_av;
     ub4 oci_mode;
     ub4 num_errs;
     int i,j;
@@ -3166,6 +3261,8 @@
     char namebuf[30];
     STRLEN len;
     int outparams = (imp_sth->out_params_av) ? AvFILL(imp_sth->out_params_av)+1 : 0;
+	int *utf8_flgs;
+    tuples_utf8_av=newAV();
 
     if (debug >= 2  || dbd_verbose >=2)
  		PerlIO_printf(DBILOGFP, "  ora_st_execute_array %s count=%d (%s %s %s)...\n",
@@ -3206,11 +3303,7 @@
         }
         tuples_status_av = (AV*)SvRV(tuples_status);
         av_fill(tuples_status_av, exe_count - 1);
-        /* Fill in 'unknown' exe count in every element (know not how to get
-           individual execute row counts from OCI). */
-        for(i = 0; (unsigned int) i < exe_count; i++) {
-            av_store(tuples_status_av, i, newSViv((IV)-1));
-        }
+
     } else {
         tuples_status_av = NULL;
     }
@@ -3229,18 +3322,29 @@
 
     param_count=DBIc_NUM_PARAMS(imp_sth);
 	phs = safemalloc(param_count*sizeof(*phs));
+	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++) {
+		/* Fill in 'unknown' exe count in every element (know not how to get
+           individual execute row counts from OCI).
+           Moved it here as there is no need to iterate twice over it
+           this should speed it up somewhat for large binds*/
 
+		if (SvTRUE(tuples_status)){
+		    av_store(tuples_status_av, j, newSViv((IV)-1));
+		}
     	sv_p = av_fetch(tuples_av, j, 0);
         if(sv_p == NULL) {
             Safefree(phs);
-             croak("Cannot fetch tuple %d", j);
+            Safefree(utf8_flgs);
+            croak("Cannot fetch tuple %d", j);
         }
         sv = *sv_p;
         if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
             Safefree(phs);
+            Safefree(utf8_flgs);
             croak("Not an array ref in element %d", j);
         }
         av = (AV*)SvRV(sv);
@@ -3251,8 +3355,9 @@
                phs_svp = hv_fetch(imp_sth->all_params_hv,
                                 namebuf, strlen(namebuf), 0);
                if (phs_svp == NULL) {
-                    Safefree(phs);
-                    croak("Can't execute for non-existent placeholder :%d", i);
+				   Safefree(utf8_flgs);
+                   Safefree(phs);
+                   croak("Can't execute for non-existent placeholder :%d", i);
                }
                phs[i] = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
                if(phs[i]->idx < 0) {
@@ -3263,6 +3368,7 @@
             }
             sv_p = av_fetch(av, phs[i]->idx, 0);
             if(sv_p == NULL) {
+				Safefree(utf8_flgs);
                 Safefree(phs);
                 croak("Cannot fetch value for param %d in entry %d", i, j);
         	}
@@ -3281,22 +3387,39 @@
         	/* Find the value length, and increase maxlen if needed. */
         	if(SvROK(sv)) {
         	    Safefree(phs);
+        	    Safefree(utf8_flgs);
         	    croak("Can't bind a reference (%s) for param %d, entry %d",
         	    neatsvpv(sv,0), i, j);
         	}
         	if(len > (unsigned int) phs[i]->maxlen)
         	    phs[i]->maxlen = len;
 
+			/* update the utf8_flgs for this value */
+			if (SvUTF8(sv)) {
+				utf8_flgs[i] |= ARRAY_BIND_UTF8;
+				if (SvTRUE(tuples_status)){
+					av_push(tuples_utf8_av,newSViv(j));
+				}
+
+
+			}
+			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])) {
-        	        Safefree(phs);
-        		}
+
+				if(!do_bind_array_exec(sth, imp_sth, phs[i], utf8_flgs[i],i,tuples_utf8_av,tuples_status_av)) {
+   					Safefree(phs);
+   			 		Safefree(utf8_flgs);
+   			 		/*Safefree(tuples_utf8_av);*/
+				}
 			}
     	}
   	}
 	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);

Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h	(original)
+++ dbd-oracle/trunk/dbdimp.h	Fri Oct 17 07:22:39 2008
@@ -254,12 +254,19 @@
 
 extern ub2 charsetid;
 extern ub2 ncharsetid;
+extern ub2 us7ascii_csid;
 extern ub2 utf8_csid;
 extern ub2 al32utf8_csid;
 extern ub2 al16utf16_csid;
 
+#define CS_IS_NOT_UTF8( cs ) ( cs == us7ascii_csid )
+
 #define CS_IS_UTF8( cs ) \
-   (  ( cs == utf8_csid ) || ( cs == al32utf8_csid ) )
+   (  ( cs == utf8_csid )  )
+
+#define CS_IS_UTF8_COMPATIBLE( cs ) \
+  ( CS_IS_UTF8(cs) || ( (cs) == us7ascii_csid ) )
+
 
 #define CS_IS_UTF16( cs ) ( cs == al16utf16_csid )
 

Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c	(original)
+++ dbd-oracle/trunk/oci8.c	Fri Oct 17 07:22:39 2008
@@ -658,50 +658,51 @@
 	if( bindp ) { /* For GCC not to warn on unused parameter*/ }
 
  		/* Check for bind values supplied by tuple array. */
-		tuples_av = phs->imp_sth->bind_tuples;
-		if(tuples_av) {
-		   	/* NOTE: we already checked the validity in ora_st_bind_for_array_exec(). */
-		   	sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ? (int)iter : phs->idx, 0);
-		   	av = (AV*)SvRV(*sv_p);
-		   	sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : (int)iter, 0);
-			sv = *sv_p;
-	   		if(SvOK(sv)) {
-	     		*bufpp = SvPV(sv, phs_len);
-	     		phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
-	     		phs->indp = 0;
-	   		} else {
-	     		*bufpp = SvPVX(sv);
-	     		phs->alen = 0;
-	     		phs->indp = -1;
-	   		}
-    	}
-    	else
-    		if (phs->desc_h) {
-				*bufpp  = phs->desc_h;
-				phs->alen = 0;
-				phs->indp = 0;
-    	}
-    	else
-    		if (SvOK(phs->sv)) {
-				*bufpp  = SvPV(phs->sv, phs_len);
+	tuples_av = phs->imp_sth->bind_tuples;
+	if(tuples_av) {
+	   	/* NOTE: we already checked the validity in ora_st_bind_for_array_exec(). */
+	   	sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ? (int)iter : phs->idx, 0);
+	   	av = (AV*)SvRV(*sv_p);
+	   	sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : (int)iter, 0);
+		sv = *sv_p;
+		if(SvOK(sv)) {
+	   		*bufpp = SvPV(sv, phs_len);
+	   		phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
+	   		phs->indp = 0;
+		} else {
+	   		*bufpp = SvPVX(sv);
+	   		phs->alen = 0;
+	   		phs->indp = -1;
+		}
+    }
+    else
+	if (phs->desc_h) {
+		*bufpp  = phs->desc_h;
+		phs->alen = 0;
+		phs->indp = 0;
+    }
+    else
+   	if (SvOK(phs->sv)) {
+		*bufpp  = SvPV(phs->sv, phs_len);
 		phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;;
 		phs->indp = 0;
-   	}
-    else {
+	}
+   	else {
 		*bufpp  = SvPVX(phs->sv);	/* not actually used? */
 		phs->alen = 0;
 		phs->indp = -1;
-    }
-    *alenp  = phs->alen;
-    *indpp  = &phs->indp;
-    *piecep = OCI_ONE_PIECE;
-    if (DBIS->debug >= 3 || dbd_verbose >=3)
- 		PerlIO_printf(DBILOGFP, "       in  '%s' [%lu,%lu]: len %2lu, ind %d%s, value=%s\n",
+   	}
+   	*alenp  = phs->alen;
+   	*indpp  = &phs->indp;
+   	*piecep = OCI_ONE_PIECE;
+   	if (DBIS->debug >= 3 || dbd_verbose >=3)
+		PerlIO_printf(DBILOGFP, "       in  '%s' [%lu,%lu]: len %2lu, ind %d%s, value=%s\n",
 			phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp,
 			(phs->desc_h) ? " via descriptor" : "",neatsvpv(phs->sv,10));
-    if (!tuples_av && (index > 0 || iter > 0))
+   	if (!tuples_av && (index > 0 || iter > 0))
 		croak(" Arrays and multiple iterations not currently supported by DBD::Oracle (in %d/%d)", index,iter);
-    return OCI_CONTINUE;
+
+   	return OCI_CONTINUE;
 }
 
 /*
@@ -1625,7 +1626,7 @@
     return cache_rows;
 }
 
-/* called by get_object to return the actual value in the proerty */
+/* called by get_object to return the actual value in the property */
 
 static void get_attr_val(SV *sth,AV *list,imp_fbh_t *fbh, text  *name , OCITypeCode  typecode, dvoid   *attr_value )
 {
@@ -2082,7 +2083,7 @@
     sv_setpvn(dest_sv, (char*)fb_ary->cb_abuf,(STRLEN)actual_bufl);
 
   	if (fbh->ftype != SQLT_BIN){
-		
+
 		if (CSFORM_IMPLIES_UTF8(fbh->csform) ){ /* do the UTF 8 magic*/
 			SvUTF8_on(dest_sv);
 		}
@@ -3396,7 +3397,7 @@
     	char new_tablename[100];
     	ub4 syn_schema_len = 0, syn_name_len = 0,tn_len;
       	OCIAttrGet_log_stat(imp_sth->dschp,  OCI_HTYPE_DESCRIBE,
-				  &parmhp, 0, OCI_ATTR_PARAM, errhp, status);				  
+				  &parmhp, 0, OCI_ATTR_PARAM, errhp, status);
       	OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,
       		      &syn_schema, &syn_schema_len, OCI_ATTR_SCHEMA_NAME, errhp, status);
 		OCIAttrGet_log_stat(parmhp, OCI_DTYPE_PARAM,

Modified: dbd-oracle/trunk/t/26exe_array.t
==============================================================================
--- dbd-oracle/trunk/t/26exe_array.t	(original)
+++ dbd-oracle/trunk/t/26exe_array.t	Fri Oct 17 07:22:39 2008
@@ -4,7 +4,7 @@
 use DBD::Oracle qw(ORA_RSET SQLCS_NCHAR);
 use strict;
 
-use Test::More tests =>14 ;
+use Test::More tests =>17 ;
 unshift @INC ,'t';
 require 'nchar_test_lib.pl';
 
@@ -15,7 +15,8 @@
 ## By John Scoles, The Pythian Group
 ## ----------------------------------------------------------------------------
 ##  Just a few checks to see if execute array works in Oracle::DBD
-##  Nothing fancy. 
+##  Nothing fancy. I also checks for warnings when utf8 is inserted into 
+##  an ASCII only DB
 ## ----------------------------------------------------------------------------
 
 BEGIN {
@@ -25,21 +26,27 @@
 # create a database handle
 my $dsn = oracle_test_dsn();
 my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+$ENV{NLS_NCHAR} = "US7ASCII";
 my $dbh = DBI->connect($dsn, $dbuser, '', { RaiseError=>1, 
 						AutoCommit=>1,
-						PrintError => 0 });
+						PrintError => 0,
+						ora_envhp  => 0});
 
 
 # check that our db handle is good
 isa_ok($dbh, "DBI::db");
 
+
 my $table = table();
-    
+eval{
+ drop_table($dbh);
+};
 $dbh->do(qq{
             CREATE TABLE $table (
 	    row_1 INTEGER NOT NULL,
 	    row_2 INTEGER NOT NULL,
-	    row_3 INTEGER NOT NULL
+	    row_3 INTEGER NOT NULL,
+	    row_4 CHAR(5)
 	)
     });
     
@@ -47,7 +54,7 @@
 my @var1         = (1,1,1,1,1,1,1,1,1,1);
 my @var2         = (2,2,2,2,2,2,2,2,2,2);
 my @var3         = (3,3,3,3,3,3,3,3,3,3);
-
+my @utf8_string =  ("A","A","A","A","\x{6e9}","A","A","A","A","A");
 my $tuple_status = [];
 my $dumped ;
 
@@ -146,6 +153,19 @@
  cmp_ok(scalar @$problems, '==',48, '... we should have 48 rows');
 
 
+$sth = $dbh->prepare("INSERT INTO $table ( row_1,  row_2, row_3,row_4) VALUES (1,2,3,?)");
+
+ok ($sth->execute_array(
+      {ArrayTupleStatus => $tuple_status},
+       \@utf8_string 
+ ), '... execute_array should return true');
+
+
+cmp_ok(@$tuple_status[4],'ne','-1','... #5 should be a warning');
+cmp_ok(scalar @{$tuple_status}, '==', 10, '... we should have 10 tuple_status');
+
+
+
  drop_table($dbh);
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.