Author: byterock
Date: Mon Feb 4 16:50:08 2008
New Revision: 10686
Modified:
dbd-oracle/branches/array_inout/Oracle.xs
dbd-oracle/branches/array_inout/dbdimp.c
dbd-oracle/branches/array_inout/oci8.c
dbd-oracle/branches/objects/dbdimp.c
dbd-oracle/branches/objects/oci8.c
dbd-oracle/branches/sasha/dbdimp.c
Log:
latest
Modified: dbd-oracle/branches/array_inout/Oracle.xs
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.xs (original)
+++ dbd-oracle/branches/array_inout/Oracle.xs Mon Feb 4 16:50:08 2008
@@ -168,7 +168,6 @@
/* XXX this code is duplicated in selectrow_arrayref above */
if (DBIc_ROW_COUNT(imp_sth) > 0) /* reset for re-execute */
DBIc_ROW_COUNT(imp_sth) = 0;
- PerlIO_printf(DBILOGFP, " in ora_execute_array\n");
retval = ora_st_execute_array(sth, imp_sth, tuples, tuples_status,
cols, (ub4)exe_count);
/* XXX Handle return value ... like DBI::execute_array(). */
Modified: dbd-oracle/branches/array_inout/dbdimp.c
==============================================================================
--- dbd-oracle/branches/array_inout/dbdimp.c (original)
+++ dbd-oracle/branches/array_inout/dbdimp.c Mon Feb 4 16:50:08 2008
@@ -1626,7 +1626,7 @@
arr=(AV*)(SvRV(phs->sv));
if (trace_level >= 2){
- `PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
array_numstruct=%d\n",
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
array_numstruct=%d\n",
phs->array_numstruct);
}
/* If no number of entries to bind specified,
@@ -1634,14 +1634,14 @@
*/
if( phs->array_numstruct <= 0 ){
/* av_len() returns last array index, or -1 is array is empty */
- int numarrayentries=av_len( arr );
- if( numarrayentries >= 0 ){
- phs->array_numstruct = numarrayentries+1;
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
array_numstruct=%d (calculated) \n",
- phs->array_numstruct);
- }
- }
+ int numarrayentries=av_len( arr );
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n",
+ phs->array_numstruct);
+ }
+ }
}
/* Calculate each bound structure maxlen.
* maxlen(int) = sizeof(int);
@@ -1656,27 +1656,27 @@
phs->maxlen=sizeof(double);
}
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): phs->maxlen
calculated =%ld\n",
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
phs->maxlen calculated =%ld\n",
(long)phs->maxlen);
}
if( phs->array_numstruct == 0 ){
- /* Oracle doesn't allow NULL buffers even for empty tables. Don't know
why. */
- phs->array_numstruct=1;
+ /* Oracle doesn't allow NULL buffers even for empty tables.
Don't know why. */
+ phs->array_numstruct=1;
}
if( phs->ora_maxarray_numentries== 0 ){
/* Zero means "use current array length". */
- phs->ora_maxarray_numentries=phs->array_numstruct;
+ phs->ora_maxarray_numentries=phs->array_numstruct;
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries assumed=phs->array_numstruct=%d\n",
- phs->array_numstruct);
- }
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries assumed=phs->array_numstruct=%d\n",
+ phs->array_numstruct);
+ }
}else{
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries=%d\n",
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries=%d\n",
phs->ora_maxarray_numentries);
- }
+ }
}
need_allocate_rows=phs->ora_maxarray_numentries;
@@ -2022,8 +2022,6 @@
int at_exec = 0;
at_exec = (phs->desc_h == NULL);
-PerlIO_printf(DBILOGFP, "\n\nin dbd_rebind_ph_char() phs->sv=%d\n",phs->sv);
-
if (!SvPOK(phs->sv)) { /* normalizations for special cases */
if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
if (!(SvROK(phs->sv) && phs->is_inout))
@@ -2034,7 +2032,7 @@
}
- if (DBIS->debug <= 2) {
+ if (DBIS->debug >= 2) {
char *val = neatsvpv(phs->sv,0);
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (1): bind %s <==
%.1000s (", phs->name, val);
if (!SvOK(phs->sv))
@@ -2098,22 +2096,20 @@
phs->maxlen = ((IV)SvLEN(phs->sv))-1; /* avail buffer space (64bit safe)
*/
-PerlIO_printf(DBILOGFP, "\n\n in dbd_rebind_ph_char( 3)
phs->maxlen=%d\n",phs->maxlen);
if (phs->maxlen < 0) /* can happen with nulls */
phs->maxlen = 0;
phs->alen = value_len + phs->alen_incnull;
- if (DBIS->debug <= 3) {
- UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (2): bind %s <== '%.*s'
(size %ld/%ld, otype %d, indp %d, at_exec %d)\n",
- phs->name,
- (int)(phs->alen > neatsvpvlen ? neatsvpvlen : phs->alen),
- (phs->progv) ? phs->progv : "",
- (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp, at_exec);
+ if (DBIS->debug >= 3) {
+ UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (2): bind %s <==
'%.*s' (size %ld/%ld, otype %d, indp %d, at_exec %d)\n",
+ phs->name,
+ (int)(phs->alen > neatsvpvlen ? neatsvpvlen : phs->alen),
+ (phs->progv) ? phs->progv : "",
+ (long)phs->alen, (long)phs->maxlen, phs->ftype, phs->indp,
at_exec);
}
-PerlIO_printf(DBILOGFP, "done dbd_rebind_ph_char");
return 1;
}
@@ -2605,7 +2601,7 @@
SvPOK_only_UTF8(sv);
}
else { /* shouldn't happen */
- debug = 2;
+ debug = 2;/
note = " [placeholder has no data buffer]";
}
@@ -2651,7 +2647,7 @@
AV *av = (AV*)SvRV(phs->sv);
SV *sv = *av_fetch(av, index, 1);
dbd_phs_sv_complete(phs, sv, 0);
- if (debug <= 2)
+ if (debug >= 2)
PerlIO_printf(DBILOGFP, " dbd_phs_avsv_complete out '%s'[%ld] =
%s (arcode %d, ind %d, len %d)\n",
phs->name, (long)index, neatsvpv(sv,0), phs->arcode,
phs->indp, phs->alen);
}
@@ -2833,7 +2829,6 @@
{
dTHX;
sword status;
-PerlIO_printf(DBILOGFP, "in do_bind_array_exec phs->sv=%d\n",phs->sv);
OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
0,
@@ -2866,11 +2861,7 @@
phs_t *phs;
{
dTHX;
-
- PerlIO_printf(DBILOGFP, "\n in init_bind_for_array_exec
phs->sv=%d\n",phs->sv);
if (phs->sv == &sv_undef) { /* first bind for this placeholder */
- PerlIO_printf(DBILOGFP, "\n ok why am I here \n\n\n%d\n",phs->sv);
-
phs->is_inout = 0;
phs->maxlen = 1;
/* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
@@ -2910,8 +2901,8 @@
int param_count;
char namebuf[30];
STRLEN len;
-
int outparams = (imp_sth->out_params_av) ?
AvFILL(imp_sth->out_params_av)+1 : 0;
+
if (debug >= 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,
@@ -2947,7 +2938,7 @@
/* Check the `tuples_status' parameter. */
if(SvTRUE(tuples_status)) {
if(!SvROK(tuples_status) || SvTYPE(SvRV(tuples_status)) != SVt_PVAV) {
- croak("ora_st_execute_array(): tuples_status not an array
reference.");
+ croak("ora_st_execute_array(): tuples_status not an array
reference.");
}
tuples_status_av = (AV*)SvRV(tuples_status);
av_fill(tuples_status_av, exe_count - 1);
@@ -2972,80 +2963,74 @@
fix for Perl undefined warning. Moved out of function back out to main code
Still ensures proper OCIBindByName*/
- param_count=DBIc_NUM_PARAMS(imp_sth);
- phs = safemalloc(param_count*sizeof(*phs));
- memset(phs, 0, param_count*sizeof(*phs));
-
- for(j = 0; (unsigned int) j < exe_count; j++) {
-
- sv_p = av_fetch(tuples_av, j, 0);
- if(sv_p == NULL) {
- Safefree(phs);
- croak("Cannot fetch tuple %d", j);
- }
- sv = *sv_p;
- if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
- Safefree(phs);
- croak("Not an array ref in element %d", j);
- }
- av = (AV*)SvRV(sv);
- for(i = 0; i < param_count; i++) {
- if(!phs[i]) {
- SV **phs_svp;
-
- sprintf(namebuf, ":p%d", i+1);
- PerlIO_printf(DBILOGFP, "namebuf = %s 2\n",namebuf);
- 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);
- }
- phs[i] = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder
struct */
- if(phs[i]->idx < 0) {
- Safefree(phs);
- croak("Placeholder %d not of ?/:1 type", i);
- }
- PerlIO_printf(DBILOGFP, "namebuf = 2\n");
- init_bind_for_array_exec(phs[i]);
- }
- PerlIO_printf(DBILOGFP, "namebuf = 3\n");
- sv_p = av_fetch(av, phs[i]->idx, 0);
- PerlIO_printf(DBILOGFP, "namebuf = 2 %d\n",sv_p);
- if(sv_p == NULL) {
+ param_count=DBIc_NUM_PARAMS(imp_sth);
+ phs = safemalloc(param_count*sizeof(*phs));
+ memset(phs, 0, param_count*sizeof(*phs));
+
+ for(j = 0; (unsigned int) j < exe_count; j++) {
+
+ sv_p = av_fetch(tuples_av, j, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch tuple %d", j);
+ }
+ sv = *sv_p;
+ if(!SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) {
+ Safefree(phs);
+ croak("Not an array ref in element %d", j);
+ }
+ av = (AV*)SvRV(sv);
+ for(i = 0; i < param_count; i++) {
+ if(!phs[i]) {
+ SV **phs_svp;
+ sprintf(namebuf, ":p%d", i+1);
+ phs_svp = hv_fetch(imp_sth->all_params_hv,
+ namebuf, strlen(namebuf), 0);
+ if (phs_svp == NULL) {
Safefree(phs);
- croak("Cannot fetch value for param %d in entry %d", i, j);
+ 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) {
+ Safefree(phs);
+ croak("Placeholder %d not of ?/:1 type", i);
}
+ init_bind_for_array_exec(phs[i]);
+ }
+ sv_p = av_fetch(av, phs[i]->idx, 0);
+ if(sv_p == NULL) {
+ Safefree(phs);
+ croak("Cannot fetch value for param %d in entry %d", i, j);
+ }
- sv = *sv_p;
-
- /*check to see if value sv is a null (undef) if it is upgrade
it*/
- if (!SvOK(sv)) {
- if(SvUPGRADE(sv, SVt_PV)){} /* For GCC
not to warn on unused result */
-
- }
- else {
- SvPV(sv, len);
- }
-
-
- /* Find the value length, and increase maxlen if needed. */
- if(SvROK(sv)) {
- Safefree(phs);
- 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;
+ sv = *sv_p;
- /* 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);
- }
- }
- }
- }
+ /*check to see if value sv is a null (undef) if it is upgrade
it*/
+ if (!SvOK(sv)) {
+ if(SvUPGRADE(sv, SVt_PV)){} /* For GCC not to
warn on unused result */
+ }
+ else {
+ SvPV(sv, len);
+ }
+
+
+ /* Find the value length, and increase maxlen if needed. */
+ if(SvROK(sv)) {
+ Safefree(phs);
+ 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;
+
+ /* 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);
+ }
+ }
+ }
+ }
Safefree(phs);
/* Store array of bind typles, for use in OCIBindDynamic() callback. */
@@ -3056,57 +3041,39 @@
if(autocommit)
oci_mode |= OCI_COMMIT_ON_SUCCESS;
-PerlIO_printf(DBILOGFP, "\n\n\n\n OCIStmtExecute_log_stat exe_array next
outparams=%d\n",outparams);
-
-
-
-OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
exe_count, 0, 0, 0, oci_mode, exe_status);
-if (outparams){
-
-PerlIO_printf(DBILOGFP, "\n\n\n\n i=%d",i);
-
-i=outparams;
- while(--i >= 0) {
-
-
- phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
- SV *sv = phs->sv;
-
- PerlIO_printf(DBILOGFP, " sv=%d\n",sv);
-
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- AV *av = (AV*)SvRV(sv);
- I32 avlen = AvFILL(av);
- PerlIO_printf(DBILOGFP, " av=%d \n",av);
-
- /*I32 avlen = AvFILL(av);*/
- for (j=0;j<=av_len(av);j++){
- SV *sv2 = *av_fetch(av, j, 1);
- dbd_phs_avsv_complete(phs, j, debug);
-
- PerlIO_printf(DBILOGFP, "\n sv2 %d\n",sv2);
- PerlIO_printf(DBILOGFP, "\n
neatsvpv(sv2,1)=%s\n",neatsvpv(sv2,1));
- }
- /*if (avlen >= 0)
- dbd_phs_avsv_complete(phs, avlen, debug);*/
- }
-}
-}
-
- imp_sth->bind_tuples = NULL;
+ imp_sth->bind_tuples = NULL;
if (exe_status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, exe_status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
+ oci_error(sth, imp_sth->errhp, exe_status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
if(exe_status != OCI_SUCCESS_WITH_INFO)
return -2;
}
+ if (outparams){
+ i=outparams;
+ while(--i >= 0) {
+ phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) ==
SVt_PVAV) {
+ AV *av = (AV*)SvRV(sv);
+ I32 avlen = AvFILL(av);
+ for (j=0;j<=av_len(av);j++){
+ SV *sv2 = *av_fetch(av, j, 1);
+ dbd_phs_avsv_complete(phs, j, debug);
+ }
+ }
+ }
+ }
+
OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS,
status);
- if (debug <= 6)
- PerlIO_printf(DBILOGFP, " ora_st_execute_array %d errors in batch.\n",
+
+ if (debug >= 6)
+ PerlIO_printf(DBILOGFP, " ora_st_execute_array %d errors in
batch.\n",
num_errs);
+
if(num_errs && tuples_status_av) {
OCIError *row_errhp, *tmp_errhp;
ub4 row_off;
@@ -3152,7 +3119,7 @@
return -2;
} else {
ub4 row_count = 0;
- OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
+ OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0,
OCI_ATTR_ROW_COUNT, status);
return row_count;
}
}
Modified: dbd-oracle/branches/array_inout/oci8.c
==============================================================================
--- dbd-oracle/branches/array_inout/oci8.c (original)
+++ dbd-oracle/branches/array_inout/oci8.c Mon Feb 4 16:50:08 2008
@@ -2010,8 +2010,6 @@
/* sth is not 'active' (executing) then we need an explicit describe.
*/
if ( !DBIc_ACTIVE(imp_sth) ) {
-PerlIO_printf(DBILOGFP, "\n\n\nOCIStmtExecute_log_stat 3 next\n");
-
OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
0, 0, 0, 0, OCI_DESCRIBE_ONLY, status);
if (status != OCI_SUCCESS) {
@@ -2949,7 +2947,7 @@
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID /LOB
refetch");
-PerlIO_printf(DBILOGFP, "\n\n\n OCIStmtExecute_log_stat 4 next\n");
+
OCIStmtExecute_log_stat(imp_sth->svchp, lr->stmthp, errhp,
1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */
Modified: dbd-oracle/branches/objects/dbdimp.c
==============================================================================
--- dbd-oracle/branches/objects/dbdimp.c (original)
+++ dbd-oracle/branches/objects/dbdimp.c Mon Feb 4 16:50:08 2008
@@ -957,147 +957,6 @@
}
-
-/* ================================================================== */
-
-void
-dbd_tdo_prepare(SV *h,imp_sth_t *imp_sth)
-{
- dTHX;
- SV **tdo_name_hvp;
- SV *tdo_name_hv;
- int sv_i= 1;
- OCIType *any_tdo = (OCIType *)0;
- OCIArray *oArray = (OCIArray*)0;
- OCIInd *any_indp = (OCIInd *) 0;
- OCIType *tdo;
-OCIAnyData *oan_buffer;
- sword status;
-/* imp_fbh_t *fbh = &imp_sth->fbh[sv_i];
- sv_i= 1; /*sv_2mortal(newSViv((IV)i));*/
- imp_fbh_t *fbh = &imp_sth->fbh[1];
- DBIS->debug=16;
-
- if (DBIS->debug >= 3){
- PerlIO_printf(DBILOGFP," Field #%d is an object of some sort.
Getting a OCIHandle for its tdo \n",sv_i);
- }
-
- /*OCIHandleAlloc_ok(imp_sth->envhp,
- (dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
- OCI_HTYPE_DESCRIBE, status);
-
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, "OCIHandleAlloc_ok/allocate
handle");
- ++num_errors;
- }
-
- tdo_name_hvp = hv_fetch(imp_sth->fbh_tdo_hv,sv_i,(ub4) strlen((char
*)sv_i), 0);
- tdo_name_hv=*tdo_name_hvp;
-
- if (DBIS->debug >= 3){
- PerlIO_printf(DBILOGFP," Get the OCIType named %s for field #%d
from ora_oci_type_names \n",neatsvpv(*tdo_name_hvp,0),sv_i);
- }
-*/
-
- status=OCITypeByName(imp_sth->envhp,
- imp_sth->errhp,
- imp_sth->svchp,
- (CONST text *)"",
- (ub4) strlen(""),
- "PHONE_NUMBERS",
- (ub4) 13,
- (ub4) 0,
- (ub4) 0,
- OCI_DURATION_SESSION,
- OCI_TYPEGET_ALL,
- &any_tdo);
-
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, " \n john
error OCITypeByName");
-
- }
-
- /* if (DBIS->debug >= 3){
- PerlIO_printf(DBILOGFP," Got the tdo for the object %s
\n",neatsvpv(*tdo_name_hvp,0));
- }
-*/
- fbh->tdo=any_tdo; /* save this for later use in the fetch */
-
- status=OCIObjectNew(imp_sth->envhp,
- imp_sth->errhp,
- imp_sth->svchp,
- OCI_TYPECODE_VARRAY,
- any_tdo,
- 0,
- OCI_DURATION_SESSION,
- TRUE,
- (dvoid**)&oArray);
-
- PerlIO_printf(DBILOGFP," not an error here 1#%d \n",status);
-
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, " \n john error
OCIObjectNew");
-
- }
-
-
- /*if (DBIS->debug >= 3){
- PerlIO_printf(DBILOGFP," Created a new object for %s
\n",neatsvpv(*tdo_name_hvp,0));
- }
-*/
- OCIDefineByPos_log_stat(imp_sth->stmhp,
- &fbh->defnp,
- imp_sth->errhp,
- (ub4) 1,
- 0,/*(fbh->desc_h) ? (dvoid*)&fbh->desc_h :
(dvoid*)fb_ary->abuf,--5*/
- 0,/*(fbh->desc_h) ? -1 : define_len,--6*/
- SQLT_NTY,
- 0,
- 0,
- 0,
- OCI_DEFAULT,
- status);
-
- PerlIO_printf(DBILOGFP," not an error here 2#%d \n",status);
-
- if (status != OCI_SUCCESS) {
- oci_error(h, imp_sth->errhp, status, " \n john error
OCIDefineByPos");
- /* ++num_errors;*/
- }
-
- status=OCIDefineObject(fbh->defnp,
- imp_sth->errhp,
- any_tdo,
- (dvoid **) &oan_buffer,
- (ub4 *) 0,
- (dvoid **)&any_indp,
- (ub4 *) 0);
-/*
-status=OCIBindObject(fbh->defnp,
- imp_sth->errhp,
- any_tdo,
- (void**)&oArray,
- &szArr,0,0);
-*/
- PerlIO_printf(DBILOGFP," not an error here 3#%d
\n",status);
-
-
-
- PerlIO_printf(DBILOGFP," not an error here 3#%d \n",status);
-
- /*if (status != 0) {
- oci_error(h, imp_sth->errhp, status, "\n 4john error
OCIBindObject");
- ++num_errors;
- }
-
- if (DBIS->debug >= 3){
- PerlIO_printf(DBILOGFP," Bound object %s to position #%d
\n",neatsvpv(*tdo_name_hvp,0),i);
- }
-*/
- PerlIO_printf(DBILOGFP," Done with objects\n\n\n");
- DBIS->debug=0;
-}
-
void
dbd_preparse(imp_sth_t *imp_sth, char *statement)
{
Modified: dbd-oracle/branches/objects/oci8.c
==============================================================================
--- dbd-oracle/branches/objects/oci8.c (original)
+++ dbd-oracle/branches/objects/oci8.c Mon Feb 4 16:50:08 2008
@@ -231,6 +231,149 @@
return 0;
}
+
+
+/* ================================================================== */
+
+void
+oci_tdo_prepare(SV *h,imp_sth_t *imp_sth)
+{
+ dTHX;
+ SV **tdo_name_hvp;
+ SV *tdo_name_hv;
+ int sv_i= 1;
+ OCIType *any_tdo = (OCIType *)0;
+ OCIArray *oArray = (OCIArray*)0;
+ OCIInd *any_indp = (OCIInd *) 0;
+ OCIType *tdo;
+OCIAnyData *oan_buffer;
+ sword status;
+/* imp_fbh_t *fbh = &imp_sth->fbh[sv_i];
+ sv_i= 1; /*sv_2mortal(newSViv((IV)i));*/
+ imp_fbh_t *fbh = &imp_sth->fbh[1];
+ fb_ary_t *fb_ary = fbh->fb_ary;
+ DBIS->debug=16;
+
+ if (DBIS->debug >= 3){
+ PerlIO_printf(DBILOGFP," Field #%d is an object of some sort.
Getting a OCIHandle for its tdo \n",sv_i);
+ }
+
+ OCIHandleAlloc_ok(imp_sth->envhp,
+ (dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
+ OCI_HTYPE_DESCRIBE, status);
+
+ /*if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, "OCIHandleAlloc_ok/allocate
handle");
+ ++num_errors;
+ }
+
+ tdo_name_hvp = hv_fetch(imp_sth->fbh_tdo_hv,sv_i,(ub4) strlen((char
*)sv_i), 0);
+ tdo_name_hv=*tdo_name_hvp;
+
+ if (DBIS->debug >= 3){
+ PerlIO_printf(DBILOGFP," Get the OCIType named %s for field #%d
from ora_oci_type_names \n",neatsvpv(*tdo_name_hvp,0),sv_i);
+ }
+*/
+
+ status=OCITypeByName(imp_sth->envhp,
+ imp_sth->errhp,
+ imp_sth->svchp,
+ (CONST text *)"",
+ (ub4) strlen(""),
+ "PHONE_NUMBERS",
+ (ub4) 13,
+ (ub4) 0,
+ (ub4) 0,
+ OCI_DURATION_SESSION,
+ OCI_TYPEGET_ALL,
+ &any_tdo);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, " \n john
error OCITypeByName");
+
+ }
+
+ /* if (DBIS->debug >= 3){
+ PerlIO_printf(DBILOGFP," Got the tdo for the object %s
\n",neatsvpv(*tdo_name_hvp,0));
+ }
+*/
+ fbh->tdo=any_tdo; /* save this for later use in the fetch */
+
+ status=OCIObjectNew(imp_sth->envhp,
+ imp_sth->errhp,
+ imp_sth->svchp,
+ OCI_TYPECODE_VARRAY,
+ any_tdo,
+ 0,
+ OCI_DURATION_SESSION,
+ TRUE,
+ (dvoid**)&oArray);
+
+ PerlIO_printf(DBILOGFP," not an error here 1#%d \n",status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, " \n john error
OCIObjectNew");
+
+ }
+
+
+ /*if (DBIS->debug >= 3){
+ PerlIO_printf(DBILOGFP," Created a new object for %s
\n",neatsvpv(*tdo_name_hvp,0));
+ }
+*/
+ OCIDefineByPos_log_stat(imp_sth->stmhp,
+ &fbh->defnp,
+ imp_sth->errhp,
+ (ub4) 1,
+ 0,/*(fbh->desc_h) ? (dvoid*)&fbh->desc_h :
(dvoid*)fb_ary->abuf,--5*/
+ 0,/*(fbh->desc_h) ? -1 : define_len,--6*/
+ SQLT_NTY,
+ 0,
+ 0,
+ 0,
+ OCI_DEFAULT,
+ status);
+
+ PerlIO_printf(DBILOGFP," not an error here 2#%d \n",status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(h, imp_sth->errhp, status, " \n john error
OCIDefineByPos");
+ /* ++num_errors;*/
+ }
+
+ status=OCIDefineObject(fbh->defnp,
+ imp_sth->errhp,
+ any_tdo,
+ (dvoid **) &oan_buffer,
+ (ub4 *) 0,
+ (dvoid **)&any_indp,
+ (ub4 *) 0);
+/*
+status=OCIBindObject(fbh->defnp,
+ imp_sth->errhp,
+ any_tdo,
+ (void**)&oArray,
+ &szArr,0,0);
+*/
+ PerlIO_printf(DBILOGFP," not an error here 3#%d
\n",status);
+
+
+
+ PerlIO_printf(DBILOGFP," not an error here 3#%d \n",status);
+
+ /*if (status != 0) {
+ oci_error(h, imp_sth->errhp, status, "\n 4john error
OCIBindObject");
+ ++num_errors;
+ }
+
+ if (DBIS->debug >= 3){
+ PerlIO_printf(DBILOGFP," Bound object %s to position #%d
\n",neatsvpv(*tdo_name_hvp,0),i);
+ }
+*/
+ PerlIO_printf(DBILOGFP," Done with objects\n\n\n");
+ DBIS->debug=0;
+}
+
void *
oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags)
{
@@ -346,7 +489,7 @@
if (imp_sth->fbh_tdo_hv){
PerlIO_printf(DBILOGFP, " in my supper special statement
function thing\n");
- dbd_tdo_prepare(sth,imp_sth);
+ oci_tdo_prepare(sth,imp_sth);
}
Modified: dbd-oracle/branches/sasha/dbdimp.c
==============================================================================
--- dbd-oracle/branches/sasha/dbdimp.c (original)
+++ dbd-oracle/branches/sasha/dbdimp.c Mon Feb 4 16:50:08 2008
@@ -1320,6 +1320,7 @@
* */
int ora_realloc_phs_array(phs_t *phs,int newentries, int newbufsize){
int i; /* Loop variable */
+ unsigned short *newal;
if( newbufsize < 0 ){
newbufsize=0;
}
@@ -1334,9 +1335,7 @@
}else{
croak("Not enough memory to allocate %d OCI
indicators.",newentries);
}
- unsigned short *newal=(unsigned short *)realloc(
- phs->array_lengths,
- newentries*sizeof(unsigned short)
+ newal=(unsigned short
*)realloc(phs->array_lengths,newentries*sizeof(unsigned short)
);
if( newal ){
phs->array_lengths=newal;
@@ -1364,6 +1363,7 @@
}
return 0;
}
+
/* bind of SYS.DBMS_SQL.VARCHAR2_TABLE */
int
dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
@@ -1376,35 +1376,39 @@
ub1 csform;
ub2 csid;
int flag_data_is_utf8=0;
+ int need_allocate_rows;
+ int buflen;
+ int i;
+ unsigned int maxlen;
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /*
Allow only array binds */
- croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY
reference required, but got %s for '%s'.",
+ croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY
reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
}
arr=(AV*)(SvRV(phs->sv));
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d\n",
- phs->array_numstruct);
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d\n",
+ phs->array_numstruct);
}
/* If no number of entries to bind specified,
* set phs->array_numstruct to the scalar(@array) bound.
*/
if( phs->array_numstruct <= 0 ){
- /* av_len() returns last array index, or -1 is array is empty */
- int numarrayentries=av_len( arr );
- if( numarrayentries >= 0 ){
- phs->array_numstruct = numarrayentries+1;
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d (calculated) \n",
- phs->array_numstruct);
- }
- }
+ /* av_len() returns last array index, or -1 is array is empty */
+ int numarrayentries=av_len( arr );
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): array_numstruct=%d (calculated) \n",
+ phs->array_numstruct);
+ }
+ }
}
/* Fix charset */
csform = phs->csform;
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): original
csform=%d\n",
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
original csform=%d\n",
(int)csform);
}
/* Calculate each bound structure maxlen.
@@ -1412,155 +1416,152 @@
*
* Charset calculation is done inside this loop either.
*/
- {
- int maxlen=0;
- int i;
- for(i=0;i<av_len(arr)+1;i++){
- SV *item;
- item=*(av_fetch(arr,i,0));
- if( item ){
- 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);
+ {
+ maxlen=0;
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ 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( length == 0 ){
+ length=SvCUR(item);
+ }
+ if( length+1 > maxlen ){
+ maxlen=length+1;
+ }
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n",
+ i,(int)length);
+ }
+ }
+ if(SvUTF8(item) ){
+ flag_data_is_utf8=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i);
+ }
+ if (csform != SQLCS_NCHAR) {
+ /* try to default csform to avoid
translation through non-unicode */
+ if
(CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) /* prefer NCHAR */
+ csform = SQLCS_NCHAR;
+ else if
(CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
+ csform = SQLCS_IMPLICIT;
+ /* else leave csform == 0 */
+ if (trace_level)
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name,
+ (csform == SQLCS_NCHAR) ? "so
setting csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_IMPLICIT) ? "so
setting csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are
unicode\n");
+ }
+ }else{
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i);
}
- } else { /* ensure we're at least an SVt_PV (so SvPVX
etc work) */
- SvUPGRADE(item, SVt_PV);
}
- }
- if( length == 0 ){
- length=SvCUR(item);
- }
- if( length+1 > maxlen ){
- maxlen=length+1;
- }
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n",
- i,(int)length);
- }
- }
- if(SvUTF8(item) ){
- flag_data_is_utf8=1;
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i);
- }
- if (csform != SQLCS_NCHAR) {
- /* try to default csform to avoid translation through
non-unicode */
- if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) /*
prefer NCHAR */
- csform = SQLCS_NCHAR;
- else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
- csform = SQLCS_IMPLICIT;
- /* else leave csform == 0 */
- if (trace_level)
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name,
- (csform == SQLCS_NCHAR) ? "so setting
csform=SQLCS_IMPLICIT" :
- (csform == SQLCS_IMPLICIT) ? "so setting
csform=SQLCS_NCHAR" :
- "but neither CHAR nor NCHAR are unicode\n");
- }
- }else{
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i);
- }
- }
}
}
if( phs->maxlen <=0 ){
phs->maxlen=maxlen;
if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen calculated =%d\n",
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): phs->maxlen calculated =%d\n",
(int)maxlen);
}
} else{
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen forsed =%d\n",
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%d\n",
(int)maxlen);
}
}
- }
+
/* Do not allow string bind longer than max VARCHAR2=4000+1 */
if( phs->maxlen > 4001 ){
- phs->maxlen=4001;
+ phs->maxlen=4001;
}
if( phs->array_numstruct == 0 ){
- /* Oracle doesn't allow NULL buffers even for empty tables. Don't know
why. */
- phs->array_numstruct=1;
+ /* Oracle doesn't allow NULL buffers even for empty tables.
Don't know why. */
+ phs->array_numstruct=1;
}
- if( phs->ora_maxarray_numentries== 0 ){
- /* Zero means "use current array length". */
- phs->ora_maxarray_numentries=phs->array_numstruct;
+ if( phs->ora_maxarray_numentries == 0 ){
+ /* Zero means "use current array length". */
+ phs->ora_maxarray_numentries = phs->array_numstruct;
}
- int need_allocate_rows=phs->ora_maxarray_numentries;
+ need_allocate_rows=phs->ora_maxarray_numentries;
if( need_allocate_rows< phs->array_numstruct ){
- need_allocate_rows=phs->array_numstruct;
+ need_allocate_rows=phs->array_numstruct;
}
- int buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least
ora_maxarray_numentries entries */
+ buflen =need_allocate_rows;/* phs->maxlen; /* We need buffer for at least
ora_maxarray_numentries entries */
/* Upgrade array buffer to new length */
if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){
- croak("Unable to bind %s - %d structures by %d bytes requires too much
memory.",
+ croak("Unable to bind %s - %d structures by %d bytes requires
too much memory.",
phs->name, need_allocate_rows, buflen );
}else{
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n",
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n",
need_allocate_rows,buflen);
- }
+ }
}
/* If maximum allowed bind numentries is less than allowed,
* do not bind full array
*/
if( phs->array_numstruct > phs->ora_maxarray_numentries ){
- phs->array_numstruct = phs->ora_maxarray_numentries;
+ phs->array_numstruct = phs->ora_maxarray_numentries;
}
/* Fill array buffer with string data */
- {
- int i; /* Not to require C99 mode */
+
+ /* Not to require C99 mode */
for(i=0;i<av_len(arr)+1;i++){
SV *item;
item=*(av_fetch(arr,i,0));
if( item ){
- STRLEN itemlen;
- char *str=SvPV(item, itemlen);
- if( str && (itemlen>0) ){
- /* Limit string length to maxlen. FIXME: This may corrupt
UTF-8 data. */
- if( itemlen > phs->maxlen-1 ){
- itemlen=phs->maxlen-1;
- }
- memcpy( phs->array_buf+phs->maxlen*i,
- str,
- itemlen);
- /* Set last byte to zero */
- phs->array_buf[ phs->maxlen*i + itemlen ]=0;
- phs->array_indicators[i]=0;
- phs->array_lengths[i]=itemlen+1; /* Zero byte */
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
- "Copying length=%d array[%d]='%s'.\n",
- itemlen,i,str);
- }
- }else{
- /* Mark NULL */
- phs->array_indicators[i]=1;
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
- "Copying length=%d array[%d]=NULL (length==0 or
! str) .\n",
- itemlen,i);
- }
- }
+ STRLEN itemlen;
+ char *str=SvPV(item, itemlen);
+ if( str && (itemlen>0) ){
+ /* Limit string length to maxlen. FIXME: This
may corrupt UTF-8 data. */
+ if( itemlen > (unsigned)phs->maxlen-1 ){
+ itemlen=phs->maxlen-1;
+ }
+ memcpy(
phs->array_buf+phs->maxlen*i,str,itemlen);
+ /* Set last byte to zero */
+ phs->array_buf[ phs->maxlen*i + itemlen ]=0;
+ phs->array_indicators[i]=0;
+ phs->array_lengths[i]=itemlen+1; /* Zero byte */
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%d array[%d]='%s'.\n",
+ itemlen,i,str);
+ }
+ }else{
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%d array[%d]=NULL
(length==0 or ! str) .\n",
+ itemlen,i);
+ }
+ }
}else{
- /* Mark NULL */
- phs->array_indicators[i]=1;
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): "
- "Copying length=? array[%d]=NULL av_fetch
failed.\n", i);
- }
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
+ "Copying length=? array[%d]=NULL av_fetch
failed.\n", i);
+ }
}
}
- }
+
/* Do actual bind */
OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
@@ -1575,8 +1576,8 @@
status
);
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
}
OCIBindArrayOfStruct_log_stat(phs->bndhp, imp_sth->errhp,
phs->maxlen, /* Skip parameter for the next data value */
@@ -1585,22 +1586,22 @@
0, /* Skip parameter for the next column-level
error code */
status);
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct");
+ return 0;
}
/* Fixup charset */
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,
+ 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 ( 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
,
+ OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND,
&phs->csid_orig, (ub4)0 ,
OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
}
@@ -1622,21 +1623,21 @@
(unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
if (csid) {
- OCIAttrSet_log_stat(phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ 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;
- }
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_CHARSET_ID)"));
+ return 0;
+ }
}
if (phs->maxdata_size) {
- OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND,
phs->array_buf, (ub4)phs->array_buflen, (ub4)OCI_ATTR_MAXDATA_SIZE,
imp_sth->errhp, status);
- if ( status != OCI_SUCCESS ) {
- oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)"));
- return 0;
- }
+ if ( status != OCI_SUCCESS ) {
+ oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIAttrSet (OCI_ATTR_MAXDATA_SIZE)"));
+ return 0;
+ }
}
return 2;
@@ -1645,18 +1646,19 @@
/* Copy array data from array buffer into perl array */
/* Returns false on error, true on success */
-int dbd_phs_ora_varchar2_table_fixup_after_execute(phs_t *phs){
+int
+dbd_phs_ora_varchar2_table_fixup_after_execute(phs_t *phs){
dTHX;
-
- int trace_level = DBIS->debug;
AV *arr;
+ int trace_level;
+ trace_level = DBIS->debug;
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /*
Allow only array binds */
- croak("dbd_phs_ora_varchar2_table_fixup_after_execute(): bad bind
variable. ARRAY reference required, but got %s for '%s'.",
+ croak("dbd_phs_ora_varchar2_table_fixup_after_execute(): bad
bind variable. ARRAY reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
}
if (trace_level >= 1){
- PerlIO_printf(DBILOGFP,
+ PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%d \n",
phs->name,
phs->array_numstruct,
@@ -1667,82 +1669,78 @@
/* If no data is returned, just clear the array. */
if( phs->array_numstruct <= 0 ){
- av_clear(arr);
- return 1;
+ av_clear(arr);
+ return 1;
}
/* Delete extra data from array, if any */
while( av_len(arr) >= phs->array_numstruct ){
- av_delete(arr,av_len(arr),G_DISCARD);
+ av_delete(arr,av_len(arr),G_DISCARD);
};
/* Extend array, if needed. */
if( av_len(arr)+1 < phs->array_numstruct ){
- av_extend(arr,phs->array_numstruct-1);
+ av_extend(arr,phs->array_numstruct-1);
}
/* Fill array with buffer data */
{
- /* phs_t */
- int i; /* Not to require C99 mode */
- for(i=0;i<phs->array_numstruct;i++){
- SV *item,**pitem;
- pitem=av_fetch(arr,i,0);
- if( pitem ){
- item=*pitem;
- }else{
- item=NULL;
- }
- if( phs->array_indicators[i] == -1 ){
- /* NULL */
- if( item ){
- SvSetMagicSV(item,&PL_sv_undef);
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
-
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
SvSetMagicSV(item,&PL_sv_undef);\n",
- i
- );
- }
- }else{
- av_store(arr,i,&PL_sv_undef);
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
-
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
av_store(arr,i,&PL_sv_undef);\n",
- i
- );
- }
- }
- }else{
- if( (phs->array_indicators[i] == -2) ||
(phs->array_indicators[i] > 0) ){
- /* Truncation occurred */
- if (trace_level >= 2){
- PerlIO_printf(DBILOGFP,
-
"dbd_phs_ora_varchar2_table_fixup_after_execute(): Placeholder '%s': data
truncated at %d row.\n",
- phs->name,i);
- }
- }else{
- /* All OK. Just copy value.*/
- }
- if( item ){
-
sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]);
- SvPOK_only_UTF8(item);
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
-
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
-
"sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n",
- i, phs->array_buf+phs->maxlen*i
- );
- }
- }else{
-
av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
- if (trace_level >= 3){
- PerlIO_printf(DBILOGFP,
-
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
-
"av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
\n",
- i, phs->array_buf+phs->maxlen*i
- );
- }
- }
+ /* phs_t */
+ int i; /* Not to require C99 mode */
+ for(i=0;i<phs->array_numstruct;i++){
+ SV *item,**pitem;
+ pitem=av_fetch(arr,i,0);
+ if( pitem ){
+ item=*pitem;
+ }else{
+ item=NULL;
+ }
+ if( phs->array_indicators[i] == -1 ){
+ /* NULL */
+ if( item ){
+ SvSetMagicSV(item,&PL_sv_undef);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
SvSetMagicSV(item,&PL_sv_undef);\n",
+ i);
+ }
+ }else{
+ av_store(arr,i,&PL_sv_undef);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
av_store(arr,i,&PL_sv_undef);\n",
+ i);
+ }
+ }
+ }else{
+ if( (phs->array_indicators[i] == -2) ||
(phs->array_indicators[i] > 0) ){
+ /* Truncation occurred */
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
+
"dbd_phs_ora_varchar2_table_fixup_after_execute(): Placeholder '%s': data
truncated at %d row.\n",
+ phs->name,i);
+ }
+ }else{
+ /* All OK. Just copy value.*/
+ }
+ if( item ){
+
sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]);
+ SvPOK_only_UTF8(item);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
+
"sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n",
+ i, phs->array_buf+phs->maxlen*i
);
+ }
+ }else{
+
av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
+
"av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
\n",
+ i, phs->array_buf+phs->maxlen*i
);
+ }
+ }
}
}
- }
+ }
if (trace_level >= 2){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute():
scalar(@arr)=%d.\n",
