Author: byterock
Date: Sun Feb 3 18:23:24 2008
New Revision: 10681
Modified:
dbd-oracle/branches/array_inout/dbdimp.c
dbd-oracle/branches/array_inout/oci8.c
Log:
done for today can taste it now
Modified: dbd-oracle/branches/array_inout/dbdimp.c
==============================================================================
--- dbd-oracle/branches/array_inout/dbdimp.c (original)
+++ dbd-oracle/branches/array_inout/dbdimp.c Sun Feb 3 18:23:24 2008
@@ -2261,8 +2261,8 @@
ub1 csform;
ub2 csid;
- if (trace_level <= 5)
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (1): rebinding %s as
%s (%s, ftype %d, csid %d, csform %d, inout %d)\n",
+ if (trace_level <= 5000)
+ PerlIO_printf(DBILOGFP, "\n\n\ndbd_rebind_ph() (1): rebinding
%s as %s (%s, ftype %d, csid %d, csform %d, inout %d)\n",
phs->name, (SvPOK(phs->sv) ? neatsvpv(phs->sv,0) :
"NULL"),(SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
phs->ftype, phs->csid, phs->csform, phs->is_inout);
@@ -2286,12 +2286,12 @@
if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself
successfully */
- if (trace_level <= 3)
+ if (trace_level <= 3000)
PerlIO_printf(DBILOGFP, " bind %s done with ftype
%d\n",
phs->name, phs->ftype);
return 1;
}
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph done=%d\n",done);
+ PerlIO_printf(DBILOGFP, "\n\n\ndbd_rebind_ph done=%d\n",done);
if (done != 1) {
return 0; /* the rebind failed */
@@ -2413,7 +2413,7 @@
/* check if placeholder was passed as a number */
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() 1 newvalue=(%d)\n", newvalue);
+PerlIO_printf(DBILOGFP, "\n\nin dbd_bind_ph() 1 newvalue=(%d)\n", newvalue);
if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */
mg_get(ph_namesv);
@@ -2481,7 +2481,10 @@
if (!imp_sth->out_params_av)
imp_sth->out_params_av = newAV();
+PerlIO_printf(DBILOGFP, "/n/n/n hellow /n/n/John imp_sth->out_params_av
=%d",av_len(imp_sth->out_params_av));
+
av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
+PerlIO_printf(DBILOGFP, "/n/n/n hellow /n/n/John len =imp_sth->out_params_av
=%d",av_len(imp_sth->out_params_av));
}
@@ -2610,7 +2613,7 @@
char *note = "";
/* XXX doesn't check arcode for error, caller is expected to */
debug=15;
-PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1\n");
+PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1 sv=%s\n",neatsvpv(sv,0));
if (phs->indp == 0) { /* is okay */
PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 2\n");
@@ -2626,22 +2629,29 @@
}
if (SvPVX(sv)) {
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 4\n");
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1a
sv=%s\n",neatsvpv(sv,0));
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 4\n");
SvCUR_set(sv, phs->alen);
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1b
sv=%s\n",neatsvpv(sv,0));
+
*SvEND(sv) = '\0';
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1c
sv=%s\n",neatsvpv(sv,0));
+
SvPOK_only_UTF8(sv);
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1d
sv=%s\n",neatsvpv(sv,0));
+
}
else { /* shouldn't happen */
debug = 2;
note = " [placeholder has no data buffer]";
}
- if (debug >= 2)
+ if (debug <= 200)
PerlIO_printf(DBILOGFP, " out %s = %s (arcode %d, ind
%d, len %d)%s\n",
phs->name, neatsvpv(sv,0), phs->arcode, phs->indp,
phs->alen, note);
}
- else
+ else {
if (phs->indp > 0 || phs->indp == -2) { /* truncated */
PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 5\n");
@@ -2656,22 +2666,25 @@
debug = 2;
note = " [placeholder has no data buffer]";
}
- if (debug >= 2)
+ if (debug <= 200)
PerlIO_printf(DBILOGFP,
" out %s = %s\t(TRUNCATED from %d to %ld,
arcode %d)%s\n",
phs->name, neatsvpv(sv,0), phs->indp,
(long)phs->alen, phs->arcode, note);
}
- else
+ else {
if (phs->indp == -1) { /* is NULL */
(void)SvOK_off(phs->sv);
- if (debug >= 2)
+ if (debug <= 200)
PerlIO_printf(DBILOGFP,
" out %s = undef
(NULL, arcode %d)\n",
phs->name, phs->arcode);
- }
- else
- croak("panic dbd_phs_sv_complete: %s
bad indp %d, arcode %d", phs->name, phs->indp, phs->arcode);
+ }
+ else {
+ croak("panic dbd_phs_sv_complete: %s bad indp
%d, arcode %d", phs->name, phs->indp, phs->arcode);
debug=0;
+ }
+ }
+ }
}
void
dbd_phs_avsv_complete(phs_t *phs, I32 index, I32 debug)
@@ -2679,6 +2692,7 @@
dTHX;
AV *av = (AV*)SvRV(phs->sv);
SV *sv = *av_fetch(av, index, 1);
+ PerlIO_printf(DBILOGFP, " dbd_phs_avsv_complete
neatsvpv(sv,0)=%s\n",neatsvpv(sv,0));
dbd_phs_sv_complete(phs, sv, 0);
/* if (debug <= 2)*/
PerlIO_printf(DBILOGFP, " dbd_phs_avsv_complete out '%s'[%ld] = %s
(arcode %d, ind %d, len %d)\n",
@@ -2702,8 +2716,8 @@
sword status;
int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
+ if (debug >= 200)
+ PerlIO_printf(DBILOGFP, "\n\n dbd_st_execute %s (out%d, lob%d)...\n",
oci_stmt_type_name(imp_sth->stmt_type), outparams,
imp_sth->has_lobs);
/* Don't attempt execute for nested cursor. It would be meaningless,
@@ -2750,25 +2764,25 @@
|| SvPVX(sv) != phs->progv
|| (SvPOK(sv) && SvCUR(sv) > UB2MAXVAL)
) {
- if (!dbd_rebind_ph(sth, imp_sth, phs))
- croak("Can't rebind placeholder %s", phs->name);
- }
- else {
- /* String may have grown or shrunk since it was bound */
- /* so tell Oracle about it's current length */
- ub2 prev_alen = phs->alen;
- phs->alen = (SvOK(sv)) ? SvCUR(sv) + phs->alen_incnull :
0+phs->alen_incnull;
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
+ if (!dbd_rebind_ph(sth, imp_sth, phs))
+ croak("Can't rebind placeholder %s", phs->name);
+ }
+ else {
+ /* String may have grown or shrunk since it was
bound */
+ /* so tell Oracle about it's current length
*/
+ ub2 prev_alen = phs->alen;
+ phs->alen = (SvOK(sv)) ? SvCUR(sv) +
phs->alen_incnull : 0+phs->alen_incnull;
+ if (debug >= 2)
+ PerlIO_printf(DBILOGFP,
" with %s = '%.*s' (len %ld(%ld)/%ld, indp %d,
otype %d, ptype %d)\n",
- phs->name, (int)phs->alen,
- (phs->indp == -1) ? "" : SvPVX(sv),
- (long)phs->alen, (long)prev_alen, (long)phs->maxlen,
phs->indp,
- phs->ftype, (int)SvTYPE(sv));
+ phs->name, (int)phs->alen,
+ (phs->indp == -1) ? "" : SvPVX(sv),
+ (long)phs->alen, (long)prev_alen,
(long)phs->maxlen, phs->indp,
+ phs->ftype, (int)SvTYPE(sv));
}
- }
+ }
}
-PerlIO_printf(DBILOGFP, "\n\n\n OCIStmtExecute_log_stat 1 next\n");
+ PerlIO_printf(DBILOGFP, "\n\n\n OCIStmtExecute_log_stat 1 next\n");
OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
(ub4)(is_select ? 0 : 1),
@@ -2778,53 +2792,62 @@
? OCI_COMMIT_ON_SUCCESS : OCI_DEFAULT),
status);
+ PerlIO_printf(DBILOGFP, "\n\n\n NONARRAY BIN D1 next\n");
if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO
etc */
/* we record the error even for OCI_SUCCESS_WITH_INFO */
- oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
+ oci_error(sth, imp_sth->errhp, status,
ora_sql_error(imp_sth,"OCIStmtExecute"));
/* but only bail out here if not OCI_SUCCESS_WITH_INFO */
if (status != OCI_SUCCESS_WITH_INFO)
return -2;
}
if (is_select) {
- DBIc_ACTIVE_on(imp_sth);
- DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */
- row_count = 0;
+ DBIc_ACTIVE_on(imp_sth);
+ DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */
+ row_count = 0;
}
else {
- 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);
}
+ PerlIO_printf(DBILOGFP, "\n\n\n NONARRAY BIN D2 next\n");
- if (debug >= 2) {
- ub2 sqlfncode;
- OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE,
status);
- PerlIO_printf(DBILOGFP,
- " dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n",
- oci_stmt_type_name(imp_sth->stmt_type),
- oci_status_name(status),
- (long)row_count, sqlfncode, imp_sth->has_inout_params);
+ if (debug <= 200) {
+ ub2 sqlfncode;
+ OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0,
OCI_ATTR_SQLFNCODE, status);
+ PerlIO_printf(DBILOGFP,
+ " dbd_st_execute %s returned (%s, rpc%ld, fn%d,
out%d)\n",
+ oci_stmt_type_name(imp_sth->stmt_type),
+ oci_status_name(status),
+ (long)row_count, sqlfncode, imp_sth->has_inout_params);
}
+ PerlIO_printf(DBILOGFP, "\n\n\n NONARRAY BIN D3 next\n");
if (is_select && !imp_sth->done_desc) {
/* describe and allocate storage for results (if any needed) */
if (!dbd_describe(sth, imp_sth))
return -2; /* dbd_describe already called oci_error() */
}
+
if (imp_sth->has_lobs && imp_sth->stmt_type != OCI_STMT_SELECT) {
- if (!post_execute_lobs(sth, imp_sth, row_count))
- return -2; /* post_insert_lobs already called oci_error() */
- }
+ if (!post_execute_lobs(sth, imp_sth, row_count))
+ return -2; /* post_insert_lobs already called oci_error()
*/
+ }
if (outparams) { /* check validity of bound output SV's */
- int i = outparams;
- while(--i >= 0) {
- /* phs->alen has been updated by Oracle to hold the length of the
result */
- phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
- SV *sv = phs->sv;
- if (debug >= 2) {
- PerlIO_printf(DBILOGFP,
- "dbd_st_execute(): Analyzing inout parameter '%s'\n",
- phs->name);
+ int i = outparams;
+ PerlIO_printf(DBILOGFP, "\n\n\n NONARRAY BIN D4 next\n");
+
+ while(--i >= 0) {
+
+ /* phs->alen has been updated by Oracle to hold the length
of the result */
+ phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
+ PerlIO_printf(DBILOGFP, "\n\n\n
NONARRAY BIN D5 i=%d next\n",i);
+
+ if (debug <= 200) {
+ PerlIO_printf(DBILOGFP,
+ "dbd_st_execute(): Analyzing inout parameter
'%s'\n",
+ phs->name);
}
if( phs->ftype == ORA_VARCHAR2_TABLE ){
dbd_phs_ora_varchar2_table_fixup_after_execute(phs);
@@ -2836,19 +2859,19 @@
}
if (phs->out_prepost_exec) {
- if (!phs->out_prepost_exec(sth, imp_sth, phs, 0))
- return -2; /* out_prepost_exec already called ora_error()
*/
- }
- else
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- AV *av = (AV*)SvRV(sv);
- I32 avlen = AvFILL(av);
- if (avlen >= 0)
- (phs, avlen, debug);
+ if (!phs->out_prepost_exec(sth, imp_sth, phs, 0))
+ return -2; /* out_prepost_exec already called
ora_error() */
}
else
- dbd_phs_sv_complete(phs, sv, debug);
- }
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ AV *av = (AV*)SvRV(sv);
+ I32 avlen = AvFILL(av);
+ if (avlen >= 0)
+ dbd_phs_avsv_complete(phs, avlen, debug);
+ }
+ else
+ dbd_phs_sv_complete(phs, sv, debug);
+ }
}
return row_count; /* row count (0 will be returned as "0E0") */
@@ -2898,6 +2921,8 @@
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 */
@@ -2939,9 +2964,9 @@
STRLEN len;
int outparams = (imp_sth->out_params_av) ?
AvFILL(imp_sth->out_params_av)+1 : 0;
-
+PerlIO_printf(DBILOGFP, "ora_st_execute_array 2Av_Len
imp_sth->out_params_av=%d\n",av_len(imp_sth->out_params_av));
/* if (debug <= 2)*/
- PerlIO_printf(DBILOGFP, " ora_st_execute_array %s count=%d (%s %s
%s)...\n",
+ PerlIO_printf(DBILOGFP, " \n\n\n ora_st_execute_array %s count=%d (%s %s
%s)...\n",
oci_stmt_type_name(imp_sth->stmt_type), exe_count,
neatsvpv(tuples,0), neatsvpv(tuples_status,0),
neatsvpv(columns, 0));
@@ -3004,7 +3029,9 @@
param_count=DBIc_NUM_PARAMS(imp_sth);
phs = safemalloc(param_count*sizeof(*phs));
memset(phs, 0, param_count*sizeof(*phs));
+
PerlIO_printf(DBILOGFP, "exe_count = %d\n",exe_count);
+
for(j = 0; (unsigned int) j < exe_count; j++) {
PerlIO_printf(DBILOGFP, "j = %d\n",j);
@@ -3095,16 +3122,29 @@
if (outparams){
+PerlIO_printf(DBILOGFP, "\n\n\n\n i=%d",i);
-int i = outparams;
+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, "\n\n\n\n outparams=%d\n",outparams);
+
+ PerlIO_printf(DBILOGFP, " SvTYPE(sv)=%d\n",SvTYPE(SvRV(sv)));
if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ int j;
AV *av = (AV*)SvRV(sv);
I32 avlen = AvFILL(av);
+ PerlIO_printf(DBILOGFP, "\n\n\n\n avlen=%d\n",avlen);
+ PerlIO_printf(DBILOGFP, "\n\n\n\n av_len(av) =%d\n",av_len(av));
+
+ /*I32 avlen = AvFILL(av);*/
+ for (j=0;j<=av_len(av);j++){
+ SV *sv2 = *av_fetch(av, j, 1);
+ PerlIO_printf(DBILOGFP, "\n\n\n\n
neatsvpv(sv2,1)=%s\n",neatsvpv(sv2,1));
+ }
if (avlen >= 0)
dbd_phs_avsv_complete(phs, avlen, debug);
}
Modified: dbd-oracle/branches/array_inout/oci8.c
==============================================================================
--- dbd-oracle/branches/array_inout/oci8.c (original)
+++ dbd-oracle/branches/array_inout/oci8.c Sun Feb 3 18:23:24 2008
@@ -376,7 +376,7 @@
SV **sv_p;
if( bindp ) { /* For GCC not to warn on unused parameter*/ }
-PerlIO_printf(DBILOGFP, " in dbd_phs_in\n");
+PerlIO_printf(DBILOGFP, " in dbd_phs_in %d\n",index);
/* Check for bind values supplied by tuple array. */
tuples_av = phs->imp_sth->bind_tuples;
if(tuples_av) {
@@ -421,7 +421,7 @@
phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp,
(phs->desc_h) ? " via descriptor" : "");
if (!tuples_av && (index > 0 || iter > 0))
- croak("Arrays and multiple iterations not currently supported by
DBD::Oracle (in %d/%d)", index,iter);
+ croak(" mehere Arrays and multiple iterations not currently supported
by DBD::Oracle (in %d/%d)", index,iter);
return OCI_CONTINUE;
}
@@ -480,6 +480,7 @@
phs_t *phs = (phs_t*)octxp; /* context */
/*imp_sth_t *imp_sth = phs->imp_sth;*/
+PerlIO_printf(DBILOGFP, " values in
iter=%d,index=%d,bufpp=%d,alenpp=%d,piecep=%d,indpp=%d,rcodeppt=%d
1\n",iter,index,bufpp,alenpp,piecep,indpp,rcodepp);
if( bindp ) { /* For GCC not to warn on unused parameter */ }
@@ -494,19 +495,32 @@
} else {
SV *sv = phs->sv;
- PerlIO_printf(DBILOGFP, " in dbd_phs_out 3
SvTYPE(sv)=%d\n",SvTYPE(sv));
+ PerlIO_printf(DBILOGFP, " in dbd_phs_out 3
SvTYPE(sv)=%d\n",sv);
+ PerlIO_printf(DBILOGFP, " in dbd_phs_out 3a index=%d\n",index);
if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- PerlIO_printf(DBILOGFP, " in dbd_phs_out 4\n");
- if (index > 0) /* finish-up handling previous element
*/
+ AV *av = (AV*)SvRV(sv);
+ SV *sv2 = *av_fetch((AV*)SvRV(sv), (IV)index, 1);
+ PerlIO_printf(DBILOGFP, " I are a array reff (good) so lod data at
the point av_len(av)=%d\n",av_len(av));
+ /* if (iter >= 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);
- PerlIO_printf(DBILOGFP, " in dbd_phs_out 5
sv=%s\n",neatsvpv(sv,0));
- if (!SvOK(sv))
+*/
+
+
+ PerlIO_printf(DBILOGFP, " pointer to sv =%s\n",neatsvpv(sv2,1));
+ *bufpp = SvGROW(sv2, (size_t)(((phs->maxlen < 28) ? 28 :
phs->maxlen)+1)/*for null*/);
+ phs->alen = SvLEN(sv2); /* max buffer size now,
actual data len later */
+
+/*ok here is the rub I have to add a new values to this array*/
+ if (!SvOK(sv))
sv_setpv(sv,"");
+ } else {
+
+ *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 = 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 */
+ PerlIO_printf(DBILOGFP, " bufpp is the bffer where the data is
sv=%s\n",sv);
+
}
*alenpp = &phs->alen;
*indpp = &phs->indp;
@@ -516,7 +530,7 @@
phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), *piecep,
(phs->desc_h) ? " via descriptor" : "");
if (iter > 0)
- warn("Multiple iterations not currently supported by DBD::Oracle (out
%d/%d)", index,iter);
+ warn("mr here Multiple iterations not currently supported by
DBD::Oracle (out %d/%d)", index,iter);
*piecep = OCI_ONE_PIECE;
return OCI_CONTINUE;
}
