Author: byterock
Date: Mon Feb 4 13:57:04 2008
New Revision: 10684
Modified:
dbd-oracle/branches/array_inout/Oracle.pm
dbd-oracle/branches/array_inout/Oracle.xs
dbd-oracle/branches/array_inout/dbdimp.c
dbd-oracle/branches/array_inout/oci8.c
Log:
cleaning up code getting ready to patch
Modified: dbd-oracle/branches/array_inout/Oracle.pm
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.pm (original)
+++ dbd-oracle/branches/array_inout/Oracle.pm Mon Feb 4 13:57:04 2008
@@ -858,7 +858,6 @@
sub bind_param_inout_array {
my $sth = shift;
my ($p_id, $value_array,$maxlen, $attr) = @_;
- warn "john in PM bind_param_inout_array\n";
return $sth->set_err($DBI::stderr, "Value for parameter $p_id must be
an arrayref, not a ".ref($value_array))
if defined $value_array and ref $value_array and ref $value_array ne
'ARRAY';
@@ -891,7 +890,6 @@
my $tuple_batch_status;
my $dbh = $sth->{Database};
my $batch_size =($dbh->{'ora_array_chunk_size'}||= 1000);
-warn "john in PM\n";
if(defined($tuple_status)) {
@$tuple_status = ();
$tuple_batch_status = [ ];
@@ -903,7 +901,6 @@
push @tuple_batch, [ @{$fetch_tuple_sub->() || last} ];
}
last unless @tuple_batch;
-warn "john in PM\n";
my $res = ora_execute_array($sth,
[EMAIL PROTECTED],
scalar(@tuple_batch),
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 13:57:04 2008
@@ -91,34 +91,25 @@
IV sql_type = 0;
D_imp_sth(sth);
SV *av_value;
- PerlIO_printf(DBILOGFP, " in bind_param_inout_array\n");
-
if (!SvROK(av_ref) || SvTYPE(SvRV(av_ref)) != SVt_PVAV)
croak("bind_param_inout_array needs a reference to a array value");
-
av_value = av_ref;
-
if (SvREADONLY(av_value))
croak("Modification of a read-only value attempted");
-
if (attribs) {
if (SvNIOK(attribs)) {
- PerlIO_printf(DBILOGFP, " in attribs1\n");
sql_type = SvIV(attribs);
attribs = Nullsv;
}
else {
SV **svp;
- PerlIO_printf(DBILOGFP, " in attribs2\n");
DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type);
}
}
- PerlIO_printf(DBILOGFP," on john param=%d, av_value=%d,
sql_type=%d,attribs=%d ,maxlen=%d \n",param,av_value,sql_type,attribs,maxlen);
-
ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE,
maxlen)
? &sv_yes : &sv_no;
- }
+}
void
ora_fetch(sth)
@@ -368,9 +359,7 @@
/* if locator is CLOB and data is UTF8 and not in bytes pragma */
/* if (0 && SvUTF8(dest_sv) && !IN_BYTES) { amtp = sv_len_utf8(dest_sv); }
*/
/* added by lab: */
- PerlIO_printf(DBILOGFP, " john 0 OCILobCharSetForm_log_stat %d", status);
OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator,
&csform, status );
- PerlIO_printf(DBILOGFP, " john 1 OCILobCharSetForm_log_stat %d", status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
dest_sv = &sv_undef;
@@ -380,7 +369,6 @@
&amtp, (ub4)offset, /* offset starts at 1 */
bufp, (ub4)bufp_len,
0, 0, (ub2)0, csform, status);
- PerlIO_printf(DBILOGFP, " john 2 OCILobRead_log_stat %d", status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobRead");
dest_sv = &sv_undef;
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 13:57:04 2008
@@ -2412,9 +2412,6 @@
phs_t *phs;
/* check if placeholder was passed as a number */
-
-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);
@@ -2450,7 +2447,7 @@
if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */
croak("Can't bind ``lvalue'' mode scalar as inout parameter
(currently)");
- if (DBIS->debug <= 2) {
+ if (DBIS->debug >= 2) {
PerlIO_printf(DBILOGFP, "dbd_bind_ph(): bind %s <== %s (type
%ld",
name, neatsvpv(newvalue,0), (long)sql_type);
if (is_inout)
@@ -2458,7 +2455,6 @@
(long)newvalue, (long)maxlen);
if (attribs)
PerlIO_printf(DBILOGFP, ", attribs: %s",
neatsvpv(attribs,0));
-
PerlIO_printf(DBILOGFP, ")\n");
}
@@ -2476,16 +2472,10 @@
if (is_inout) {
/* phs->sv assigned in the code below */
++imp_sth->has_inout_params;
- PerlIO_printf(DBILOGFP, "John s 2
imp_sth->has_inout_params=%d\n ",imp_sth->has_inout_params);
/* build array of phs's so we can deal with out vars fast
*/
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));
-
}
/*
@@ -2505,13 +2495,10 @@
if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_type",8, 0)) !=
NULL) {
int ora_type = SvIV(*svp);
- PerlIO_printf(DBILOGFP, "John s 2c
ora_type=%d\n",ora_type);
-
if (!oratype_bind_ok(ora_type))
croak("Can't bind %s, ora_type %d not
supported by DBD::Oracle", phs->name, ora_type);
if (sql_type)
croak("Can't specify both TYPE (%d) and
ora_type (%d) for %s", sql_type, ora_type, phs->name);
-
phs->ftype = ora_type;
}
if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_field",9, 0))
!= NULL) {
@@ -2536,9 +2523,6 @@
if (sql_type)
phs->ftype = ora_sql_type(imp_sth, phs->name,
(int)sql_type);
-
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() 2d =phs->ftype=%d\n",phs->ftype);
-
/* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
if (phs->ftype==102)
phs->ftype = 116;
@@ -2562,14 +2546,10 @@
PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 3\n");
}
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 4 %d\n",newvalue);
/* Array binding is supported for a limited number of data types. */
if( SvROK(newvalue) ){
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 5\n");
-
if( SvTYPE(SvRV(newvalue))!=SVt_PVAV ){
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 6\n");
/* if( (phs->ftype == ORA_VARCHAR2_TABLE) ||
(phs->ftype == ORA_NUMBER_TABLE)) {
@@ -2591,14 +2571,11 @@
sv_pvn_force(phs->sv, &na);
}
else if (newvalue != phs->sv) {
- PerlIO_printf(DBILOGFP, "is a in_out %d 7\n",phs->sv);
-
if (phs->sv)
SvREFCNT_dec(phs->sv);
phs->sv = SvREFCNT_inc(newvalue); /* point to live var
*/
}
-PerlIO_printf(DBILOGFP, "end phs->sv= %d\n",phs->sv);
return dbd_rebind_ph(sth, imp_sth, phs);
}
@@ -2613,13 +2590,10 @@
char *note = "";
/* XXX doesn't check arcode for error, caller is expected to */
debug=15;
-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");
if (phs->is_inout && phs->alen == SvLEN(sv)) {
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 3\n");
/* if the placeholder has not been assigned to then
phs->alen */
/* is left untouched: still set to SvLEN(sv). If we use
that */
@@ -2629,37 +2603,22 @@
}
if (SvPVX(sv)) {
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1a
sv=%s\n",neatsvpv(sv,0));
-
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 4
phs->alen=%d\n",phs->alen);
-
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 <= 200)
+ if (debug >= 2)
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 {
if (phs->indp > 0 || phs->indp == -2) { /* truncated */
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 5\n");
-
- if (SvPVX(sv)) {
- PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete
6\n");
-
+ if (SvPVX(sv)) {
SvCUR_set(sv, phs->alen);
*SvEND(sv) = '\0';
SvPOK_only_UTF8(sv);
@@ -2668,7 +2627,7 @@
debug = 2;
note = " [placeholder has no data buffer]";
}
- if (debug <= 200)
+ if (debug >= 2)
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);
@@ -2676,7 +2635,7 @@
else {
if (phs->indp == -1) { /* is NULL */
(void)SvOK_off(phs->sv);
- if (debug <= 200)
+ if (debug >= 2)
PerlIO_printf(DBILOGFP,
" out %s = undef
(NULL, arcode %d)\n",
phs->name, phs->arcode);
@@ -2694,11 +2653,10 @@
dTHX;
AV *av = (AV*)SvRV(phs->sv);
SV *sv = *av_fetch(av, index, 1);
- PerlIO_printf(DBILOGFP, " dbd_phs_avsv_complete neasv=%s\n",sv);
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",
- phs->name, (long)index, neatsvpv(sv,0), phs->arcode, phs->indp,
phs->alen);
+ 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);
}
@@ -2718,91 +2676,89 @@
sword status;
int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
- if (debug >= 200)
- PerlIO_printf(DBILOGFP, "\n\n dbd_st_execute %s (out%d, lob%d)...\n",
+ if (debug >= 2)
+ PerlIO_printf(DBILOGFP, "\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,
and Oracle code has been seen to core dump */
if (imp_sth->nested_cursor) {
- oci_error(sth, NULL, OCI_ERROR,
- "explicit execute forbidden for nested cursor");
- return -2;
+ oci_error(sth, NULL, OCI_ERROR,
+ "explicit execute forbidden for nested cursor");
+ return -2;
}
if (outparams) { /* check validity of bind_param_inout SV's */
- int i = outparams;
- while(--i >= 0) {
- phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
- SV *sv = phs->sv;
+ int i = outparams;
+ while(--i >= 0) {
+ phs_t *phs =
(phs_t*)(void*)SvPVX(AvARRAY(imp_sth->out_params_av)[i]);
+ SV *sv = phs->sv;
/* Make sure we have the value in string format. Typically a number
*/
/* will be converted back into a string using the same bound buffer
*/
/* so the progv test below will not trip. */
/* is the value a null? */
- phs->indp = (SvOK(sv)) ? 0 : -1;
+ phs->indp = (SvOK(sv)) ? 0 : -1;
- if (phs->out_prepost_exec) {
- if (!phs->out_prepost_exec(sth, imp_sth, phs, 1))
- return -2; /* out_prepost_exec already called ora_error()
*/
- }
- else
- if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " with %s = [] (len %ld/%ld, indp %d, otype %d,
ptype %d)\n",
- phs->name,
- (long)phs->alen, (long)phs->maxlen, phs->indp,
- phs->ftype, (int)SvTYPE(sv));
- av_clear((AV*)SvRV(sv));
- }
- else
+ if (phs->out_prepost_exec) {
+ if (!phs->out_prepost_exec(sth, imp_sth, phs, 1))
+ return -2; /* out_prepost_exec already called
ora_error() */
+ }
+ else
+ if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
+ if (debug >= 2)
+ PerlIO_printf(DBILOGFP,
+ " with %s = [] (len %ld/%ld, indp %d,
otype %d, ptype %d)\n",
+ phs->name,
+ (long)phs->alen, (long)phs->maxlen, phs->indp,
+ phs->ftype, (int)SvTYPE(sv));
+ av_clear((AV*)SvRV(sv));
+ }
+ else
/* Some checks for mutated storage since we pointed oracle at it.
*/
- if (SvTYPE(sv) != phs->sv_type
- || (SvOK(sv) && !SvPOK(sv))
+ if (SvTYPE(sv) != phs->sv_type
+ || (SvOK(sv) && !SvPOK(sv))
/* SvROK==!SvPOK so cursor (SQLT_CUR) handle will call
dbd_rebind_ph */
/* that suits us for now */
- || 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,
- " 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));
- }
- }
- }
- 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),
- 0, 0, 0,
- /* we don't AutoCommit on select so LOB locators work */
- (ub4)((DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select)
- ? OCI_COMMIT_ON_SUCCESS : OCI_DEFAULT),
- status);
+ || 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,
+ " 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));
+ }
+ }
+ }
- PerlIO_printf(DBILOGFP, "\n\n\n NONARRAY BIN D1 next\n");
+ OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+ (ub4)(is_select ? 0 : 1),
+ 0, 0, 0,
+ /* we don't AutoCommit on select so LOB locators work */
+ (ub4)((DBIc_has(imp_dbh,DBIcf_AutoCommit) && !is_select)
+ ? OCI_COMMIT_ON_SUCCESS : OCI_DEFAULT),
+ status);
- if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO
etc */
+ 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 (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) */
@@ -2811,9 +2767,8 @@
else {
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 <= 200) {
+ if (debug >= 2) {
ub2 sqlfncode;
OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0,
OCI_ATTR_SQLFNCODE, status);
PerlIO_printf(DBILOGFP,
@@ -2822,7 +2777,6 @@
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) */
@@ -2837,16 +2791,11 @@
if (outparams) { /* check validity of bound output SV's */
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) {
+ if (debug >= 2) {
PerlIO_printf(DBILOGFP,
"dbd_st_execute(): Analyzing inout parameter
'%s'\n",
phs->name);
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 13:57:04 2008
@@ -317,19 +317,20 @@
OCIStmtPrepare_log_stat(imp_sth->stmhp, imp_sth->errhp,
(text*)imp_sth->statement, (ub4)strlen(imp_sth->statement),
oparse_lng, OCI_DEFAULT, status);
+
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare");
- OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare");
+ OCIHandleFree_log_stat(imp_sth->stmhp, OCI_HTYPE_STMT, status);
+ return 0;
}
OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE,
status);
- if (DBIS->debug <= 3)
- PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s (pl%d, auto_lob%d,
check_sql%d)\n",
- oci_stmt_type_name(imp_sth->stmt_type),
- oparse_lng, imp_sth->auto_lob, ora_check_sql);
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s (pl%d,
auto_lob%d, check_sql%d)\n",
+ oci_stmt_type_name(imp_sth->stmt_type),
+ oparse_lng, imp_sth->auto_lob, ora_check_sql);
DBIc_IMPSET_on(imp_sth);
@@ -376,51 +377,50 @@
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 ? (int)iter :
phs->idx, 0);
- av = (AV*)SvRV(*sv_p);
- sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx : (int)iter, 0);
-
- sv = *sv_p;
- if(SvOK(sv)) {
- *bufpp = SvPV(sv, phs_len);
- phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
- phs->indp = 0;
- } else {
- *bufpp = SvPVX(sv);
- phs->alen = 0;
- phs->indp = -1;
- }
- }
- else
- if (phs->desc_h) {
- *bufpp = phs->desc_h;
- phs->alen = 0;
- phs->indp = 0;
- }
- else
- if (SvOK(phs->sv)) {
- *bufpp = SvPV(phs->sv, phs_len);
- phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;;
- phs->indp = 0;
- }
+ /* Check for bind values supplied by tuple array. */
+ tuples_av = phs->imp_sth->bind_tuples;
+ if(tuples_av) {
+ /* NOTE: we already checked the validity in
ora_st_bind_for_array_exec(). */
+ sv_p = av_fetch(tuples_av, phs->imp_sth->rowwise ?
(int)iter : phs->idx, 0);
+ av = (AV*)SvRV(*sv_p);
+ sv_p = av_fetch(av, phs->imp_sth->rowwise ? phs->idx :
(int)iter, 0);
+ sv = *sv_p;
+ if(SvOK(sv)) {
+ *bufpp = SvPV(sv, phs_len);
+ phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;
+ phs->indp = 0;
+ } else {
+ *bufpp = SvPVX(sv);
+ phs->alen = 0;
+ phs->indp = -1;
+ }
+ }
+ else
+ if (phs->desc_h) {
+ *bufpp = phs->desc_h;
+ phs->alen = 0;
+ phs->indp = 0;
+ }
+ else
+ if (SvOK(phs->sv)) {
+ *bufpp = SvPV(phs->sv, phs_len);
+ phs->alen = (phs->alen_incnull) ? phs_len+1 : phs_len;;
+ phs->indp = 0;
+ }
else {
- *bufpp = SvPVX(phs->sv); /* not actually used? */
- phs->alen = 0;
- phs->indp = -1;
+ *bufpp = SvPVX(phs->sv); /* not actually used? */
+ phs->alen = 0;
+ phs->indp = -1;
}
*alenp = phs->alen;
*indpp = &phs->indp;
*piecep = OCI_ONE_PIECE;
if (DBIS->debug >= 3)
- PerlIO_printf(DBILOGFP, " in '%s' [%lu,%lu]: len %2lu, ind
%d%s\n",
- 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(" mehere Arrays and multiple iterations not currently supported
by DBD::Oracle (in %d/%d)", index,iter);
+ PerlIO_printf(DBILOGFP, " in '%s' [%lu,%lu]: len %2lu,
ind %d%s\n",
+ 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);
return OCI_CONTINUE;
}
@@ -478,45 +478,17 @@
dTHX;
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 */ }
-PerlIO_printf(DBILOGFP, " in dbd_phs_out 1\n");
-
if (phs->desc_h) { /* a descriptor if present (LOBs etc)*/
*bufpp = phs->desc_h;
phs->alen = 0;
-PerlIO_printf(DBILOGFP, " in dbd_phs_out 2\n");
} else {
SV *sv = phs->sv;
- PerlIO_printf(DBILOGFP, " in dbd_phs_out 3
SvTYPE(sv)=%d\n",sv);
- PerlIO_printf(DBILOGFP, " in dbd_phs_out 3a iter=%d\n",iter);
-
if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
-
-/* dbd_phs_avsv_complete(phs, (I32)iter-1, DBIS->debug);
-*/
- sv = *av_fetch((AV*)SvRV(sv), (IV)iter, 1);
- /* SV **sv_p;
- AV *av = (AV*)SvRV(sv);
- av_push(av,newSVpv("",0));
- sv_p = av_fetch(av, (IV)iter, 1);
- PerlIO_printf(DBILOGFP, " av=%d\n",av);
- PerlIO_printf(DBILOGFP, " I are a array reff (good)
sv_p=%d\n",sv_p);
-/* *bufpp = SvPV_nolen(*sv_p);
-
- *bufpp = SvGROW(*sv_p, (size_t)(((phs->maxlen < 28) ?
28 : phs->maxlen)+1)/*for null);
- phs->alen = SvLEN(*sv_p); /* max buffer size now,
actual data len later
- if (iter >= 0) /* finish-up handling previous element
- dbd_phs_avsv_complete(phs, (I32)index-1,
DBIS->debug);
-/*ok here is the rub I have to add a new values to this array*/
-
-
+ sv = *av_fetch((AV*)SvRV(sv), (IV)iter, 1);
if (!SvOK(sv))
sv_setpv(sv,"");
}
@@ -524,18 +496,14 @@
*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=%d\n",sv);
-
}
*alenpp = &phs->alen;
*indpp = &phs->indp;
*rcodepp= &phs->arcode;
- /* if (DBIS->debug <= 3)*/
- PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld, piece
%d%s\n",
- phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), *piecep,
- (phs->desc_h) ? " via descriptor" : "");
- if (iter > 0)
- warn("mr here Multiple iterations not currently supported by
DBD::Oracle (out %d/%d)", index,iter);
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld,
piece %d%s\n",
+ phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen),
*piecep,
+ (phs->desc_h) ? " via descriptor" : "");
*piecep = OCI_ONE_PIECE;
return OCI_CONTINUE;
}
