Hello!
A preliminary version of OCI array bind patch attached.
Apply to the latest trunk release.
Usage example also attached.
1) Only Varchar2 tables are supported. ( SYS.DBMS_SQL.VARCHAR2_TABLE )
2) utf8 is untested. Seems to currupt utf8 data on truncate.
3) Untested.
I plan to support bind of SYS.DBMS_SQL.NUMBER_TABLE also.
As I'm new to perl api, your comments are welcome.
Also, I cannot test the whole functionality much. So, bug
reports are welcome.
Bye. Alex.
#!/usr/bin/perl
use strict;
use warnings;
BEGIN{
use lib 'blib/lib';
use lib 'blib/arch';
use lib 'blib/arch/auto';
use lib 'lib';
use lib '.';
};
use Data::Dumper;
use DBI;
use DBD::Oracle qw(:ora_types);
my $dsn = 'dbi:Oracle:mydb';
my $user = 'myuser';
my $password = 'mypw';
my $dbh = DBI->connect($dsn, $user, $password,
{ RaiseError => 0, AutoCommit => 0 });
my $statement='
DECLARE
tbl SYS.DBMS_SQL.VARCHAR2_TABLE;
BEGIN
tbl := :mytable;
:cc := tbl.count();
tbl(1) := \'def\';
tbl(2) := \'ijk\';
:mytable := tbl;
END;
';
my $sth=$dbh->prepare( $statement );
if( ! defined($sth) ){
die "Prapare error: ",$dbh->errstr,"\n";
}
my @arr=( "abc" );
if( not $sth->bind_param_inout(":mytable", [EMAIL PROTECTED], 10, { TYPE =>
DBD::Oracle::ORA_VARCHAR2, ora_maxarray_numentries => 100 } ) ){
die "bind :mytable error: ",$dbh->errstr,"\n";
}
my $cc;
if( not $sth->bind_param_inout(":cc", \$cc, 100 ) ){
die "bind :cc error: ",$dbh->errstr,"\n";
}
if( not $sth->execute() ){
die "Execute failed: ",$dbh->errstr,"\n";
}
print "Result: cc=",$cc,"\n",
"\tarr=",Data::Dumper::Dumper([EMAIL PROTECTED]),"\n";
$dbh->disconnect();
Index: ocitrace.h
===================================================================
--- ocitrace.h (revision 9916)
+++ ocitrace.h (working copy)
@@ -98,12 +98,20 @@
#define OCIBindByName_log_stat(sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md,stat)
\
stat=OCIBindByName(sh,bp,eh,p1,pl,v,vs,dt,in,al,rc,mx,cu,md); \
(DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP,
\
-
"%sBindByName(%p,%p,%p,\"%s\",%ld,%p,%ld,%u,%p,%p,%p,%lu,%p,%lu)=%s\n",\
+
"%sBindByName(%p,%p,%p,\"%s\",placeh_len=%ld,value_p=%p,value_sz=%ld," \
+ "dty=%u,indp=%p,alenp=%p,rcodep=%p,maxarr_len=%lu,curelep=%p
(*=%d),mode=%lu)=%s\n",\
OciTp, (void*)sh,(void*)bp,(void*)eh,p1,sl_t(pl),(void*)(v), \
sl_t(vs),(ub2)(dt),(void*)(in),(ub2*)(al),(ub2*)(rc), \
- ul_t((mx)),pul_t((cu)),ul_t((md)), \
+ ul_t((mx)),pul_t((cu)),(cu ? *(int*)cu : 0 ) ,ul_t((md)),
\
oci_status_name(stat)),stat : stat
+#define OCIBindArrayOfStruct_log_stat(bp,ep,sd,si,sl,sr,stat) \
+ stat=OCIBindArrayOfStruct(bp,ep,sd,si,sl,sr); \
+ (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP, \
+ "%sOCIBindArrayOfStruct(%p,%p,%u,%u,%u,%u)=%s\n", \
+ OciTp,(void*)bp,(void*)ep,sd,si,sl,sr, \
+ oci_status_name(stat)),stat : stat
+
#define OCIBindDynamic_log(bh,eh,icx,cbi,ocx,cbo,stat) \
stat=OCIBindDynamic(bh,eh,icx,cbi,ocx,cbo); \
(DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OCI_TRACEFP,
\
Index: dbdimp.c
===================================================================
--- dbdimp.c (revision 9916)
+++ dbdimp.c (working copy)
@@ -1141,8 +1141,437 @@
}
}
+/* ############### Array bind ######################################### */
+/*
+ *
+ * Realloc temporary array buffer to match required number of entries
+ * and buffer size.
+ *
+ * Return value: croaks on error. false (=0 ) on success.
+ * */
+int ora_realloc_phs_array(phs_t *phs,int newentries, int newbufsize){
+ int i; /* Loop variable */
+ if( newbufsize < 0 ){
+ newbufsize=0;
+ }
+ if( newentries > phs->array_numallocated ){
+ OCIInd *newind=(OCIInd
*)realloc(phs->array_indicators,newentries*sizeof(OCIInd) );
+ if( newind ){
+ phs->array_indicators=newind;
+ /* Init all indicators to NULL values. */
+ for( i=phs->array_numallocated; i < newentries ; i++ ){
+ newind[i]=1;
+ }
+ }else{
+ croak("Not enough memory to allocate %d OCI
indicators.",newentries);
+ }
+ unsigned short *newal=(unsigned short *)realloc(
+ phs->array_lengths,
+ newentries*sizeof(unsigned short)
+ );
+ if( newal ){
+ phs->array_lengths=newal;
+ /* Init all new lengths to zero */
+ if( newentries > phs->array_numallocated ){
+ memset(
+ &(newal[phs->array_numallocated]),
+ 0,
+
(newentries-(phs->array_numallocated))*sizeof(unsigned short)
+ );
+ }
+ }else{
+ croak("Not enough memory to allocate %d entries in OCI array of
lengths.",newentries);
+ }
+ phs->array_numallocated=newentries;
+ }
+ if( phs->array_buflen < newbufsize ){
+ char * newbuf=(char *)realloc( phs->array_buf, (unsigned) newbufsize );
+ if( newbuf ){
+ phs->array_buf=newbuf;
+ }else{
+ croak("Not enough memory to allocate OCI array buffer of %d
bytes.",newbufsize);
+ }
+ phs->array_buflen=newbufsize;
+ }
+ return 0;
+}
+/* bind of SYS.DBMS_SQL.VARCHAR2_TABLE */
+int
+dbd_rebind_ph_varchar2_table(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+{
+ dTHX;
+ /*D_imp_dbh_from_sth ;*/
+ sword status;
+ int trace_level = DBIS->debug;
+ AV *arr;
+ ub1 csform;
+ ub2 csid;
+ int flag_data_is_utf8=0;
+
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /*
Allow only array binds */
+ croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY
reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ arr=(AV*)(SvRV(phs->sv));
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d\n",
+ phs->array_numstruct);
+ }
+ /* If no number of entries to bind specified,
+ * set phs->array_numstruct to the scalar(@array) bound.
+ */
+ if( phs->array_numstruct <= 0 ){
+ /* av_len() returns last array index, or -1 is array is empty */
+ int numarrayentries=av_len( arr );
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d (calculated) \n",
+ phs->array_numstruct);
+ }
+ }
+ }
+ /* Fix charset */
+ csform = phs->csform;
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): original
csform=%d\n",
+ (int)csform);
+ }
+ /* Calculate each bound structure maxlen.
+ * If maxlen<=0, let maxlen=MAX ( length($$_) each @array );
+ *
+ * Charset calculation is done inside this loop either.
+ */
+ {
+ int maxlen=0;
+ int i;
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ if( phs->maxlen <=0 ){ /* Analyze maxlength only if not forced
*/
+ STRLEN length=0;
+ if (!SvPOK(item)) { /* normalizations for special cases
*/
+ if (SvOK(item)) { /* ie a number, convert to string
ASAP */
+ if (!(SvROK(item) && phs->is_inout)){
+ sv_2pv(item, &length);
+ }
+ } else { /* ensure we're at least an SVt_PV (so SvPVX
etc work) */
+ SvUPGRADE(item, SVt_PV);
+ }
+ }
+ if( length == 0 ){
+ length=SvCUR(item);
+ }
+ if( length+1 > maxlen ){
+ maxlen=length+1;
+ }
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n",
+ i,(int)length);
+ }
+ }
+ if(SvUTF8(item) ){
+ flag_data_is_utf8=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i);
+ }
+ if (csform != SQLCS_NCHAR) {
+ /* try to default csform to avoid translation through
non-unicode */
+ if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR)) /*
prefer NCHAR */
+ csform = SQLCS_NCHAR;
+ else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
+ csform = SQLCS_IMPLICIT;
+ /* else leave csform == 0 */
+ if (trace_level)
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name,
+ (csform == SQLCS_NCHAR) ? "so setting
csform=SQLCS_IMPLICIT" :
+ (csform == SQLCS_IMPLICIT) ? "so setting
csform=SQLCS_NCHAR" :
+ "but neither CHAR nor NCHAR are unicode\n");
+ }
+ }else{
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i);
+ }
+ }
+ }
+ }
+ if( phs->maxlen <=0 ){
+ phs->maxlen=maxlen;
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen calculated =%d\n",
+ (int)maxlen);
+ }
+ } else{
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen forsed =%d\n",
+ (int)maxlen);
+ }
+ }
+ }
+ /* Do not allow string bind longer than max VARCHAR2=4000+1 */
+ if( phs->maxlen > 4001 ){
+ phs->maxlen=4001;
+ }
+ if( phs->array_numstruct == 0 ){
+ /* Oracle doesn't allow NULL buffers even for empty tables. Don't know
why. */
+ phs->array_numstruct=1;
+ }
+ int need_allocate_rows=phs->ora_maxarray_numentries;
+
+ if( need_allocate_rows< phs->array_numstruct ){
+ need_allocate_rows=phs->array_numstruct;
+ }
+ int buflen=need_allocate_rows* phs->maxlen; /* We need buffer for at least
ora_maxarray_numentries entries */
+ /* Upgrade array buffer to new length */
+ if( ora_realloc_phs_array(phs,need_allocate_rows,buflen) ){
+ croak("Unable to bind %s - %d structures by %d bytes requires too much
memory.",
+ phs->name, need_allocate_rows, buflen );
+ }
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): "
+ "Call ora_realloc_phs_array(, array_numstruct=%d, buflen=%d)
successfull.\n",
+ phs->array_numstruct,buflen);
+ }
+ /* Fill array buffer with string data */
+
+ {
+ int i; /* Not to require C99 mode */
+ for(i=0;i<av_len(arr)+1;i++){
+ SV *item;
+ item=*(av_fetch(arr,i,0));
+ if( item ){
+ STRLEN itemlen;
+ char *str=SvPV(item, itemlen);
+ if( str && (itemlen>0) ){
+ /* Limit string length to maxlen. FIXME: This may corrupt
UTF-8 data. */
+ if( itemlen > phs->maxlen-1 ){
+ itemlen=phs->maxlen-1;
+ }
+ memcpy( phs->array_buf+phs->maxlen*i,
+ str,
+ itemlen);
+ /* Set last byte to zero */
+ phs->array_buf[ phs->maxlen*i + itemlen ]=0;
+ phs->array_indicators[i]=0;
+ phs->array_lengths[i]=itemlen+1; /* Zero byte */
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%d array[%d]='%s'.\n",
+ itemlen,i,str);
+ }
+ }else{
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
+ "Copying length=%d array[%d]=NULL (length==0 or
! str) .\n",
+ itemlen,i);
+ }
+ }
+ }else{
+ /* Mark NULL */
+ phs->array_indicators[i]=1;
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): "
+ "Copying length=? array[%d]=NULL av_fetch
failed.\n", i);
+ }
+ }
+ }
+ }
+ /* Do actual bind */
+ OCIBindByName_log_stat(imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
+ (text*)phs->name, (sb4)strlen(phs->name),
+ phs->array_buf,
+ phs->maxlen,
+ (ub2)SQLT_STR, phs->array_indicators,
+ phs->array_lengths, /* ub2 *alen_ptr not needed with OCIBindDynamic
*/
+ (ub2)0,
+ (ub4)phs->ora_maxarray_numentries, /* max elements that can fit in
allocated array */
+ &(phs->array_numstruct), /* (ptr to) current number of elements
in array */
+ OCI_DEFAULT, /* OCI_DATA_AT_EXEC (bind with
callbacks) or OCI_DEFAULT */
+ status
+ );
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindByName");
+ return 0;
+ }
+ OCIBindArrayOfStruct_log_stat(phs->bndhp, imp_sth->errhp,
+ phs->maxlen, /* Skip parameter for the next data value */
+ sizeof (OCIInd), /* Skip parameter for the next indicator
value */
+ sizeof(unsigned short), /* Skip parameter for the next actual
length value */
+ 0, /* Skip parameter for the next column-level
error code */
+ status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCIBindArrayOfStruct");
+ return 0;
+ }
+ /* Fixup charset */
+ 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;
+ }
+ }
+
+ 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);
+ }
+
+ /* if app has specified a csid then use that, else use default */
+ csid = (phs->csid) ? phs->csid : phs->csid_orig;
+
+ /* if data is utf8 but charset isn't then switch to utf8 csid */
+ if ( flag_data_is_utf8 && !CS_IS_UTF8(csid))
+ csid = utf8_csid; /* not al32utf8_csid here on purpose */
+
+ if (trace_level >= 3)
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): 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),
+ (phs->is_inout) ? "inout" : "in",
+ flag_data_is_utf8 ? "is-utf8" : "not-utf8",
+ phs->csid_orig, phs->csid, csid,
+ phs->ftype, phs->csform, csform,
+ (unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
+
+
+ if (csid) {
+ 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 (phs->maxdata_size) {
+ OCIAttrSet_log_stat(phs->bndhp, (ub4)OCI_HTYPE_BIND,
+ phs->array_buf, (ub4)phs->array_buflen, (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 2;
+}
+
+
+/* Copy array data from array buffer into perl array */
+/* Returns false on error, true on success */
+int dbd_phs_array_fixup_after_execute(phs_t *phs){
+ dTHX;
+
+ int trace_level = DBIS->debug;
+ AV *arr;
+
+ if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /*
Allow only array binds */
+ croak("dbd_phs_array_fixup_after_execute(): bad bind variable. ARRAY
reference required, but got %s for '%s'.",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ if (trace_level >= 1){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): Called for '%s' :
array_numstruct=%d, maxlen=%d \n",
+ phs->name,
+ phs->array_numstruct,
+ phs->maxlen
+ );
+ }
+ arr=(AV*)(SvRV(phs->sv));
+
+ /* If no data is returned, just clear the array. */
+ if( phs->array_numstruct <= 0 ){
+ av_clear(arr);
+ return 1;
+ }
+ /* Delete extra data from array, if any */
+ while( av_len(arr) >= phs->array_numstruct ){
+ av_delete(arr,av_len(arr),G_DISCARD);
+ };
+ /* Extend array, if needed. */
+ if( av_len(arr)+1 < phs->array_numstruct ){
+ av_extend(arr,phs->array_numstruct-1);
+ }
+ /* Fill array with buffer data */
+ {
+ /* phs_t */
+ int i; /* Not to require C99 mode */
+ for(i=0;i<phs->array_numstruct;i++){
+ SV *item,**pitem;
+ pitem=av_fetch(arr,i,0);
+ if( pitem ){
+ item=*pitem;
+ }else{
+ item=NULL;
+ }
+ if( phs->array_indicators[i] == -1 ){
+ /* NULL */
+ if( item ){
+ SvSetMagicSV(item,&PL_sv_undef);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): arr[%d] =
undef; SvSetMagicSV(item,&PL_sv_undef);\n",
+ i
+ );
+ }
+ }else{
+ av_store(arr,i,&PL_sv_undef);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): arr[%d] =
undef; av_store(arr,i,&PL_sv_undef);\n",
+ i
+ );
+ }
+ }
+ }else{
+ if( (phs->array_indicators[i] == -2) ||
(phs->array_indicators[i] > 0) ){
+ /* Truncation occurred */
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute():
Placeholder '%s': data truncated at %d row.\n",
+ phs->name,i);
+ }
+ }else{
+ /* All OK. Just copy value.*/
+ }
+ if( item ){
+
sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]);
+ SvPOK_only_UTF8(item);
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): arr[%d] =
'%s'; "
+
"sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n",
+ i, phs->array_buf+phs->maxlen*i
+ );
+ }
+ }else{
+
av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
+ if (trace_level >= 3){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): arr[%d] =
'%s'; "
+
"av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
\n",
+ i, phs->array_buf+phs->maxlen*i
+ );
+ }
+ }
+ }
+ }
+ }
+ if (trace_level >= 2){
+ PerlIO_printf(DBILOGFP,
+ "dbd_phs_array_fixup_after_execute(): scalar(@arr)=%d.\n",
+ av_len(arr)+1);
+ }
+ return 1;
+}
+
static int
dbd_rebind_ph_char(SV *sth, imp_sth_t *imp_sth, phs_t *phs, ub2 **alen_ptr_ptr)
{
@@ -1162,7 +1591,7 @@
if (DBIS->debug >= 2) {
char *val = neatsvpv(phs->sv,0);
- PerlIO_printf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val);
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (1): bind %s <== %.1000s
(", phs->name, val);
if (!SvOK(phs->sv))
PerlIO_printf(DBILOGFP, "NULL, ");
PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ",
@@ -1217,7 +1646,7 @@
if (DBIS->debug >= 3) {
UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;
- PerlIO_printf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype
%d, indp %d, at_exec %d)\n",
+ 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 : "",
@@ -1227,7 +1656,6 @@
return 1;
}
-
/*
* Rebind an "in" cursor ref to its real statement handle
* This allows passing cursor refs as "in" to pl/sql (but only if you got the
@@ -1371,10 +1799,34 @@
ub2 csid;
if (trace_level >= 5)
- PerlIO_printf(DBILOGFP, " rebinding %s (%s, ftype %d, csid %d,
csform %d, inout %d)\n",
- phs->name, (SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
+ 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) ? neatspv(phs->sv,0) :
"NULL"),(SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
phs->ftype, phs->csid, phs->csform, phs->is_inout);
+ if( SvROK(phs->sv) ){
+ if (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) { /* Allow only array binds */
+ croak("Reference bind allowed only for ARRAY references, but got %s
for '%s'",
+ neatsvpv(phs->sv,0), phs->name);
+ }
+ if( (phs->ftype == SQLT_CLOB) ||
+ (phs->ftype == SQLT_BLOB) ||
+ (phs->ftype == SQLT_RSET) ){
+
+ croak("Array binding is not allowed for CLOB/BLOB/RSET datatype for
'%s'",
+ phs->name);
+ }
+ switch( phs->ftype ){
+ default:
+ done = dbd_rebind_ph_varchar2_table(sth, 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;
+ }
+ return 0; /* the rebind failed */
+ }
switch (phs->ftype) {
case SQLT_CLOB:
case SQLT_BLOB:
@@ -1435,7 +1887,7 @@
csform = SQLCS_IMPLICIT;
/* else leave csform == 0 */
if (trace_level)
- PerlIO_printf(DBILOGFP, " rebinding %s with UTF8 value %s",
phs->name,
+ PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (2): rebinding %s with
UTF8 value %s", phs->name,
(csform == SQLCS_NCHAR) ? "so setting csform=SQLCS_IMPLICIT"
:
(csform == SQLCS_IMPLICIT) ? "so setting csform=SQLCS_NCHAR" :
"but neither CHAR nor NCHAR are unicode\n");
@@ -1464,7 +1916,7 @@
csid = utf8_csid; /* not al32utf8_csid here on purpose */
if (trace_level >= 3)
- PerlIO_printf(DBILOGFP, " bind %s <== %s "
+ 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),
(phs->is_inout) ? "inout" : "in",
@@ -1529,16 +1981,18 @@
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*/
+ && !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_PVLV) /* hook for later array logic? */
- croak("Can't bind a non-scalar value (%s)", neatsvpv(newvalue,0));
+ /*if (SvTYPE(newvalue) > SVt_PVLV)*/ /* hook for later array logic?
*/
+ 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, " bind %s <== %s (type %ld",
+ 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",
@@ -1551,6 +2005,7 @@
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
*/
@@ -1563,7 +2018,15 @@
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.
+ * If "ora_maxarray_numentries" bind parameter specified,
+ * it would be set below.
+ *
+ * If no ora_maxarray_numentries specified, let it be
+ * the same as scalar(@array) bound.
+ */
+ phs->array_numstruct=0;
if (attribs) { /* only look for ora_type on first bind of var */
SV **svp;
/* Setup / Clear attributes as defined by attribs. */
@@ -1589,6 +2052,9 @@
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 (sql_type)
phs->ftype = ora_sql_type(imp_sth, phs->name, (int)sql_type);
@@ -1835,20 +2301,35 @@
/* 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);
+ }
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( SvROK(sv) ){
+ if (SvTYPE(SvRV(sv))==SVt_PVAV) {
+ /* Array reference */
+ dbd_phs_array_fixup_after_execute(phs);
+ }
+ /*
+ [EMAIL PROTECTED]: Commented out.
+ [EMAIL PROTECTED]: FIXME: What does this code mean ????
+
+ else 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);
+ }
}
- else
- 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);
}
}
@@ -2261,6 +2742,22 @@
if (phs->desc_h)
OCIDescriptorFree_log(phs->desc_h, phs->desc_t);
+ if( phs->array_buf ){
+ free(phs->array_buf);
+ phs->array_buf=NULL;
+ }
+ if( phs->array_indicators ){
+ free(phs->array_indicators);
+ phs->array_indicators=NULL;
+ }
+ if( phs->array_lengths ){
+ free(phs->array_lengths);
+ phs->array_lengths=NULL;
+ }
+
+ phs->array_buflen=0;
+ phs->array_numallocated=0;
+
sv_free(phs->ora_field);
sv_free(phs->sv);
}
Index: dbdimp.h
===================================================================
--- dbdimp.h (revision 9916)
+++ dbdimp.h (working copy)
@@ -105,7 +105,7 @@
OCIStmt *stmhp;
ub2 stmt_type; /* OCIAttrGet OCI_ATTR_STMT_TYPE */
U16 auto_lob;
- int has_lobs;
+ int has_lobs; /* Satement has bound LOBs */
lob_refetch_t *lob_refetch;
int nested_cursor; /* cursors fetched from SELECTs */
@@ -182,6 +182,10 @@
};
+ /* Placeholder structure */
+ /* Note: phs_t is serialized into scalar value, and de-serialized then. */
+ /* Be carefull! */
+
typedef struct phs_st phs_t; /* scalar placeholder */
struct phs_st { /* scalar placeholder EXPERIMENTAL */
@@ -197,6 +201,7 @@
bool is_inout;
IV maxlen; /* max possible len (=allocated buffer) */
+ /* Note: for array bind = buffer for each entry */
OCIBind *bndhp;
void *desc_h; /* descriptor if needed (LOBs etc) */
@@ -211,6 +216,16 @@
int (*out_prepost_exec)_((SV *, imp_sth_t *, phs_t *, int pre_exec));
SV *ora_field; /* from attribute (for LOB binds) */
int alen_incnull; /* 0 or 1 if alen should include null */
+
+ /* Array bind support */
+ char * array_buf; /* Temporary buffer = malloc(array_buflen)
*/
+ int array_buflen; /* Allocated length of array_buf */
+ int array_numstruct; /* Number of bound structures in buffer */
+ OCIInd * array_indicators; /* Indicator array = malloc(
array_numallocated * sizeof(OCIInd) ) */
+ unsigned short *array_lengths; /* Array entries lengths = malloc(
array_numallocated * sizeof(unsigned short) ) */
+ int array_numallocated; /* Allocated number of indicators/lengths */
+ int ora_maxarray_numentries; /* Number of entries to send allocated
to Oracle. (may be less, than total allocated) */
+
char name[1]; /* struct is malloc'd bigger as needed */
};
