DBD-Oracle
view release on metacpan or search on metacpan
{
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 > (unsigned int) 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 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_varchar2_table(): "
"Copying length=%lu array[%d]='%s'.\n",
(unsigned long)itemlen,i,str);
}
}else{
/* Mark NULL */
phs->array_indicators[i]=1;
if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_varchar2_table(): "
"Copying length=%lu array[%d]=NULL (length==0 or ! str) .\n",
(unsigned long)itemlen,i);
}
}
}else{
/* Mark NULL */
phs->array_indicators[i]=1;
if (trace_level >= 3 || dbd_verbose >= 3 ) {
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_varchar2_table(): "
"Copying length=? array[%d]=NULL av_fetch failed.\n", i);
}
}
}
}
/* Do actual bind */
OCIBindByName_log_stat(imp_sth, 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 */
NULL,
(ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */
(ub4 *)&(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(imp_sth, phs->bndhp, imp_sth->errhp,
(unsigned)phs->maxlen, /* Skip parameter for the next data value */
(unsigned)sizeof (OCIInd), /* Skip parameter for the next indicator value */
(unsigned)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(imp_sth, 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(imp_sth, phs->bndhp, OCI_HTYPE_BIND, &phs->csid_orig, NULL,
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 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_varchar2_table(): bind %s <== %s "
"(%s, %s, csid %d->%d->%d, ftype %d, csform %d (%s)->%d (%s), 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,oci_csform_name(phs->csform), csform,oci_csform_name(csform),
(unsigned long)phs->maxlen, (unsigned long)phs->maxdata_size);
if (csid) {
OCIAttrSet_log_stat(imp_sth, 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( SvOK( item ) ){
/* Defined NaN assumed =0 */
*(double*)(phs->array_buf+phs->maxlen*i)=0;
phs->array_indicators[i]=0;
if (trace_level >= 2 || dbd_verbose >= 3 ){
STRLEN l;
char *p=SvPV(item,l);
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_number_table(): "
"let (double) array[%d]=\"%s\" =NaN. Set =0 - NOT NULL\n",
i, p ? p : "<NULL>" );
}
}else{
/* NULL */
phs->array_indicators[i]=1;
if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_number_table(): "
"let (double) array[%d] NULL\n",
i);
}
}
}
phs->array_lengths[i]=sizeof(double);
if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_number_table(): "
"(double) array[%d]=%f%s\n",
i, *(double*)(phs->array_buf+phs->maxlen*i),
phs->array_indicators[i] ? " (NULL)" : "" );
}
}
break;
}
}else{
/* item not defined, mark NULL */
phs->array_indicators[i]=1;
if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"dbd_rebind_ph_number_table(): "
"Copying length=? array[%d]=NULL av_fetch failed.\n", i);
}
}
}
}
/* Do actual bind */
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
phs->array_buf,
phs->maxlen,
(ub2)phs->ora_internal_type, phs->array_indicators,
phs->array_lengths,
NULL,
(ub4)phs->ora_maxarray_numentries, /* max elements that can fit in allocated array */
(ub4 *)&(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(imp_sth, phs->bndhp, imp_sth->errhp,
(unsigned)phs->maxlen, /* Skip parameter for the next data value */
(unsigned)sizeof(OCIInd), /* Skip parameter for the next indicator value */
(unsigned)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;
}
if (phs->maxdata_size) {
OCIAttrSet_log_stat(imp_sth, 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_number_table_post_exe(imp_sth_t *imp_sth, phs_t *phs){
dTHX;
int trace_level = DBIc_DBISTATE(imp_sth)->debug;
AV *arr;
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
croak("dbd_phs_number_table_post_exe(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
}
if (trace_level >= 1 || dbd_verbose >= 3 ){
PerlIO_printf(DBIc_LOGPIO(imp_sth),
"dbd_phs_number_table_post_exe(): Called for '%s' : array_numstruct=%d, maxlen=%ld \n",
phs->name,
phs->array_numstruct,
(long)phs->maxlen
);
}
/* At this point, ora_internal_type can't be default. It must be set at bind time. */
if( (phs->ora_internal_type != SQLT_FLT) &&
(phs->ora_internal_type != SQLT_INT) ){
croak("dbd_rebind_ph_number_table(): Specified internal bind type %d unsupported. "
"SYS.DBMS_SQL.NUMBER_TABLE can be bound only to SQLT_FLT, SQLT_INT datatypes.",
phs->ora_internal_type);
}
arr=(AV*)(SvRV(phs->sv));
/* If no data is returned, just clear the array. */
if( phs->array_numstruct <= 0 ){
( run in 0.886 second using v1.01-cache-2.11-cpan-39bf76dae61 )