Author: byterock
Date: Tue Jan 29 11:56:01 2008
New Revision: 10670
Modified:
dbd-oracle/branches/array_inout/Oracle.pm
dbd-oracle/branches/array_inout/Oracle.xs
dbd-oracle/branches/array_inout/dbdimp.c
Log:
daily
Modified: dbd-oracle/branches/array_inout/Oracle.pm
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.pm (original)
+++ dbd-oracle/branches/array_inout/Oracle.pm Tue Jan 29 11:56:01 2008
@@ -857,8 +857,8 @@
sub bind_param_inout_array {
my $sth = shift;
- my ($p_num, $value_array, $attr) = @_;
- ora_bind_param_inout_array($sth, $p_num, $value_array, $attr);
+ my ($p_num, $value_array,$maxlen, $attr) = @_;
+ ora_bind_param_inout_array($sth, $p_num, $value_array,$maxlen, $attr);
}
Modified: dbd-oracle/branches/array_inout/Oracle.xs
==============================================================================
--- dbd-oracle/branches/array_inout/Oracle.xs (original)
+++ dbd-oracle/branches/array_inout/Oracle.xs Tue Jan 29 11:56:01 2008
@@ -78,7 +78,7 @@
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::st
void
-ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs=Nullsv)
+ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs)
SV * sth
SV * param
SV * av_ref
@@ -92,23 +92,29 @@
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);
+
+ av_value = av_ref;
+
if (SvREADONLY(av_value))
croak("Modification of a read-only value attempted");
+
if (attribs) {
- if (SvNIOK(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, "TYPE",4, svp, sql_type);
+ DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type);
}
}
- PerlIO_printf(DBILOGFP," param=%d, av_value=%d, sql_type=%d
\n",param,av_value,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;
Modified: dbd-oracle/branches/array_inout/dbdimp.c
==============================================================================
--- dbd-oracle/branches/array_inout/dbdimp.c (original)
+++ dbd-oracle/branches/array_inout/dbdimp.c Tue Jan 29 11:56:01 2008
@@ -2023,16 +2023,20 @@
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));
+
if (!SvPOK(phs->sv)) { /* normalizations for special cases */
- if (SvOK(phs->sv)) { /* ie a number, convert to string ASAP */
+
+ 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) */
+ 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 (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))
@@ -2049,47 +2053,54 @@
/* just copy the value & length over and not rebind. */
if (phs->is_inout) { /* XXX */
- if (SvREADONLY(phs->sv))
+ 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)
+ if (imp_sth->ora_pad_empty)
croak("Can't use ora_pad_empty with bind_param_inout");
- if (1 || !at_exec) {
- /* 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*/);
- }
+ 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 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->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;
+ 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);
+ 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)
*/
if (phs->maxlen < 0) /* can happen with nulls */
- phs->maxlen = 0;
+ 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",
+ 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 : "",
@@ -2242,7 +2253,7 @@
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 +2275,23 @@
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",
- phs->name, phs->ftype);
- return 1;
+ if (trace_level <= 3)
+ 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);
+
if (done != 1) {
- return 0; /* the rebind failed */
+ 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,
@@ -2384,7 +2401,7 @@
phs_t *phs;
/* check if placeholder was passed as a number */
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph()\n");
+PerlIO_printf(DBILOGFP, "in dbd_bind_ph() newvalue=(%s)\n",
neatsvpv(newvalue,0));
if (SvGMAGICAL(ph_namesv)) /* eg tainted or overloaded */
mg_get(ph_namesv);
@@ -2397,63 +2414,74 @@
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]);
+
+ 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);
+ name = namebuf;
+ }
+
+PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 1a\n");
- if (SvROK(newvalue)
+ 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");
- }
-PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 1a\n");
-
- phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0);
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph() js 2a\n");
+ 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");
+ }
+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));
+ 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 */
+ 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) {
- PerlIO_printf(DBILOGFP, "John s 2\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));
- }
+ 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));
+
+ }
/*
* Init number of bound array entries to zero.
@@ -2463,33 +2491,35 @@
* 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 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);
+
+ 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);
- 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);
- 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);
- }
+ 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);
}
@@ -2498,11 +2528,12 @@
}
}
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph() b\n");
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;
@@ -2526,22 +2557,22 @@
PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 3\n");
}
- PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 4\n");
-
+ PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 4 %d\n",SvROK(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 ){
+ if( SvTYPE(SvRV(newvalue))!=SVt_PVAV ){
PerlIO_printf(DBILOGFP, "in dbd_bind_ph js 6\n");
- if( (phs->ftype == ORA_VARCHAR2_TABLE) ||
+/* if( (phs->ftype == ORA_VARCHAR2_TABLE) ||
(phs->ftype == ORA_NUMBER_TABLE)) {
- /* Supported */
- }else{
+ /* Supported *
+ }else{*/
/* All the other types are not supported */
croak("Array bind is supported only for
ORA_%_TABLE types. Unable to bind '%s'.",phs->name);
- }
+ /*}*/
}
/* Add checks for other reference types here ? */
}
@@ -2884,7 +2915,7 @@
char namebuf[30];
STRLEN len;
- if (debug >= 2)
+ 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),
