Author: byterock
Date: Fri Feb 1 14:13:32 2008
New Revision: 10678
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:
well close to getting it only getting one at a time
Modified: dbd-oracle/branches/array_inout/Oracle.pm
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.pm (original)
+++ dbd-oracle/branches/array_inout/Oracle.pm Fri Feb 1 14:13:32 2008
@@ -857,11 +857,33 @@
sub bind_param_inout_array {
my $sth = shift;
- my ($p_num, $value_array,$maxlen, $attr) = @_;
- ora_bind_param_inout_array($sth, $p_num, $value_array,$maxlen, $attr);
-
+ 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';
+
+ return $sth->set_err($DBI::stderr, "Can't use named placeholder '$p_id'
for non-driver supported bind_param_inout_array")
+ unless DBI::looks_like_number($p_id); # because we rely on
execute(@ary) here
+
+ return $sth->set_err($DBI::stderr, "Placeholder '$p_id' is out of
range")
+ if $p_id <= 0; # can't easily/reliably test for too big
+
+ # get/create arrayref to hold params
+ my $hash_of_arrays = $sth->{ParamArrays} ||= { };
+
+ $$hash_of_arrays{$p_id} = $value_array;
+ return ora_bind_param_inout_array($sth, $p_id, $value_array,$maxlen,
$attr);
+ 1;
+
}
+
+ my $sth = shift;
+ my ($p_id, $value_array, $attr) = @_;
+
+
+
+
sub execute_for_fetch {
my ($sth, $fetch_tuple_sub, $tuple_status) = @_;
my $row_count = 0;
@@ -869,7 +891,7 @@
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 = [ ];
@@ -881,6 +903,7 @@
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 Fri Feb 1 14:13:32 2008
@@ -177,6 +177,7 @@
/* 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 Fri Feb 1 14:13:32 2008
@@ -986,7 +986,6 @@
char *style="", *laststyle=Nullch;
STRLEN namelen;
phs_t *phs;
-PerlIO_printf(DBILOGFP, " pere parse\n");
/* allocate room for copy of statement with spare capacity */
/* for editing '?' or ':1' into ':p1' so we can use obndrv. */
/* XXX should use SV and append to it */
@@ -2023,19 +2022,18 @@
int at_exec = 0;
at_exec = (phs->desc_h == NULL);
-PerlIO_printf(DBILOGFP, "\n\nin dbd_rebind_ph_char()
SvPOK(phs->sv)=%d\n",SvPOK(phs->sv));
+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))
sv_2pv(phs->sv, &na);
}
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)*/;
+ if(SvUPGRADE(phs->sv, SVt_PV)){ PerlIO_printf(DBILOGFP, "14\n");} /*
For gcc not to warn on unused result)*/;
}
+
if (DBIS->debug <= 2) {
char *val = neatsvpv(phs->sv,0);
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (1): bind %s <==
%.1000s (", phs->name, val);
@@ -2053,49 +2051,58 @@
/* just copy the value & length over and not rebind. */
if (phs->is_inout) { /* XXX */
- PerlIO_printf(DBILOGFP, " dbd_rebind_ph_char 2\n");
+ if (SvREADONLY(phs->sv))
+ croak("Modification of a read-only value attempted");
+ if (imp_sth->ora_pad_empty)
+ croak("Can't use ora_pad_empty with bind_param_inout");
+ if (SvTYPE(phs->sv)!=SVt_RV || !at_exec) {
+ STRLEN min_len = (phs->ftype != 96) ? 28 : 0;
+
- if (SvREADONLY(phs->sv))
- croak("Modification of a read-only value attempted");
- if (imp_sth->ora_pad_empty)
- croak("Can't use ora_pad_empty with bind_param_inout");
- if (1 || !at_exec) {
- PerlIO_printf(DBILOGFP, "in dbd_rebind_ph_char()
SvTYPE(SvRV(phs->sv))=%d\n",SvTYPE(SvRV(phs->sv)));
+ /* if (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) {*/
- if (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) {
-
/* if not an array ref then do this */
/* ensure room for result, 28 is magic number (see sv_2pv)
*/
/* don't apply 28 char min to CHAR types - probably shouldn't
*/
/* apply it anywhere really, trying to be too helpful.
*/
- STRLEN min_len = (phs->ftype != 96) ? 28 : 0;
+
/* phs->sv _is_ the real live variable, it may 'mutate' later
*/
/* pre-upgrade to high'ish type to reduce risk of SvPVX
realloc/move */
(void)SvUPGRADE(phs->sv, SVt_PVNV);
SvGROW(phs->sv, (STRLEN)(((unsigned int) phs->maxlen < min_len) ?
min_len : (unsigned int) phs->maxlen)+1/*for null*/);
- }
+ /* }*/
}
}
/* At this point phs->sv must be at least a PV with a valid buffer,
*/
/* even if it's undef (null) */
/* Here we set phs->progv, phs->indp, and value_len. */
+
if (SvOK(phs->sv)) {
- phs->progv = SvPV(phs->sv, value_len);
+ phs->progv = SvPV(phs->sv, value_len);
phs->indp = 0;
} else { /* it's null but point to buffer incase it's an out var */
phs->progv = (phs->is_inout) ? SvPVX(phs->sv) : NULL;
phs->indp = -1;
value_len = 0;
}
+
+
if (imp_sth->ora_pad_empty && value_len==0) {
sv_setpv(phs->sv, " ");
phs->progv = SvPV(phs->sv, value_len);
}
+
phs->sv_type = SvTYPE(phs->sv); /* part of mutation check */
+
+
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) {
@@ -2106,6 +2113,7 @@
(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;
}
@@ -2275,8 +2283,8 @@
default:
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)
PerlIO_printf(DBILOGFP, " bind %s done with ftype
%d\n",
@@ -2284,14 +2292,14 @@
return 1;
}
PerlIO_printf(DBILOGFP, "dbd_rebind_ph done=%d\n",done);
-
+
if (done != 1) {
return 0; /* the rebind failed */
}
at_exec = (phs->desc_h == NULL);
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph binde next\n");
-
+
+
OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
phs->progv,
@@ -2305,13 +2313,16 @@
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;
}
if (at_exec) {
- OCIBindDynamic_log(phs->bndhp, imp_sth->errhp,
+ PerlIO_printf(DBILOGFP, "OCIBindDynamic_log dbd_phs_out
phs->bndhp=%d\n",phs->bndhp);
+
+ OCIBindDynamic_log(phs->bndhp, imp_sth->errhp,
(dvoid *)phs, dbd_phs_in,
(dvoid *)phs, dbd_phs_out, status);
+
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
return 0;
@@ -2401,33 +2412,29 @@
phs_t *phs;
/* check if placeholder was passed as a number */
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() newvalue=(%s)\n",
neatsvpv(newvalue,0));
+
+PerlIO_printf(DBILOGFP, "in dbd_bind_ph() 1 newvalue=(%d)\n", newvalue);
+
if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */
mg_get(ph_namesv);
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 0\n");
-
if (!SvNIOKp(ph_namesv)) {
STRLEN i;
-
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 1\n");
name = SvPV(ph_namesv, name_len);
if (name_len > sizeof(namebuf)-1)
croak("Placeholder name %s too long",
neatsvpv(ph_namesv,0));
-
+
for (i=0; i<name_len; i++) namebuf[i] = toLOWER(name[i]);
namebuf[i] = '\0';
name = namebuf;
}
-
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 1a\n");
if (SvNIOKp(ph_namesv) || (name && isDIGIT(name[0]))) {
sprintf(namebuf, ":p%d", (int)SvIV(ph_namesv));
name = namebuf;
name_len = strlen(name);
}
-
+
assert(name != Nullch);
if (SvROK(newvalue)
@@ -2451,14 +2458,12 @@
(long)newvalue, (long)maxlen);
if (attribs)
PerlIO_printf(DBILOGFP, ", attribs: %s",
neatsvpv(attribs,0));
-
+
PerlIO_printf(DBILOGFP, ")\n");
}
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 1b\n");
phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
-
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 2a
ph_namesv=%s\n",neatsvpv(ph_namesv,0));
+
if (phs_svp == NULL)
croak("Can't bind unknown placeholder '%s' (%s)", name,
neatsvpv(ph_namesv,0));
@@ -2467,20 +2472,17 @@
phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
if (phs->sv == &sv_undef) { /* first bind for this placeholder
*/
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 2b is_inout=%d\n",is_inout);
phs->is_inout = is_inout;
if (is_inout) {
- PerlIO_printf(DBILOGFP, "John s is_inout\n");
-
/* 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();
-
+
av_push(imp_sth->out_params_av, SvREFCNT_inc(*phs_svp));
-
+
}
/*
@@ -2492,12 +2494,12 @@
* the same as scalar(@array) bound (see dbd_rebind_ph_varchar2_table()
).
*/
phs->array_numstruct=0;
- PerlIO_printf(DBILOGFP, "John s 2ac attribs=%d\n",attribs);
+
if (attribs) { /* only look for ora_type on first bind of var
*/
SV **svp;
/* Setup / Clear attributes as defined by attribs.
*/
/* XXX If attribs is EMPTY then reset attribs to default?
*/
-
+
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);
@@ -2532,7 +2534,7 @@
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);
+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)
@@ -2557,9 +2559,9 @@
PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 3\n");
}
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 4 %d\n",SvROK(newvalue));
+ 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");
@@ -2586,13 +2588,14 @@
sv_pvn_force(phs->sv, &na);
}
else if (newvalue != phs->sv) {
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 7\n");
+ 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
*/
+
+ phs->sv = SvREFCNT_inc(newvalue); /* point to live var
*/
}
-PerlIO_printf(DBILOGFP, "end dbd_bind_ph js \n");
+PerlIO_printf(DBILOGFP, "end phs->sv= %d\n",phs->sv);
return dbd_rebind_ph(sth, imp_sth, phs);
}
@@ -2604,57 +2607,72 @@
dbd_phs_sv_complete(phs_t *phs, SV *sv, I32 debug)
{
dTHX;
- char *note = "";
+ char *note = "";
/* XXX doesn't check arcode for error, caller is expected to */
+ debug=15;
+PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 1\n");
+
if (phs->indp == 0) { /* is okay */
- if (phs->is_inout && phs->alen == SvLEN(sv)) {
- /* if the placeholder has not been assigned to then phs->alen */
- /* is left untouched: still set to SvLEN(sv). If we use that */
- /* then we'll get garbage bytes beyond the original contents. */
- phs->alen = SvCUR(sv);
- note = " UNTOUCHED?";
- }
- if (SvPVX(sv)) {
- SvCUR_set(sv, phs->alen);
- *SvEND(sv) = '\0';
- SvPOK_only_UTF8(sv);
- }
- else { /* shouldn't happen */
- debug = 2;
- note = " [placeholder has no data buffer]";
- }
- 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 */
- if (SvPVX(sv)) {
- SvCUR_set(sv, phs->alen);
- *SvEND(sv) = '\0';
- SvPOK_only_UTF8(sv);
- }
- else { /* shouldn't happen */
- debug = 2;
- note = " [placeholder has no data buffer]";
- }
- 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);
- }
- else
- if (phs->indp == -1) { /* is NULL */
- (void)SvOK_off(phs->sv);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP,
- " out %s = undef (NULL, arcode %d)\n",
- phs->name, phs->arcode);
+ 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 */
+ /* then we'll get garbage bytes beyond the original
contents. */
+ phs->alen = SvCUR(sv);
+ note = " UNTOUCHED?";
+ }
+
+ if (SvPVX(sv)) {
+ PerlIO_printf(DBILOGFP, "dbd_phs_sv_complete 4\n");
+
+ SvCUR_set(sv, phs->alen);
+ *SvEND(sv) = '\0';
+ SvPOK_only_UTF8(sv);
+ }
+ else { /* shouldn't happen */
+ debug = 2;
+ note = " [placeholder has no data buffer]";
+ }
+
+ 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
- croak("panic dbd_phs_sv_complete: %s bad indp %d, arcode %d",
phs->name, phs->indp, phs->arcode);
-}
+ 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");
+ SvCUR_set(sv, phs->alen);
+ *SvEND(sv) = '\0';
+ SvPOK_only_UTF8(sv);
+ }
+ else { /* shouldn't happen */
+ debug = 2;
+ note = " [placeholder has no data buffer]";
+ }
+ 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);
+ }
+ else
+ if (phs->indp == -1) { /* is NULL */
+ (void)SvOK_off(phs->sv);
+ if (debug >= 2)
+ 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);
+ debug=0;
+}
void
dbd_phs_avsv_complete(phs_t *phs, I32 index, I32 debug)
{
@@ -2662,8 +2680,8 @@
AV *av = (AV*)SvRV(phs->sv);
SV *sv = *av_fetch(av, index, 1);
dbd_phs_sv_complete(phs, sv, 0);
- if (debug >= 2)
- PerlIO_printf(DBILOGFP, " out '%s'[%ld] = %s (arcode %d, ind %d,
len %d)\n",
+ /* 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);
}
@@ -2750,6 +2768,7 @@
}
}
}
+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),
@@ -2825,7 +2844,7 @@
AV *av = (AV*)SvRV(sv);
I32 avlen = AvFILL(av);
if (avlen >= 0)
- dbd_phs_avsv_complete(phs, avlen, debug);
+ (phs, avlen, debug);
}
else
dbd_phs_sv_complete(phs, sv, debug);
@@ -2843,7 +2862,7 @@
{
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,
@@ -2859,6 +2878,8 @@
oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
return 0;
}
+
+
OCIBindDynamic_log(phs->bndhp, imp_sth->errhp,
(dvoid *)phs, dbd_phs_in,
(dvoid *)phs, dbd_phs_out, status);
@@ -2874,6 +2895,8 @@
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 */
phs->is_inout = 0;
phs->maxlen = 1;
@@ -2915,7 +2938,9 @@
char namebuf[30];
STRLEN len;
- if (debug <= 2)
+ 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,
neatsvpv(tuples,0), neatsvpv(tuples_status,0),
@@ -2926,8 +2951,8 @@
"for array operation.");
}
- if (imp_sth->out_params_av || imp_sth->has_lobs) {
- croak("ora_st_execute_array(): Output placeholders and LOBs not "
+ if (imp_sth->has_lobs) {
+ croak("ora_st_execute_array(): LOBs not "
"supported for array operation.");
}
@@ -2947,7 +2972,7 @@
} else {
columns_av = NULL;
}
-
+PerlIO_printf(DBILOGFP, "ora_st_execute_array 2\n");
/* Check the `tuples_status' parameter. */
if(SvTRUE(tuples_status)) {
if(!SvROK(tuples_status) || SvTYPE(SvRV(tuples_status)) != SVt_PVAV) {
@@ -2979,7 +3004,10 @@
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++) {
+ 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);
sv_p = av_fetch(tuples_av, j, 0);
if(sv_p == NULL) {
Safefree(phs);
@@ -2996,6 +3024,7 @@
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) {
@@ -3007,11 +3036,12 @@
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) {
Safefree(phs);
croak("Cannot fetch value for param %d in entry %d", i, j);
@@ -3046,7 +3076,7 @@
}
}
}
- Safefree(phs);
+ Safefree(phs);
/* Store array of bind typles, for use in OCIBindDynamic() callback. */
imp_sth->bind_tuples = tuples_av;
@@ -3055,8 +3085,32 @@
oci_mode = OCI_BATCH_ERRORS;
if(autocommit)
oci_mode |= OCI_COMMIT_ON_SUCCESS;
- OCIStmtExecute_log_stat(imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
+
+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,
exe_count, 0, 0, 0, oci_mode, exe_status);
+
+if (outparams){
+
+
+int 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);
+
+ 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);
+ }
+}
+}
+
imp_sth->bind_tuples = NULL;
if (exe_status != OCI_SUCCESS) {
@@ -3066,7 +3120,7 @@
}
OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS,
status);
- if (debug >= 6)
+ if (debug <= 6)
PerlIO_printf(DBILOGFP, " ora_st_execute_array %d errors in batch.\n",
num_errs);
if(num_errs && tuples_status_av) {
Modified: dbd-oracle/branches/array_inout/oci8.c
==============================================================================
--- dbd-oracle/branches/array_inout/oci8.c (original)
+++ dbd-oracle/branches/array_inout/oci8.c Fri Feb 1 14:13:32 2008
@@ -416,7 +416,7 @@
*alenp = phs->alen;
*indpp = &phs->indp;
*piecep = OCI_ONE_PIECE;
- if (DBIS->debug >= 3)
+ /* 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" : "");
@@ -480,17 +480,28 @@
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 */ }
-PerlIO_printf(DBILOGFP, " in dbd_phs_out\n");
- if (phs->desc_h) {
+
+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",SvTYPE(sv));
+
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
*/
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))
sv_setpv(sv,"");
}
@@ -500,7 +511,7 @@
*alenpp = &phs->alen;
*indpp = &phs->indp;
*rcodepp= &phs->arcode;
- if (DBIS->debug >= 3)
+ /* 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" : "");
@@ -2012,6 +2023,7 @@
/* 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);
@@ -2950,6 +2962,8 @@
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 */
if (status != OCI_SUCCESS)
