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);
