Author: byterock
Date: Fri Dec 21 09:59:43 2007
New Revision: 10448
Modified:
dbd-oracle/trunk/Oracle.h
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
Log:
Patches from RC5
Modified: dbd-oracle/trunk/Oracle.h
==============================================================================
--- dbd-oracle/trunk/Oracle.h (original)
+++ dbd-oracle/trunk/Oracle.h Fri Dec 21 09:59:43 2007
@@ -5,6 +5,42 @@
*/
+/* ====== Include Oracle Header Files ====== */
+
+#ifndef CAN_PROTOTYPE
+#define signed /* Oracle headers use signed */
+#endif
+
+/* The following define avoids a problem with Oracle >=7.3 where
+ * ociapr.h has the line:
+ * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ...
+ * In some compilers that clashes with perls 'opcode' enum definition.
+ */
+#define opcode opcode_redefined
+
+/* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */
+#if defined(__osf__) && defined(__alpha)
+#ifndef A_OSF
+#define A_OSF
+#endif
+#endif
+
+/* egcs-1.1.2 does not have _int64 */
+#if defined(__MINGW32__) || defined(__CYGWIN32__)
+#define _int64 long long
+#endif
+
+
+/* ori.h uses 'dirty' as an arg name in prototypes so we use this */
+/* hack to prevent ori.h being read (since we don't need it) */
+//#define ORI_ORACLE
+#include <oci.h>
+#include <oratypes.h>
+#include <ocidfn.h>
+#include <orid.h>
+#include <ori.h>
+/* ------ end of Oracle include files ------ */
+
#define NEED_DBIXS_VERSION 93
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Fri Dec 21 09:59:43 2007
@@ -123,6 +123,11 @@
return 0;
return 1;
#else
+ /* For gcc not to warn on unused parameters. */
+ if( key ){}
+ if( val ){}
+ if( data ){}
+ if( size ){}
return 0;
#endif
}
@@ -273,9 +278,9 @@
/* and setup the pointers in the head fb_ary struct */
Newz(42, fb_ary, sizeof(fb_ary_t), fb_ary_t);
Newz(42, fb_ary->abuf, size * bufl, ub1);
- Newz(42, fb_ary->aindp, size, sb2);
- Newz(42, fb_ary->arlen, size, ub2);
- Newz(42, fb_ary->arcode, size, ub2);
+ Newz(42, fb_ary->aindp, (unsigned)size, sb2);
+ Newz(42, fb_ary->arlen, (unsigned)size, ub2);
+ Newz(42, fb_ary->arcode, (unsigned)size, ub2);
fb_ary->bufl = bufl;
return fb_ary;
}
@@ -517,7 +522,8 @@
croak("ora_charset is not a string");
}
- new_charsetid = OCINlsCharSetNameToId(imp_dbh->envhp,
SvPV_nolen(*svp));
+ new_charsetid = OCINlsCharSetNameToId(imp_dbh->envhp,
(oratext*)SvPV_nolen(*svp));
+
if (!new_charsetid) {
croak("ora_charset value (%s) is not valid",
SvPV_nolen(*svp));
}
@@ -529,7 +535,7 @@
croak("ora_ncharset is not a string");
}
- new_ncharsetid = OCINlsCharSetNameToId(imp_dbh->envhp,
SvPV_nolen(*svp));
+ new_ncharsetid = OCINlsCharSetNameToId(imp_dbh->envhp,
(oratext*)SvPV_nolen(*svp));
if (!new_ncharsetid) {
croak("ora_ncharset value (%s) is not valid",
SvPV_nolen(*svp));
}
@@ -1263,16 +1269,16 @@
if( phs->maxlen <=0 ){ /* Analyze maxlength only if not forced
*/
STRLEN length=0;
if (!SvPOK(item)) { /* normalizations for special cases
*/
- if (SvOK(item)) { /* ie a number, convert to string
ASAP */
- if (!(SvROK(item) && phs->is_inout)){
- sv_2pv(item, &length);
- }
- } else { /* ensure we're at least an SVt_PV (so SvPVX
etc work) */
- SvUPGRADE(item, SVt_PV);
- }
+ if (SvOK(item)) { /* ie a number, convert to
string ASAP */
+ if (!(SvROK(item) && phs->is_inout)){
+ sv_2pv(item, &length);
+ }
+ } else { /* ensure we're at least an SVt_PV (so
SvPVX etc work) */
+ if(SvUPGRADE(item, SVt_PV)){}
+ }
}
if( length == 0 ){
- length=SvCUR(item);
+ length=SvCUR(item);
}
if( length+1 > maxlen ){
maxlen=length+1;
@@ -1310,13 +1316,13 @@
if( phs->maxlen <=0 ){
phs->maxlen=maxlen;
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen calculated =%d\n",
- (int)maxlen);
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen calculated =%ld\n",
+ (long)maxlen);
}
} else{
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen forsed =%d\n",
- (int)maxlen);
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n",
+ (long)maxlen);
}
}
}
@@ -1420,7 +1426,7 @@
return 0;
}
OCIBindArrayOfStruct_log_stat(phs->bndhp, imp_sth->errhp,
- phs->maxlen, /* Skip parameter for the next data value */
+ (unsigned)phs->maxlen, /* Skip parameter for the next data value */
sizeof (OCIInd), /* Skip parameter for the next indicator
value */
sizeof(unsigned short), /* Skip parameter for the next actual
length value */
0, /* Skip parameter for the next column-level
error code */
@@ -1499,10 +1505,10 @@
}
if (trace_level >= 1){
PerlIO_printf(DBILOGFP,
- "dbd_phs_ora_varchar2_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%d \n",
+ "dbd_phs_ora_varchar2_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%ld \n",
phs->name,
phs->array_numstruct,
- phs->maxlen
+ (long)phs->maxlen
);
}
arr=(AV*)(SvRV(phs->sv));
@@ -1587,8 +1593,8 @@
}
if (trace_level >= 2){
PerlIO_printf(DBILOGFP,
- "dbd_phs_ora_varchar2_table_fixup_after_execute():
scalar(@arr)=%d.\n",
- av_len(arr)+1);
+ "dbd_phs_ora_varchar2_table_fixup_after_execute():
scalar(@arr)=%ld.\n",
+ (long)av_len(arr)+1);
}
return 1;
}
@@ -1601,7 +1607,7 @@
AV *arr;
int need_allocate_rows;
int buflen;
- int flag_data_is_utf8=0;
+ /*int flag_data_is_utf8=0;*/
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /*
Allow only array binds */
croak("dbd_rebind_ph_number_table(): bad bind variable. ARRAY reference
required, but got %s for '%s'.",
@@ -1651,8 +1657,8 @@
phs->maxlen=sizeof(double);
}
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): phs->maxlen
calculated =%d\n",
- (int)phs->maxlen);
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): phs->maxlen
calculated =%ld\n",
+ (long)phs->maxlen);
}
if( phs->array_numstruct == 0 ){
@@ -1665,12 +1671,12 @@
if (trace_level >= 2){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries assumed=phs->array_numstruct=%d\n",
- (int)phs->array_numstruct);
+ phs->array_numstruct);
}
}else{
if (trace_level >= 2){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries=%d\n",
- (int)phs->ora_maxarray_numentries);
+ phs->ora_maxarray_numentries);
}
}
@@ -1708,7 +1714,7 @@
switch( phs->ora_internal_type ){
case SQLT_INT:
{
- int ival;
+ int ival =0;
int val_found=0;
/* Double values are converted as int(val) */
if( SvOK( item ) && ! SvIOK( item ) ){
@@ -1827,7 +1833,7 @@
return 0;
}
OCIBindArrayOfStruct_log_stat(phs->bndhp, imp_sth->errhp,
- phs->maxlen, /* Skip parameter for the next data value */
+ (unsigned)phs->maxlen, /* Skip parameter for the next data value */
sizeof (OCIInd), /* Skip parameter for the next indicator
value */
sizeof(unsigned short), /* Skip parameter for the next actual
length value */
0, /* Skip parameter for the next column-level
error code */
@@ -1863,10 +1869,10 @@
}
if (trace_level >= 1){
PerlIO_printf(DBILOGFP,
- "dbd_phs_ora_number_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%d \n",
+ "dbd_phs_ora_number_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%ld \n",
phs->name,
phs->array_numstruct,
- phs->maxlen
+ (long)phs->maxlen
);
}
/* At this point, ora_internal_type can't be default. It must be set at
bind time. */
@@ -2000,8 +2006,8 @@
}
if (trace_level >= 2){
PerlIO_printf(DBILOGFP,
- "dbd_phs_ora_number_table_fixup_after_execute():
scalar(@arr)=%d.\n",
- av_len(arr)+1);
+ "dbd_phs_ora_number_table_fixup_after_execute():
scalar(@arr)=%ld.\n",
+ (long)av_len(arr)+1);
}
return 1;
}
@@ -2010,7 +2016,7 @@
static int
-dbd_rebind_ph_char(SV *sth, imp_sth_t *imp_sth, phs_t *phs, ub2 **alen_ptr_ptr)
+dbd_rebind_ph_char(imp_sth_t *imp_sth, phs_t *phs)
{
dTHX;
STRLEN value_len;
@@ -2023,8 +2029,8 @@
sv_2pv(phs->sv, &na);
}
else /* ensure we're at least an SVt_PV (so SvPVX etc work) */
- SvUPGRADE(phs->sv, SVt_PV);
- }
+ if(SvUPGRADE(phs->sv, SVt_PV)){} /* For gcc not to warn on unused
result)*/;
+ }
if (DBIS->debug >= 2) {
char *val = neatsvpv(phs->sv,0);
@@ -2228,7 +2234,7 @@
dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
dTHX;
- ub2 *alen_ptr = NULL;
+ /*ub2 *alen_ptr = NULL;*/
sword status;
int done = 0;
int at_exec;
@@ -2256,7 +2262,7 @@
done = dbd_rebind_ph_rset(sth, imp_sth, phs);
break;
default:
- done = dbd_rebind_ph_char(sth, imp_sth, phs, &alen_ptr);
+ done = dbd_rebind_ph_char(imp_sth, phs);
}
if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself
successfully */
if (trace_level >= 3)
@@ -2957,7 +2963,8 @@
/*check to see if value sv is a null (undef) if it is upgrade
it*/
if (!SvOK(sv)) {
- SvUPGRADE(sv, SVt_PV);
+ if(SvUPGRADE(sv, SVt_PV)){} /* For GCC
not to warn on unused result */
+
}
else {
SvPV(sv, len);
@@ -2974,7 +2981,7 @@
phs[i]->maxlen = len;
/* Do OCI bind calls on last iteration. */
- if(j == exe_count - 1) {
+ if( ((unsigned int) j ) == exe_count - 1 ) {
if(!do_bind_array_exec(sth, imp_sth, phs[i])) {
Safefree(phs);
}
@@ -3308,6 +3315,7 @@
STRLEN kl;
SV *cachesv = NULL;
char *key = SvPV(keysv,kl);
+ if( imp_sth ) { /* For GCC not to warn on unused argument */}
/*
int on = SvTRUE(valuesv);
int oraperl = DBIc_COMPAT(imp_sth); */
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Fri Dec 21 09:59:43 2007
@@ -5,46 +5,6 @@
*/
-
-
-/* ====== Include Oracle Header Files ====== */
-
-#ifndef CAN_PROTOTYPE
-#define signed /* Oracle headers use signed */
-#endif
-
-/* The following define avoids a problem with Oracle >=7.3 where
- * ociapr.h has the line:
- * sword obindps(struct cda_def *cursor, ub1 opcode, text *sqlvar, ...
- * In some compilers that clashes with perls 'opcode' enum definition.
- */
-#define opcode opcode_redefined
-
-/* Hack to fix broken Oracle oratypes.h on OSF Alpha. Sigh. */
-#if defined(__osf__) && defined(__alpha)
-#ifndef A_OSF
-#define A_OSF
-#endif
-#endif
-
-/* egcs-1.1.2 does not have _int64 */
-#if defined(__MINGW32__) || defined(__CYGWIN32__)
-#define _int64 long long
-#endif
-
-
-/* ori.h uses 'dirty' as an arg name in prototypes so we use this */
-/* hack to prevent ori.h being read (since we don't need it) */
-#define ORI_ORACLE
-#include <oci.h>
-#include <oratypes.h>
-#include <ocidfn.h>
-#include <orid.h>
-#include <ori.h>
-/* ------ end of Oracle include files ------ */
-
-
-
/* ====== define data types ====== */
typedef struct imp_fbh_st imp_fbh_t;
@@ -220,7 +180,7 @@
sword ftype; /* external OCI field type */
SV *sv; /* the scalar holding the value */
- int sv_type; /* original sv type at time of bind */
+ U32 sv_type; /* original sv type at time of bind */
ub2 csid_orig; /* original oracle default csid */
ub2 csid; /* 0 for automatic */
ub1 csform; /* 0 for automatic */
@@ -240,8 +200,8 @@
char *progv;
int (*out_prepost_exec)_((SV *, imp_sth_t *, phs_t *, int pre_exec));
- SV *ora_field; /* from attribute (for LOB binds) */
- int alen_incnull; /* 0 or 1 if alen should include null */
+ SV *ora_field; /* from attribute (for LOB binds) */
+ ub4 alen_incnull; /* 0 or 1 if alen should include null */
/* Array bind support */
char * array_buf; /* Temporary buffer = malloc(array_buflen)
*/
int array_buflen; /* Allocated length of array_buf */
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Fri Dec 21 09:59:43 2007
@@ -226,6 +226,7 @@
case OCI_HTYPE_SESSION: return imp_dbh->authp;
}
croak("Can't get OCI handle type %d from DBI database handle",
handle_type);
+ if( flags ) {/* For GCC not to warn on unused parameter */}
/* satisfy compiler warning, even though croak will never return */
return 0;
}
@@ -242,6 +243,7 @@
case OCI_HTYPE_STMT: return imp_sth->stmhp;
}
croak("Can't get OCI handle type %d from DBI statement handle",
handle_type);
+ if( flags ) {/* For GCC not to warn on unused parameter */}
/* satisfy compiler warning, even though croak will never return */
return 0;
}
@@ -372,14 +374,16 @@
SV *sv;
AV *av;
SV **sv_p;
-
+ 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 ? iter : phs->idx,
0);
+ 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 : iter, 0);
+ 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);
@@ -474,22 +478,23 @@
dTHX;
phs_t *phs = (phs_t*)octxp; /* context */
/*imp_sth_t *imp_sth = phs->imp_sth;*/
-
+
+ if( bindp ) { /* For GCC not to warn on unused parameter */ }
+
if (phs->desc_h) {
- *bufpp = phs->desc_h;
- phs->alen = 0;
- }
- else {
- SV *sv = phs->sv;
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- if (index > 0) /* finish-up handling previous element */
- dbd_phs_avsv_complete(phs, (I32)index-1, DBIS->debug);
- sv = *av_fetch((AV*)SvRV(sv), (IV)index, 1);
- if (!SvOK(sv))
- sv_setpv(sv,"");
- }
- *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 :
phs->maxlen)+1)/*for null*/);
- phs->alen = SvLEN(sv); /* max buffer size now, actual data len later */
+ *bufpp = phs->desc_h;
+ phs->alen = 0;
+ } else {
+ SV *sv = phs->sv;
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ if (index > 0) /* finish-up handling previous element
*/
+ dbd_phs_avsv_complete(phs, (I32)index-1,
DBIS->debug);
+ sv = *av_fetch((AV*)SvRV(sv), (IV)index, 1);
+ if (!SvOK(sv))
+ sv_setpv(sv,"");
+ }
+ *bufpp = SvGROW(sv, (size_t)(((phs->maxlen < 28) ? 28 :
phs->maxlen)+1)/*for null*/);
+ phs->alen = SvLEN(sv); /* max buffer size now, actual data len
later */
}
*alenpp = &phs->alen;
*indpp = &phs->indp;
@@ -620,6 +625,7 @@
SV *sth_nested = (SV *)fbh->special;
fbh->special = NULL;
+ if( sth ) { /* For GCC not to warn on unused parameter */ }
if (sth_nested) {
dTHR;
D_impdata(imp_sth_nested, imp_sth_t, sth_nested);
@@ -665,7 +671,9 @@
SPAGAIN;
if (count != 2)
croak("panic: DBI::_new_sth returned %d values instead of 2", count);
- POPs;
+
+ if(POPs){} /* For GCC not to warn on unused result */
+
sv_setsv(dest_sv, POPs);
SvREFCNT_dec(init_attr);
PUTBACK; FREETMPS; LEAVE;
@@ -759,13 +767,12 @@
return oci_error(sth, imp_sth->errhp, status, "OCIAttrSet
OCI_ATTR_LOBEMPTY");
if (!SvPOK(phs->sv)) { /* normalizations for special cases */
- if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
+ if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP
*/
if (!(SvROK(phs->sv) && phs->is_inout))
sv_2pv(phs->sv, &na);
- }
- else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */
- SvUPGRADE(phs->sv, SVt_PV);
- }
+ } 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 */
+ }
}
phs->indp = (SvOK(phs->sv)) ? 0 : -1;
phs->progv = (char*)&phs->desc_h;
@@ -795,8 +802,8 @@
imp_sth->stmt_type == OCI_STMT_DECLARE) {
ub4 amtp;
- SvUPGRADE(phs->sv, SVt_PV); /* just in case */
- amtp = SvCUR(phs->sv); /* XXX UTF8? */
+ if(SvUPGRADE(phs->sv, SVt_PV)){/* For GCC not to warn on unused result
*/}; /* just in case */
+ amtp = SvCUR(phs->sv); /* XXX UTF8? */
/* Create a temp lob for non-empty string */
@@ -1230,6 +1237,7 @@
fetch_func_getrefpv(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
dTHX;
+ if( sth ) { /* For GCC not to warn on unused parameter */ }
/* See the Oracle::OCI module for how to actually use this! */
sv_setref_pv(dest_sv, fbh->bless, (void*)fbh->desc_h);
return 1;
@@ -1312,8 +1320,7 @@
str_len = 200;
OCIDateToText_log_stat(fbh->imp_sth->errhp, (CONST OCIDate *)
attr_value,&str_len,str_buf,status);
str_buf[str_len+1] = '\0';
- av_push(list, newSVpv( (text *) str_buf,0));
-
+ av_push(list, newSVpv( (char *) str_buf,0));
break;
case OCI_TYPECODE_RAW :/* RAW*/
@@ -1332,7 +1339,7 @@
case OCI_TYPECODE_VARCHAR : /* varchar */
case OCI_TYPECODE_VARCHAR2 : /* varchar2 */
vs = *(OCIString **) attr_value;
- av_push(list, newSVpv((text *) OCIStringPtr(fbh->imp_sth->envhp,
vs),0));
+ av_push(list, newSVpv((char *) OCIStringPtr(fbh->imp_sth->envhp,
vs),0));
break;
case OCI_TYPECODE_SIGNED8 : /* BYTE - sb1 */
av_push(list, newSVuv(*(sb1 *)attr_value));
@@ -1392,8 +1399,8 @@
for (pos = 0; pos < obj->field_count; pos++){
fld = &obj->fields[pos]; /*get the field */
-
status=OCIObjectGetInd(fbh->imp_sth->envhp,fbh->imp_sth->errhp,value,&obj->obj_ind);
-
+
status=OCIObjectGetInd(fbh->imp_sth->envhp,fbh->imp_sth->errhp,value,(dvoid**)&obj->obj_ind);
+
/*the little bastard above took me ages to find out
seems Oracle does not like people to know that it can do this
the concept is simple really
@@ -1405,8 +1412,7 @@
The thing to remember is that OCI and C have no way of representing a DB NULLs
so we use the OCIInd find out
if the object or any of its properties are NULL, This is one little line in a
20 chapter book and even then
-id only shows you examples with the C struct built in. Nowhere does it say you
can do it this way.
- */
+id only shows you examples with the C struct built in and only a single
record. Nowhere does it say you can do it this way. */
if (status != OCI_SUCCESS) {
oci_error(sth, fbh->imp_sth->errhp,
status, "OCIObjectGetInd");
@@ -1415,7 +1421,7 @@
status = OCIObjectGetAttr(fbh->imp_sth->envhp,
fbh->imp_sth->errhp, value,
obj->obj_ind, obj->tdo,
-
&fld->type_name, &fld->type_namel, 1,
+
(CONST oratext**)&fld->type_name, &fld->type_namel, 1,
(ub4 *)0, 0, &attr_null_status, &attr_null_struct,
&attr_value, &attr_tdo);
@@ -1534,8 +1540,10 @@
int
empty_oci_object(fbh_obj_t *obj){
dTHX;
- int pos=0;
- fbh_obj_t *fld;
+ int pos = 0;
+ fbh_obj_t *fld;
+
+
switch (obj->element_typecode) {
case OCI_TYPECODE_OBJECT : /*
embedded ADT */
@@ -1570,23 +1578,36 @@
default:
break;
}
- if (SvTYPE(fld->value) == SVt_PVAV){
+ if (fld->value && SvTYPE(fld->value) == SVt_PVAV){
av_clear(obj->value);
av_undef(obj->value);
}
+
+
+
+
+
+
+
return 1;
+
}
-int
+static void
fetch_cleanup_oci_object(SV *sth, imp_fbh_t *fbh){
dTHX;
- if (fbh->obj){
+
+ if( sth ) { /* For GCC not to warn on unused parameter*/ }
+
+ if (fbh->obj){
if(fbh->obj->value){
-
empty_oci_object(fbh->obj);
}
}
- return 1;
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP," fetch_cleanup_oci_object \n");
+ return;
}
@@ -1739,7 +1760,7 @@
}
/*now get the differnt fields of this object add one field
object for property*/
- Newz(1, obj->fields, obj->field_count, fbh_obj_t);
+ Newz(1, obj->fields, (unsigned) obj->field_count, fbh_obj_t);
/*a field is just another instance of an obj not a new struct*/
@@ -1839,20 +1860,20 @@
int i;
/*dumps the contents of the current fbh->obj*/
- PerlIO_printf(DBILOGFP, " level=%d type_name =
%s\n",level,obj->type_name);
- PerlIO_printf(DBILOGFP, " type_namel = %d\n",obj->type_namel);
- PerlIO_printf(DBILOGFP, " parmdp = %d\n",obj->parmdp);
- PerlIO_printf(DBILOGFP, " parmap = %d\n",obj->parmap);
- PerlIO_printf(DBILOGFP, " tdo = %d\n",obj->tdo);
- PerlIO_printf(DBILOGFP, " typecode = %d\n",obj->typecode);
- PerlIO_printf(DBILOGFP, " col_typecode = %d\n",obj->col_typecode);
- PerlIO_printf(DBILOGFP, " element_typecode =
%d\n",obj->element_typecode);
- PerlIO_printf(DBILOGFP, " obj_ref = %d\n",obj->obj_ref);
- PerlIO_printf(DBILOGFP, " obj_value = %d\n",obj->obj_value);
- PerlIO_printf(DBILOGFP, " obj_type = %d\n",obj->obj_type);
- PerlIO_printf(DBILOGFP, " field_count = %d\n",obj->field_count);
- PerlIO_printf(DBILOGFP, " fields = %d\n",obj->fields);
-
+ PerlIO_printf(DBILOGFP, " level=%d type_name =
%s\n",level,obj->type_name);
+ PerlIO_printf(DBILOGFP, " type_namel = %u\n",obj->type_namel);
+ PerlIO_printf(DBILOGFP, " parmdp = %p\n",obj->parmdp);
+ PerlIO_printf(DBILOGFP, " parmap = %p\n",obj->parmap);
+ PerlIO_printf(DBILOGFP, " tdo = %p\n",obj->tdo);
+ PerlIO_printf(DBILOGFP, " typecode = %d\n",obj->typecode);
+ PerlIO_printf(DBILOGFP, " col_typecode = %d\n",obj->col_typecode);
+ PerlIO_printf(DBILOGFP, " element_typecode =
%d\n",obj->element_typecode);
+ PerlIO_printf(DBILOGFP, " obj_ref = %p\n",obj->obj_ref);
+ PerlIO_printf(DBILOGFP, " obj_value = %p\n",obj->obj_value);
+ PerlIO_printf(DBILOGFP, " obj_type = %p\n",obj->obj_type);
+ PerlIO_printf(DBILOGFP, " field_count = %d\n",obj->field_count);
+ PerlIO_printf(DBILOGFP, " fields = %p\n",obj->fields);
+
for (i = 0; i < obj->field_count;i++){
fbh_obj_t *fld = &obj->fields[i];
PerlIO_printf(DBILOGFP, " \n--->sub objects\n ");
@@ -2193,8 +2214,8 @@
dump_struct(imp_sth,fbh->obj,0);
}
-
OCIDefineObject_log_stat(fbh->defnp,imp_sth->errhp,fbh->obj->tdo,&fbh->obj->obj_value,status);
-
+
OCIDefineObject_log_stat(fbh->defnp,imp_sth->errhp,fbh->obj->tdo,(dvoid**)&fbh->obj->obj_value,status);
+
if (status != OCI_SUCCESS) {
oci_error(h,imp_sth->errhp, status,
"OCIDefineObject");
++num_errors;
@@ -2380,7 +2401,7 @@
}
if (DBIS->debug >= 5){
- PerlIO_printf(DBILOGFP, "\n %d (rc=%d):
%s\n", av, i,neatsvpv(sv,0));
+ PerlIO_printf(DBILOGFP, "\n %p (rc=%d): %s\n",
av, i,neatsvpv(sv,0));
}
}
return (err) ? Nullav : av;
@@ -2816,6 +2837,7 @@
int
post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks
handles on error */
{
+
/* To insert a new LOB transparently (without using 'INSERT . RETURNING
.') */
/* we have to insert an empty LobLocator and then fetch it back from the
*/
/* server before we can call OCILobWrite on it! This function handles
that. */
@@ -2857,21 +2879,21 @@
ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch"));
for(i=0; i < lr->num_fields; ++i) {
- imp_fbh_t *fbh = &lr->fbh_ary[i];
- int rc = fbh->fb_ary->arcode[0];
- phs_t *phs = (phs_t*)fbh->special;
- ub4 amtp;
-
- SvUPGRADE(phs->sv, SVt_PV); /* just in case */
- amtp = SvCUR(phs->sv); /* XXX UTF8? */
- if (rc == 1405) { /* NULL - return undef */
- sv_set_undef(phs->sv);
- status = OCI_SUCCESS;
- }
- else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail (OCI
8.0.4) */
+ imp_fbh_t *fbh = &lr->fbh_ary[i];
+ int rc = fbh->fb_ary->arcode[0];
+ phs_t *phs = (phs_t*)fbh->special;
+ ub4 amtp;
+
+ if(SvUPGRADE(phs->sv, SVt_PV)){/* For GCC not to warn on unused result
*/ }; /* just in case */
+
+ amtp = SvCUR(phs->sv); /* XXX UTF8? */
+ if (rc == 1405) { /* NULL - return undef */
+ sv_set_undef(phs->sv);
+ status = OCI_SUCCESS;
+ } else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail
(OCI 8.0.4) */
if( ! fbh->csid ) {
- ub1 csform = SQLCS_IMPLICIT;
- ub2 csid = 0;
+ ub1 csform = SQLCS_IMPLICIT;
+ ub2 csid = 0;
OCILobCharSetForm_log_stat( imp_sth->envhp, errhp,
(OCILobLocator*)fbh->desc_h, &csform, status );
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status, "OCILobCharSetForm");
@@ -2882,36 +2904,36 @@
return oci_error(sth, errhp, status, "OCILobCharSetId");
#endif /* OCI_ATTR_CHARSET_ID */
/* if data is utf8 but charset isn't then switch to utf8 csid */
- csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid :
CSFORM_IMPLIED_CSID(csform);
- fbh->csid = csid;
- fbh->csform = csform;
- }
+ csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ?
utf8_csid : CSFORM_IMPLIED_CSID(csform);
+ fbh->csid = csid;
+ fbh->csform = csform;
+ }
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3)
PerlIO_printf(DBILOGFP, " calling OCILobWrite
fbh->csid=%d fbh->csform=%d amtp=%d\n",
fbh->csid, fbh->csform, amtp );
- OCILobWrite_log_stat(imp_sth->svchp, errhp,
- (OCILobLocator*)fbh->desc_h, &amtp, 1, SvPVX(phs->sv),
amtp, OCI_ONE_PIECE,
- 0,0, fbh->csid ,fbh->csform, status);
+
+ OCILobWrite_log_stat(imp_sth->svchp, errhp,
+ (OCILobLocator*)fbh->desc_h, &amtp, 1,
SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
+ 0,0, fbh->csid ,fbh->csform, status);
+
if (status != OCI_SUCCESS) {
return oci_error(sth, errhp, status, "OCILobWrite in
post_execute_lobs");
- }
- }
- else { /* amtp==0 so truncate LOB to zero length */
- OCILobTrim_log_stat(imp_sth->svchp, errhp,
(OCILobLocator*)fbh->desc_h, 0, status);
+ }
+ }else { /* amtp==0 so truncate LOB to zero
length */
+ OCILobTrim_log_stat(imp_sth->svchp, errhp,
(OCILobLocator*)fbh->desc_h, 0, status);
if (status != OCI_SUCCESS) {
return oci_error(sth, errhp, status, "OCILobTrim in
post_execute_lobs");
- }
- }
- if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP,
- " lob refetch %d for '%s' param: ftype %d, len %ld: %s
%s\n",
- i+1,fbh->name, fbh->dbtype, ul_t(amtp),
- (rc==1405 ? "NULL" : (amtp > 0) ? "LobWrite" : "LobTrim"),
oci_status_name(status)
- );
- if (status != OCI_SUCCESS) {
- return oci_error(sth, errhp, status, "OCILobTrim/OCILobWrite/LOB
refetch");
+ }
}
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP,
+ " lob refetch %d for '%s' param: ftype %d, len
%ld: %s %s\n",
+ i+1,fbh->name, fbh->dbtype, ul_t(amtp),
+ (rc==1405 ? "NULL" : (amtp > 0) ? "LobWrite" :
"LobTrim"), oci_status_name(status));
+ if (status != OCI_SUCCESS) {
+ return oci_error(sth, errhp, status,
"OCILobTrim/OCILobWrite/LOB refetch");
+ }
}
if (DBIc_has(imp_dbh,DBIcf_AutoCommit))
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Fri Dec 21 09:59:43 2007
@@ -40,7 +40,7 @@
stat = OCIObjectPin(envhp,errhp,or,(OCIComplexObject
*)0,OCI_PIN_LATEST,OCI_DURATION_TRANS,OCI_LOCK_NONE,ot);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCIObjectPin_log_stat(%p,%p,%d,%d)=%s\n",\
+ "%sObjectPin_log_stat(%p,%p,%p,%p)=%s\n",\
OciTp, (void*)envhp,
(void*)errhp,or,ot,oci_status_name(stat)),stat \
: stat
@@ -49,7 +49,7 @@
stat = OCICollGetElem(envhp,errhp, v,i,ex,e,ne);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCICollGetElem_log_stat(%p,%p,%d,%d,%d,%d,%d)=%s\n",\
+
"%sOCICollGetElem_log_stat(%p,%p,%d,%d,%d,%d,%d)=%s\n",\
OciTp, (void*)envhp,
(void*)errhp,v,i,ex,e,ne,oci_status_name(stat)),stat \
: stat
@@ -58,7 +58,7 @@
stat = OCITableFirst(envhp,errhp,v,i);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCITableFirst_log_stat(%p,%p,%d,%d)=%s\n",\
+ "%sOCITableFirst_log_stat(%p,%p,%d,%d)=%s\n",\
OciTp, (void*)envhp,
(void*)errhp,v,i,oci_status_name(stat)),stat \
: stat
@@ -66,7 +66,7 @@
stat = OCIObjectGetAttr(errhp,errhp,v,no,ot,tn,tnl,1,(ub4 *)0,
0,ani,ans,av,atdo,stat);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
-
"%OCIObjectGetAttr_log_stat(%p,%p,%d,%d,%d,%d,%d,%d,%d,%d,%d)=%s\n",\
+
"%sOCIObjectGetAttr_log_stat(%p,%p,%d,%d,%d,%d,%d,%d,%d,%d,%d)=%s\n",\
OciTp,
(void*)envhp,(void*)errhp,v,no,ot,tn,tnl,ani,ans,av,atdo,(void*)errhp,oci_status_name(stat)),stat
\
: stat
@@ -75,16 +75,16 @@
stat = OCIDateToText(errhp, (CONST OCIDate *) d,(CONST text*) "Month dd,
SYYYY, HH:MI A.M.",(ub1) 27, (CONST text*) "American", (ub4) 8,(ub4 *)sl,sb );\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCIDateToText_log_stat(%p,%d,%d,%s)=%s\n",\
- OciTp, (void*)errhp,
d,sl,sb,(void*)errhp,oci_status_name(stat)),stat \
- : stat
+ "%sDateToText_log_stat(%p,%p,%p,%s)=%s\n",\
+ OciTp, (void*)errhp,
d,sl,sb,oci_status_name(stat)),stat \
+ : stat
#define OCIIterDelete_log_stat(envhp,errhp,itr,stat)\
stat = OCIIterDelete(envhp,errhp,itr );\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCIIterDelete_log_stat(%p,%p,%d)=%s\n",\
+ "%sOCIIterDelete_log_stat(%p,%p,%d)=%s\n",\
OciTp, (void*)envhp,
(void*)errhp,itr,oci_status_name(stat)),stat \
: stat
@@ -93,15 +93,15 @@
stat = OCIIterCreate(envhp,errhp,coll,itr);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCIIterCreate_log_stat(%p,%p,%d)=%s\n",\
- OciTp, (void*)envhp,
(void*)errhp,oci_status_name(stat)),stat \
+ "%sIterCreate_log_stat(%p,%p,%p)=%s\n",\
+ OciTp, (void*)envhp,
(void*)errhp,(void*)coll,oci_status_name(stat)),stat \
: stat
#define OCICollSize_log_stat(envhp,errhp,coll,coll_siz,stat)\
stat = OCICollSize(envhp,errhp,(CONST OCIColl *)coll,coll_siz);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCICollSize_log_stat(%p,%p,%d)=%s\n",\
+ "%sOCICollSize_log_stat(%p,%p,%d)=%s\n",\
OciTp, (void*)envhp,
(void*)errhp,oci_status_name(stat)),stat \
: stat
@@ -110,16 +110,16 @@
stat = OCIDefineObject(defnp,errhp,tdo,eo_buff,0,0, 0);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCIDefineObject(%p,%p,%d)=%s\n",\
+ "%sOCIDefineObject(%p,%p,%d)=%s\n",\
OciTp, (void*)defnp, (void*)errhp,
(void*)tdo,oci_status_name(stat)),stat \
: stat
#define OCITypeByName_log_stat(envhp,errhp,svchp,p1,l,tdo,stat)\
- stat =
OCITypeByName(envhp,errhp,svchp,"",0,p1,l,0,0,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\
+ stat = OCITypeByName(envhp,errhp,svchp,(const
oratext*)"",0,p1,l,0,0,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
- "%OCITypeByName(%p,%p,%p,%s,%d)=%s\n",\
- OciTp, (void*)envhp, (void*)errhp, (void*)svchp,
(void*)(p1),(l),oci_status_name(stat)),stat \
+ "%sTypeByName(%p,%p,%p,%s,%d)=%s\n",\
+ OciTp, (void*)envhp, (void*)errhp, (void*)svchp,
(char*)(p1),(l),oci_status_name(stat)),stat \
: stat
/* added by lab */
