Author: byterock
Date: Mon Jan 21 11:48:16 2008
New Revision: 10628
Modified:
dbd-oracle/branches/array_inout/Oracle.xs
dbd-oracle/branches/array_inout/dbdimp.c
Log:
daily for this
Modified: dbd-oracle/branches/array_inout/Oracle.xs
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.xs (original)
+++ dbd-oracle/branches/array_inout/Oracle.xs Mon Jan 21 11:48:16 2008
@@ -78,6 +78,40 @@
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
void
+bind_param_inout_array(sth, param, av_ref, maxlen, attribs=Nullsv)
+ SV * sth
+ SV * param
+ SV * av_ref
+ IV maxlen
+ SV * attribs
+ CODE:
+ {
+ 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 = SvRV(av_ref);
+ if (SvREADONLY(av_value))
+ croak("Modification of a read-only value attempted");
+ if (attribs) {
+ if (SvNIOK(attribs)) {
+ sql_type = SvIV(attribs);
+ attribs = Nullsv;
+ }
+ else {
+ SV **svp;
+ DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+ DBD_ATTRIB_GET_IV(attribs, "TYPE",4, svp, sql_type);
+ }
+ }
+ PerlIO_printf(DBILOGFP," param=%d, av_value=%d, sql_type=%d
\n",param,av_value,sql_type);
+ ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE,
maxlen)
+ ? &sv_yes : &sv_no;
+ }
+
+void
ora_fetch(sth)
SV * sth
PPCODE:
@@ -188,12 +222,12 @@
/* if (0 && SvUTF8(data) && !IN_BYTES) { amtp = sv_len_utf8(data); } */
/* added by lab: */
/* LAB do something about length here? see above comment */
- OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator,
&csform, status );
+ OCILobCharSetForm_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator,
&csform, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
ST(0) = &sv_undef;
return;
- }
+ }
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat( imp_dbh->envhp, imp_dbh->errhp, locator, &csid,
status );
@@ -324,7 +358,9 @@
/* 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;
@@ -334,6 +370,7 @@
&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 Jan 21 11:48:16 2008
@@ -2032,7 +2032,7 @@
if(SvUPGRADE(phs->sv, SVt_PV)){} /* For gcc not to warn on unused
result)*/;
}
- 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))
@@ -2087,7 +2087,7 @@
phs->maxlen = 0;
phs->alen = value_len + phs->alen_incnull;
- if (DBIS->debug >= 3) {
+ 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,
@@ -2241,8 +2241,7 @@
int trace_level = DBIS->debug;
ub1 csform;
ub2 csid;
-
- if (trace_level >= 5)
+ 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",
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);
@@ -2264,17 +2263,28 @@
default:
done = dbd_rebind_ph_char(imp_sth, phs);
}
+ PerlIO_printf(DBILOGFP, " John dbd_rebind_ph done=%d \n",done);
+
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",
+ if (trace_level <= 3)
+ PerlIO_printf(DBILOGFP, " bind %s done with ftype
%d\n",
phs->name, phs->ftype);
- return 1;
+ return 1;
}
if (done != 1) {
- return 0; /* the rebind failed */
+ return 0; /* the rebind failed */
}
at_exec = (phs->desc_h == NULL);
+
+ PerlIO_printf(DBILOGFP, " John 1 at_exec= %d\n", (phs->desc_h ==
NULL));
+
+ PerlIO_printf(DBILOGFP, " John 2 OCI_DATA_AT_EXEC=%d OCI_DEFAULT=%d\n",
OCI_DATA_AT_EXEC,OCI_DEFAULT);
+
+ PerlIO_printf(DBILOGFP, " John 3 at_exec ? = %d\n", (at_exec ?
OCI_DATA_AT_EXEC : OCI_DEFAULT));
+
+
+
OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
phs->progv,
@@ -2285,20 +2295,29 @@
0, /* max elements that can fit in allocated array */
NULL, /* (ptr to) current number of elements in array */
(ub4)(at_exec ? OCI_DATA_AT_EXEC : OCI_DEFAULT),
- status
- );
+ status);
+
+ PerlIO_printf(DBILOGFP, " John 4 OCIBindByName_log_stat status %d\n",
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,
+
+
+ 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;
- }
+
+ PerlIO_printf(DBILOGFP, " John 5 OCIBindDynamic_log status
%d\n", status);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindDynamic");
+ return 0;
+ }
+
}
/* some/all of the following should perhaps move into dbd_phs_in() */
@@ -2311,26 +2330,27 @@
csform = SQLCS_IMPLICIT;
else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR))
csform = SQLCS_NCHAR; /* else leave csform == 0 */
- if (trace_level)
- PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (2): rebinding %s with
UTF8 value %s", phs->name,
- (csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_IMPLICIT"
:
- (csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_NCHAR" :
- "but neither CHAR nor NCHAR are unicode\n");
+
+ if (trace_level)
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (2): rebinding %s
with UTF8 value %s", phs->name,
+ (csform == SQLCS_IMPLICIT) ? "so setting
csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_NCHAR) ? "so setting
csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are unicode\n");
}
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,
- &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;
- }
+ 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 (!phs->csid_orig) { /* get the default csid Oracle would use */
- OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, (ub4)0
,
- OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
+ OCIAttrGet_log_stat(phs->bndhp, OCI_HTYPE_BIND,
&phs->csid_orig, (ub4)0 ,
+ OCI_ATTR_CHARSET_ID, imp_sth->errhp, status);
}
/* if app has specified a csid then use that, else use default */
@@ -2340,7 +2360,7 @@
if (SvUTF8(phs->sv) && !CS_IS_UTF8(csid))
csid = utf8_csid; /* not al32utf8_csid here on purpose */
- if (trace_level >= 3)
+ if (trace_level <= 3)
PerlIO_printf(DBILOGFP, "dbd_rebind_ph(): bind %s <== %s "
"(%s, %s, csid %d->%d->%d, ftype %d, csform %d->%d, maxlen %lu,
maxdata_size %lu)\n",
phs->name, neatsvpv(phs->sv,0),
@@ -2352,23 +2372,23 @@
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,
- neatsvpv(phs->sv,0), (ub4)phs->maxdata_size,
(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;
- }
+ OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ neatsvpv(phs->sv,0), (ub4)phs->maxdata_size,
(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;
+ }
}
-
+
return 1;
}
@@ -2384,65 +2404,76 @@
phs_t *phs;
/* check if placeholder was passed as a number */
+PerlIO_printf(DBILOGFP, "in dbd_bind_ph\n");
if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */
mg_get(ph_namesv);
+
if (!SvNIOKp(ph_namesv)) {
- STRLEN i;
- 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;
- }
- 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)
- && !IS_DBI_HANDLE(newvalue) /* dbi handle allowed for
cursor variables */
- && !SvAMAGIC(newvalue) /* overload magic allowed
(untested) */
- && !sv_derived_from(newvalue, "OCILobLocatorPtr" ) /* input
LOB locator*/
- && !(SvTYPE(SvRV(newvalue))==SVt_PVAV) /* Allow array binds */
+ STRLEN i;
+ 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;
+ }
+ 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)
+ && !IS_DBI_HANDLE(newvalue) /* dbi handle allowed
for cursor variables */
+ && !SvAMAGIC(newvalue) /* overload magic
allowed (untested) */
+ && !sv_derived_from(newvalue, "OCILobLocatorPtr" ) /*
input LOB locator*/
+ && !(SvTYPE(SvRV(newvalue))==SVt_PVAV) /* Allow array
binds */
)
- croak("Can't bind a reference (%s)", neatsvpv(newvalue,0));
- if (SvTYPE(newvalue) > SVt_PVAV) /* Array binding supported */
- croak("Can't bind a non-scalar, non-array value (%s)",
neatsvpv(newvalue,0));
- 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) {
- PerlIO_printf(DBILOGFP, "dbd_bind_ph(): bind %s <== %s (type
%ld",
- name, neatsvpv(newvalue,0), (long)sql_type);
- if (is_inout)
- PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld",
- (long)newvalue, (long)maxlen);
- if (attribs)
- PerlIO_printf(DBILOGFP, ", attribs: %s",
neatsvpv(attribs,0));
- PerlIO_printf(DBILOGFP, ")\n");
- }
-
- phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
- if (phs_svp == NULL)
- croak("Can't bind unknown placeholder '%s' (%s)", name,
neatsvpv(ph_namesv,0));
-
- /* This value is not a string, but a binary structure phs_st instead. */
- phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
-
- if (phs->sv == &sv_undef) { /* first bind for this placeholder
*/
- phs->is_inout = is_inout;
- if (is_inout) {
- /* phs->sv assigned in the code below */
- ++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));
- }
+ croak("Can't bind a reference (%s)",
neatsvpv(newvalue,0));
+ if (SvTYPE(newvalue) > SVt_PVAV) /* Array binding supported */
+ croak("Can't bind a non-scalar, non-array value (%s)",
neatsvpv(newvalue,0));
+
+ 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) {
+ PerlIO_printf(DBILOGFP, "dbd_bind_ph(): bind %s <== %s
(type %ld",
+ name, neatsvpv(newvalue,0), (long)sql_type);
+ if (is_inout)
+ PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld",
+ (long)newvalue, (long)maxlen);
+
+ if (attribs)
+ PerlIO_printf(DBILOGFP, ", attribs: %s",
neatsvpv(attribs,0));
+ PerlIO_printf(DBILOGFP, ")\n");
+ }
+
+ phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
+
+ if (phs_svp == NULL)
+ croak("Can't bind unknown placeholder '%s' (%s)", name,
neatsvpv(ph_namesv,0));
+
+ /* This value is not a string, but a binary structure phs_st
instead. */
+ phs = (phs_t*)(void*)SvPVX(*phs_svp); /* placeholder struct */
+ PerlIO_printf(DBILOGFP, "john s 1\n");
+
+ if (phs->sv == &sv_undef) { /* first bind for this placeholder
*/
+ PerlIO_printf(DBILOGFP, "john s 2\n");
+ phs->is_inout = is_inout;
+ if (is_inout) {
+PerlIO_printf(DBILOGFP, "john s 3\n");
+ /* phs->sv assigned in the code below */
+ ++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));
+PerlIO_printf(DBILOGFP, "john s 4\n");
+
+ }
/*
* Init number of bound array entries to zero.
@@ -2452,62 +2483,72 @@
* If no ora_maxarray_numentries specified, let it be
* the same as scalar(@array) bound (see dbd_rebind_ph_varchar2_table()
).
*/
- phs->array_numstruct=0;
+ phs->array_numstruct=0;
+PerlIO_printf(DBILOGFP, "john s 4a %d\n",attribs);
- if (attribs) { /* only look for ora_type on first bind of var */
- SV **svp;
- /* Setup / Clear attributes as defined by attribs. */
+ if (attribs) { /* only look for ora_type on first bind
of var */
+ SV **svp;
+PerlIO_printf(DBILOGFP, "john s 5\n");
+ /* 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);
- 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) {
- phs->ora_field = SvREFCNT_inc(*svp);
- }
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_csform", 10, 0)) !=
NULL) {
- if (SvIV(*svp) == SQLCS_IMPLICIT || SvIV(*svp) ==
SQLCS_NCHAR)
- phs->csform = (ub1)SvIV(*svp);
- else warn("ora_csform must be 1 (SQLCS_IMPLICIT) or 2
(SQLCS_NCHAR), not %d", SvIV(*svp));
- }
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0))
!= NULL) {
- phs->maxdata_size = SvUV(*svp);
- }
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries",
23, 0)) != NULL) {
- phs->ora_maxarray_numentries=SvUV(*svp);
- }
- if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0))
!= NULL) {
- phs->ora_internal_type=SvUV(*svp);
- }
- }
- if (sql_type)
- phs->ftype = ora_sql_type(imp_sth, phs->name, (int)sql_type);
-
- /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
- if (phs->ftype==102)
- phs->ftype = 116;
+ if ( (svp=hv_fetch((HV*)SvRV(attribs),
"ora_type",8, 0)) != NULL) {
+ int ora_type = SvIV(*svp);
+ 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) {
+ phs->ora_field = SvREFCNT_inc(*svp);
+ }
+
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_csform",
10, 0)) != NULL) {
+ if (SvIV(*svp) == SQLCS_IMPLICIT ||
SvIV(*svp) == SQLCS_NCHAR)
+ phs->csform = (ub1)SvIV(*svp);
+ else warn("ora_csform must be 1
(SQLCS_IMPLICIT) or 2 (SQLCS_NCHAR), not %d", SvIV(*svp));
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs),
"ora_maxdata_size", 16, 0)) != NULL) {
+ phs->maxdata_size = SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs),
"ora_maxarray_numentries", 23, 0)) != NULL) {
+ phs->ora_maxarray_numentries=SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs),
"ora_internal_type", 17, 0)) != NULL) {
+ phs->ora_internal_type=SvUV(*svp);
+ }
+ }
+PerlIO_printf(DBILOGFP, "john s 6\n");
+ if (sql_type)
+ phs->ftype = ora_sql_type(imp_sth, phs->name,
(int)sql_type);
+
+ /* treat Oracle7 SQLT_CUR as SQLT_RSET for Oracle8 */
+ if (phs->ftype==102)
+ phs->ftype = 116;
/* some types require the trailing null included in the length. */
/* SQLT_STR=5=STRING, SQLT_AVC=97=VARCHAR */
- phs->alen_incnull = (phs->ftype==SQLT_STR || phs->ftype==SQLT_AVC);
+ phs->alen_incnull = (phs->ftype==SQLT_STR ||
phs->ftype==SQLT_AVC);
- } /* was first bind for this placeholder */
+ } /* was first bind for this placeholder */
/* check later rebinds for any changes */
else if (is_inout != phs->is_inout) {
- croak("Can't rebind or change param %s in/out mode after first bind (%d
=> %d)",
+ croak("Can't rebind or change param %s in/out mode after first bind
(%d => %d)",
phs->name, phs->is_inout , is_inout);
}
else if (sql_type && phs->ftype != ora_sql_type(imp_sth, phs->name,
(int)sql_type)) {
- croak("Can't change TYPE of param %s to %d after initial bind",
+ croak("Can't change TYPE of param %s to %d after initial bind",
phs->name, sql_type);
}
+
+PerlIO_printf(DBILOGFP, "john s 7 SvROK=%d\n", SvROK(newvalue));
+PerlIO_printf(DBILOGFP, "john s SvTYPE(SvRV(newvalue))==SVt_PVAV
=%d\n",SvTYPE(SvRV(newvalue)));
+
/* Array binding is supported for a limited number of data types. */
if( SvROK(newvalue) ){
if( SvTYPE(SvRV(newvalue))==SVt_PVAV ){
@@ -2524,18 +2565,20 @@
phs->maxlen = maxlen; /* 0 if not inout */
if (!is_inout) { /* normal bind so take a (new) copy of current value
*/
- if (phs->sv == &sv_undef) /* (first time bind) */
- phs->sv = newSV(0);
- sv_setsv(phs->sv, newvalue);
- if (SvAMAGIC(phs->sv)) /* overloaded. XXX hack, logic ought to be
pushed deeper */
- sv_pvn_force(phs->sv, &na);
+ if (phs->sv == &sv_undef) /* (first time bind) */
+ phs->sv = newSV(0);
+
+ sv_setsv(phs->sv, newvalue);
+ if (SvAMAGIC(phs->sv)) /* overloaded. XXX hack, logic ought to
be pushed deeper */
+ sv_pvn_force(phs->sv, &na);
+
}
else if (newvalue != phs->sv) {
- if (phs->sv)
- SvREFCNT_dec(phs->sv);
- phs->sv = SvREFCNT_inc(newvalue); /* point to live var */
+ if (phs->sv)
+ SvREFCNT_dec(phs->sv);
+
+ phs->sv = SvREFCNT_inc(newvalue); /* point to live var
*/
}
-
return dbd_rebind_ph(sth, imp_sth, phs);
}
@@ -2858,7 +2901,7 @@
STRLEN len;
if (debug >= 2)
- PerlIO_printf(DBILOGFP, " ora_st_execute_array %s count=%d (%s %s
%s)...\n",
+ 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),
neatsvpv(columns, 0));
