DBD-Oracle
view release on metacpan or search on metacpan
case OCI_PTYPE_TYPE_RESULT: return "USER-DEFINED TYPE METHOD'S RESULT";
case OCI_PTYPE_SCHEMA: return "SCHEMA";
case OCI_PTYPE_DATABASE: return "DATABASE";
}
sv = sv_2mortal(newSVpv("",0));
sv_grow(sv, 50);
sprintf(SvPVX(sv),"(UNKNOWN PTYPE Code %d)", ptype);
return SvPVX(sv);
}
*/
char *
oci_exe_mode(ub4 mode)
{
dTHX;
SV *sv;
switch (mode) {
/*----------------------- Execution Modes -----------------------------------*/
case OCI_DEFAULT: return "DEFAULT";
case OCI_BATCH_MODE: return "BATCH_MODE"; /* batch the oci stmt for exec */
case OCI_EXACT_FETCH: return "EXACT_FETCH"; /* fetch exact rows specified */
case OCI_STMT_SCROLLABLE_READONLY : return "STMT_SCROLLABLE_READONLY";
case OCI_DESCRIBE_ONLY: return "DESCRIBE_ONLY"; /* only describe the statement */
case OCI_COMMIT_ON_SUCCESS: return "COMMIT_ON_SUCCESS"; /* commit, if successful exec */
case OCI_NON_BLOCKING: return "NON_BLOCKING"; /* non-blocking */
case OCI_BATCH_ERRORS: return "BATCH_ERRORS"; /* batch errors in array dmls */
case OCI_PARSE_ONLY: return "PARSE_ONLY"; /* only parse the statement */
case OCI_SHOW_DML_WARNINGS: return "SHOW_DML_WARNINGS";
/* case OCI_RESULT_CACHE: return "RESULT_CACHE"; hint to use query caching only 11 so wait this one out*/
/* case OCI_NO_RESULT_CACHE : return "NO_RESULT_CACHE"; hint to bypass query caching*/
}
sv = sv_2mortal(newSVpv("",0));
sv_grow(sv, 50);
sprintf(SvPVX(sv),"(UNKNOWN OCI EXECUTE MODE %d)", mode);
return SvPVX(sv);
}
/* SQL Types we support for placeholders basically we support types that can be returned as strings */
char *
sql_typecode_name(int dbtype) {
dTHX;
SV *sv;
switch(dbtype) {
case 0: return "DEFAULT (varchar)";
case 1: return "VARCHAR";
case 2: return "NVARCHAR2";
case 5: return "STRING";
case 8: return "LONG";
case 21: return "BINARY FLOAT os-endian";
case 22: return "BINARY DOUBLE os-endian";
case 23: return "RAW";
case 24: return "LONG RAW";
case 96: return "CHAR";
case 97: return "CHARZ";
case 100: return "BINARY FLOAT oracle-endian";
case 101: return "BINARY DOUBLE oracle-endian";
case 104: return "ROWID";
case 106: return "MLSLABEL";
case 102: return "SQLT_CUR OCI 7 cursor variable";
case 112: return "SQLT_CLOB / long";
case 113: return "SQLT_BLOB / long";
case 116: return "SQLT_RSET OCI 8 cursor variable";
case ORA_VARCHAR2_TABLE:return "ORA_VARCHAR2_TABLE";
case ORA_NUMBER_TABLE: return "ORA_NUMBER_TABLE";
case ORA_XMLTYPE: return "ORA_XMLTYPE or SQLT_NTY";/* SQLT_NTY must be careful here as its value (108) is the same for an embedded object Well really only XML clobs not embedded objects */
}
sv = sv_2mortal(newSVpv("",0));
sv_grow(sv, 50);
sprintf(SvPVX(sv),"(UNKNOWN SQL TYPECODE %d)", dbtype);
return SvPVX(sv);
}
char *
oci_typecode_name(int typecode){
dTHX;
SV *sv;
switch (typecode) {
case OCI_TYPECODE_INTERVAL_YM: return "INTERVAL_YM";
case OCI_TYPECODE_INTERVAL_DS: return "NTERVAL_DS";
case OCI_TYPECODE_TIMESTAMP_TZ: return "TIMESTAMP_TZ";
case OCI_TYPECODE_TIMESTAMP_LTZ: return "TIMESTAMP_LTZ";
case OCI_TYPECODE_TIMESTAMP: return "TIMESTAMP";
case OCI_TYPECODE_DATE: return "DATE";
case OCI_TYPECODE_CLOB: return "CLOB";
case OCI_TYPECODE_BLOB: return "BLOB";
case OCI_TYPECODE_BFILE: return "BFILE";
case OCI_TYPECODE_RAW: return "RAW";
case OCI_TYPECODE_CHAR: return "CHAR";
case OCI_TYPECODE_VARCHAR: return "VARCHAR";
case OCI_TYPECODE_VARCHAR2: return "VARCHAR2";
case OCI_TYPECODE_SIGNED8: return "SIGNED8";
case OCI_TYPECODE_UNSIGNED8: return "DECLARE";
case OCI_TYPECODE_UNSIGNED16 : return "UNSIGNED8";
case OCI_TYPECODE_UNSIGNED32 : return "UNSIGNED32";
case OCI_TYPECODE_REAL : return "REAL";
case OCI_TYPECODE_DOUBLE : return "DOUBLE";
case OCI_TYPECODE_INTEGER : return "INT";
case OCI_TYPECODE_SIGNED16 : return "SHORT";
case OCI_TYPECODE_SIGNED32 : return "LONG";
case OCI_TYPECODE_DECIMAL : return "DECIMAL";
case OCI_TYPECODE_FLOAT : return "FLOAT";
case OCI_TYPECODE_NUMBER : return "NUMBER";
case OCI_TYPECODE_SMALLINT: return "SMALLINT";
case OCI_TYPECODE_OBJECT: return "OBJECT";
case OCI_TYPECODE_OPAQUE: return "XMLTYPE~OPAQUE";
case OCI_TYPECODE_VARRAY: return "VARRAY";
case OCI_TYPECODE_TABLE: return "TABLE";
case OCI_TYPECODE_NAMEDCOLLECTION: return "NAMEDCOLLECTION";
}
sv = sv_2mortal(newSVpv("",0));
sv_grow(sv, 50);
sprintf(SvPVX(sv),"(UNKNOWN OCI TYPECODE %d)", typecode);
return SvPVX(sv);
}
case OCI_ATTR_OBJID: return "OCI_ATTR_OBJID"; /* object id for a table or view */
case OCI_ATTR_PTYPE: return "OCI_ATTR_PTYPE"; /* type of info described by */
case OCI_ATTR_PARAM: return "OCI_ATTR_PARAM"; /* parameter descriptor */
case OCI_ATTR_OVERLOAD_ID: return "OCI_ATTR_OVERLOAD_ID"; /* overload ID for funcs and procs */
case OCI_ATTR_TABLESPACE: return "OCI_ATTR_TABLESPACE"; /* table name space */
case OCI_ATTR_TDO: return "OCI_ATTR_TDO"; /* TDO of a type */
case OCI_ATTR_LTYPE: return "OCI_ATTR_LTYPE"; /* list type */
case OCI_ATTR_PARSE_ERROR_OFFSET: return "OCI_ATTR_PARSE_ERROR_OFFSET";/* Parse Error offset */
case OCI_ATTR_IS_TEMPORARY: return "OCI_ATTR_IS_TEMPORARY"; /* whether table is temporary */
case OCI_ATTR_IS_TYPED: return "OCI_ATTR_IS_TYPED"; /* whether table is typed */
case OCI_ATTR_DURATION: return "OCI_ATTR_DURATION"; /* duration of temporary table */
case OCI_ATTR_IS_INVOKER_RIGHTS: return "OCI_ATTR_IS_INVOKER_RIGHTS";/* is invoker rights */
case OCI_ATTR_OBJ_NAME: return "OCI_ATTR_OBJ_NAME"; /* top level schema obj name */
case OCI_ATTR_OBJ_SCHEMA: return "OCI_ATTR_OBJ_SCHEMA"; /* schema name */
case OCI_ATTR_OBJ_ID: return "OCI_ATTR_OBJ_ID"; /* top level schema object id */
case OCI_ATTR_DIRPATH_SORTED_INDEX: return "OCI_ATTR_DIRPATH_SORTED_INDEX";/* index that data is sorted on */
/* direct path index maint method (see oci8dp.h) */
case OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD: return "OCI_ATTR_DIRPATH_INDEX_MAINT_METHOD";/* parallel load: db file, initial and next extent sizes */
case OCI_ATTR_DIRPATH_FILE: return "OCI_ATTR_DIRPATH_FILE"; /* DB file to load into */
case OCI_ATTR_DIRPATH_STORAGE_INITIAL: return "OCI_ATTR_DIRPATH_STORAGE_INITIAL"; /* initial extent size */
case OCI_ATTR_DIRPATH_STORAGE_NEXT: return "OCI_ATTR_DIRPATH_STORAGE_NEXT"; /* next extent size */
case OCI_ATTR_TRANS_TIMEOUT: return "OCI_ATTR_TRANS_TIMEOUT"; /* transaction timeout */
case OCI_ATTR_SERVER_STATUS: return "OCI_ATTR_SERVER_STATUS"; /* state of the server handle */
case OCI_ATTR_STATEMENT: return "OCI_ATTR_STATEMENT"; /* statement txt in stmt hdl */
/* statement should not be executed in cache*/
/*case OCI_ATTR_NO_CACHE: return "";*/
case OCI_ATTR_DEQCOND: return "OCI_ATTR_DEQCOND"; /* dequeue condition */
case OCI_ATTR_RESERVED_2: return "OCI_ATTR_RESERVED_2"; /* reserved */
case OCI_ATTR_SUBSCR_RECPT: return "OCI_ATTR_SUBSCR_RECPT"; /* recipient of subscription */
case OCI_ATTR_SUBSCR_RECPTPROTO: return "OCI_ATTR_SUBSCR_RECPTPROTO";/* protocol for recipient */
/* 8.2 dpapi support of ADTs */
case OCI_ATTR_DIRPATH_EXPR_TYPE: return "OCI_ATTR_DIRPATH_EXPR_TYPE"; /* expr type of OCI_ATTR_NAME */
case OCI_ATTR_DIRPATH_INPUT: return "OCI_ATTR_DIRPATH_INPUT"; /* input in text or stream format*/
/* case OCI_DIRPATH_INPUT_TEXT: return "";
case OCI_DIRPATH_INPUT_STREAM: return "";
case OCI_DIRPATH_INPUT_UNKNOWN: return ""; */
case OCI_ATTR_LDAP_HOST: return "OCI_ATTR_LDAP_HOST"; /* LDAP host to connect to */
case OCI_ATTR_LDAP_PORT: return "OCI_ATTR_LDAP_PORT"; /* LDAP port to connect to */
case OCI_ATTR_BIND_DN: return "OCI_ATTR_BIND_DN"; /* bind DN */
case OCI_ATTR_LDAP_CRED: return "OCI_ATTR_LDAP_CRED"; /* credentials to connect to LDAP */
case OCI_ATTR_WALL_LOC: return "OCI_ATTR_WALL_LOC"; /* client wallet location */
case OCI_ATTR_LDAP_AUTH: return "OCI_ATTR_LDAP_AUTH"; /* LDAP authentication method */
case OCI_ATTR_LDAP_CTX: return "OCI_ATTR_LDAP_CTX"; /* LDAP administration context DN */
case OCI_ATTR_SERVER_DNS: return "OCI_ATTR_SERVER_DNS"; /* list of registration server DNs */
case OCI_ATTR_DN_COUNT: return "OCI_ATTR_DN_COUNT"; /* the number of server DNs */
case OCI_ATTR_SERVER_DN: return "OCI_ATTR_SERVER_DN"; /* server DN attribute */
case OCI_ATTR_MAXCHAR_SIZE: return "OCI_ATTR_MAXCHAR_SIZE"; /* max char size of data */
case OCI_ATTR_CURRENT_POSITION: return "OCI_ATTR_CURRENT_POSITION"; /* for scrollable result sets*/
/* Added to get attributes for ref cursor to statement handle */
case OCI_ATTR_RESERVED_3: return "OCI_ATTR_RESERVED_3"; /* reserved */
case OCI_ATTR_RESERVED_4: return "OCI_ATTR_RESERVED_4"; /* reserved */
case OCI_ATTR_DIRPATH_FN_CTX: return ""; /* fn ctx ADT attrs or args */
case OCI_ATTR_DIGEST_ALGO: return "OCI_ATTR_DIRPATH_FN_CTX"; /* digest algorithm */
case OCI_ATTR_CERTIFICATE: return "OCI_ATTR_CERTIFICATE"; /* certificate */
case OCI_ATTR_SIGNATURE_ALGO: return "OCI_ATTR_SIGNATURE_ALGO"; /* signature algorithm */
case OCI_ATTR_CANONICAL_ALGO: return "OCI_ATTR_CANONICAL_ALGO"; /* canonicalization algo. */
case OCI_ATTR_PRIVATE_KEY: return "OCI_ATTR_PRIVATE_KEY"; /* private key */
case OCI_ATTR_DIGEST_VALUE: return "OCI_ATTR_DIGEST_VALUE"; /* digest value */
case OCI_ATTR_SIGNATURE_VAL: return "OCI_ATTR_SIGNATURE_VAL"; /* signature value */
case OCI_ATTR_SIGNATURE: return "OCI_ATTR_SIGNATURE"; /* signature */
/* attributes for setting OCI stmt caching specifics in svchp */
case OCI_ATTR_STMTCACHESIZE : return "OCI_ATTR_STMTCACHESIZE"; /* size of the stm cache */
/* --------------------------- Connection Pool Attributes ------------------ */
case OCI_ATTR_CONN_NOWAIT: return "OCI_ATTR_CONN_NOWAIT";
case OCI_ATTR_CONN_BUSY_COUNT: return "OCI_ATTR_CONN_BUSY_COUNT";
case OCI_ATTR_CONN_OPEN_COUNT: return "OCI_ATTR_CONN_OPEN_COUNT";
case OCI_ATTR_CONN_TIMEOUT: return "OCI_ATTR_CONN_TIMEOUT";
case OCI_ATTR_STMT_STATE: return "OCI_ATTR_STMT_STATE";
case OCI_ATTR_CONN_MIN: return "OCI_ATTR_CONN_MIN";
case OCI_ATTR_CONN_MAX: return "OCI_ATTR_CONN_MAX";
case OCI_ATTR_CONN_INCR: return "OCI_ATTR_CONN_INCR";
case OCI_ATTR_DIRPATH_OID: return "OCI_ATTR_DIRPATH_OID"; /* loading into an OID col */
case OCI_ATTR_NUM_OPEN_STMTS: return "OCI_ATTR_NUM_OPEN_STMTS"; /* open stmts in session */
case OCI_ATTR_DESCRIBE_NATIVE: return "OCI_ATTR_DESCRIBE_NATIVE"; /* get native info via desc */
case OCI_ATTR_BIND_COUNT: return "OCI_ATTR_BIND_COUNT"; /* number of bind postions */
case OCI_ATTR_HANDLE_POSITION: return "OCI_ATTR_HANDLE_POSITION"; /* pos of bind/define handle */
case OCI_ATTR_RESERVED_5: return "OCI_ATTR_RESERVED_5"; /* reserved */
case OCI_ATTR_SERVER_BUSY: return "OCI_ATTR_SERVER_BUSY"; /* call in progress on server*/
case OCI_ATTR_DIRPATH_SID: return "OCI_ATTR_DIRPATH_SID"; /* loading into an SID col */
/* notification presentation for recipient */
case OCI_ATTR_SUBSCR_RECPTPRES: return "OCI_ATTR_SUBSCR_RECPTPRES";
case OCI_ATTR_TRANSFORMATION: return "OCI_ATTR_TRANSFORMATION"; /* AQ message transformation */
case OCI_ATTR_ROWS_FETCHED: return "OCI_ATTR_ROWS_FETCHED"; /* rows fetched in last call */
/* --------------------------- Snapshot attributes ------------------------- */
case OCI_ATTR_SCN_BASE: return "OCI_ATTR_SCN_BASE"; /* snapshot base */
case OCI_ATTR_SCN_WRAP: return "OCI_ATTR_SCN_WRAP"; /* snapshot wrap */
/* --------------------------- Miscellaneous attributes --------------------- */
case OCI_ATTR_RESERVED_6: return "OCI_ATTR_RESERVED_6"; /* reserved */
case OCI_ATTR_READONLY_TXN: return "OCI_ATTR_READONLY_TXN"; /* txn is readonly */
case OCI_ATTR_RESERVED_7: return "OCI_ATTR_RESERVED_7"; /* reserved */
case OCI_ATTR_ERRONEOUS_COLUMN: return "OCI_ATTR_ERRONEOUS_COLUMN"; /* position of erroneous col */
case OCI_ATTR_RESERVED_8: return "OCI_ATTR_RESERVED_8"; /* reserved */
/* -------------------- 8.2 dpapi support of ADTs continued ---------------- */
case OCI_ATTR_DIRPATH_OBJ_CONSTR: return "OCI_ATTR_DIRPATH_OBJ_CONSTR"; /* obj type of subst obj tbl */
/************************FREE attribute 207 *************************/
/************************FREE attribute 208 *************************/
case OCI_ATTR_ENV_UTF16: return "OCI_ATTR_ENV_UTF16"; /* is env in utf16 mode? */
case OCI_ATTR_RESERVED_9: return "OCI_ATTR_RESERVED_9"; /* reserved for TMZ */
int oraperl = DBIc_COMPAT(imp_sth);
if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh->ora_trunc))) {
/* user says truncation is ok */
/* Oraperl recorded the truncation in ora_errno so we */
/* so also but only for Oraperl mode handles. */
if (oraperl) sv_setiv(DBIc_ERR(imp_sth), 1406);
} else {
char buf[300];
sprintf(buf,"fetching field %d of %d. LONG value truncated from %lu to %lu. %s",
fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth), ul_t(datalen), ul_t(bytelen),
"DBI attribute LongReadLen too small and/or LongTruncOk not set");
oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error number */
sv_set_undef(dest_sv);
return 0;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" fetching field %d of %d. LONG value truncated from "
"%lu to %lu.\n",
fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth),
ul_t(datalen), ul_t(bytelen));
datalen = bytelen;
}
}
sv_setpvn(dest_sv, p, (STRLEN)datalen);
if (CSFORM_IMPLIES_UTF8(fbh->csform))
SvUTF8_on(dest_sv);
} else {
#else
{
#endif
sv_setpvn(dest_sv, p, (STRLEN)datalen);
}
return 1;
}
static void
fetch_cleanup_rset(SV *sth, imp_fbh_t *fbh)
{
dTHX;
D_imp_sth(sth);
SV *sth_nested = (SV *)fbh->special;
fbh->special = NULL;
if( sth ) { /* For GCC not to warn on unused parameter */ }
if (sth_nested) {
dTHR;
D_impdata(imp_sth_nested, imp_sth_t, sth_nested);
int fields = DBIc_NUM_FIELDS(imp_sth_nested);
int i;
for(i=0; i < fields; ++i) {
imp_fbh_t *fbh_nested = &imp_sth_nested->fbh[i];
if (fbh_nested->fetch_cleanup)
fbh_nested->fetch_cleanup(sth_nested, fbh_nested);
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(DBIc_LOGPIO(imp_sth),
" fetch_cleanup_rset - deactivating handle %s (defunct nested cursor)\n",
neatsvpv(sth_nested, 0));
DBIc_ACTIVE_off(imp_sth_nested);
SvREFCNT_dec(sth_nested);
}
}
static int
fetch_func_rset(SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
dTHX;
OCIStmt *stmhp_nested = ((OCIStmt **)fbh->fb_ary->abuf)[0];
dTHR;
D_imp_sth(sth);
D_imp_dbh_from_sth;
dSP;
HV *init_attr = newHV();
int count;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" fetch_func_rset - allocating handle for cursor nested within %s ...\n",
neatsvpv(sth, 0));
ENTER; SAVETMPS; PUSHMARK(SP);
XPUSHs(sv_2mortal(newRV((SV*)DBIc_MY_H(imp_dbh))));
XPUSHs(sv_2mortal(newRV((SV*)init_attr)));
PUTBACK;
count = perl_call_pv("DBI::_new_sth", G_ARRAY);
SPAGAIN;
if (count != 2)
croak("panic: DBI::_new_sth returned %d values instead of 2", count);
if(POPs){} /* For GCC not to warn on unused result */
sv_setsv(dest_sv, POPs);
SvREFCNT_dec(init_attr);
PUTBACK; FREETMPS; LEAVE;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" fetch_func_rset - ... allocated %s for nested cursor\n",
neatsvpv(dest_sv, 0));
fbh->special = (void *)newSVsv(dest_sv);
{
D_impdata(imp_sth_nested, imp_sth_t, dest_sv);
imp_sth_nested->envhp = imp_sth->envhp;
imp_sth_nested->errhp = imp_sth->errhp;
imp_sth_nested->srvhp = imp_sth->srvhp;
imp_sth_nested->svchp = imp_sth->svchp;
imp_sth_nested->stmhp = stmhp_nested;
imp_sth_nested->nested_cursor = 1;
imp_sth_nested->stmt_type = OCI_STMT_SELECT;
DBIc_IMPSET_on(imp_sth_nested);
DBIc_ACTIVE_on(imp_sth_nested); /* So describe won't do an execute */
if (!dbd_describe(dest_sv, imp_sth_nested))
return 0;
}
return 1;
}
/* ------ */
int
dbd_rebind_ph_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
dTHX;
if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_rebind_ph_rset phs->is_inout=%d\n",
phs->is_inout);
/* Only do this part for inout cursor refs because pp_exec_rset only gets called for all the output params */
if (phs->is_inout) {
phs->out_prepost_exec = pp_exec_rset;
return 2; /* OCI bind done */
}
else {
/* Call a special rebinder for cursor ref "in" params */
return(pp_rebind_ph_rset_in(sth, imp_sth, phs));
}
}
/* ------ */
static int
fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV *dest_sv, char *name);
static int
lob_phs_post_execute(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
{
dTHX;
if (pre_exec)
return 1;
/* fetch PL/SQL LOB data */
if (imp_sth->auto_lob && (
imp_sth->stmt_type == OCI_STMT_BEGIN ||
imp_sth->stmt_type == OCI_STMT_DECLARE )) {
return fetch_lob(sth, imp_sth, (OCILobLocator*) phs->desc_h, phs->ftype, phs->sv, phs->name);
}
sv_setref_pv(phs->sv, "OCILobLocatorPtr", (void*)phs->desc_h);
return 1;
}
int
dbd_rebind_ph_lob(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
dTHX;
D_imp_dbh_from_sth ;
sword status;
ub4 lobEmpty = 0;
if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB)
ora_free_templob(sth, imp_sth, (OCILobLocator*)phs->desc_h);
if (!phs->desc_h) {
++imp_sth->has_lobs;
phs->desc_t = OCI_DTYPE_LOB;
OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp,
&phs->desc_h, phs->desc_t);
}
OCIAttrSet_log_stat(imp_sth, phs->desc_h, phs->desc_t,
&lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);
if (status != OCI_SUCCESS)
return oci_error(sth, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_LOBEMPTY");
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, &PL_na);
}
else { /* ensure we're at least an SVt_PV (so SvPVX etc work) */
(void)SvUPGRADE(phs->sv, SVt_PV);
}
}
if (SvOK(imp_drh->ora_cache_o)){
imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o);
}
else if (SvOK(imp_drh->ora_cache)){
imp_sth->cache_rows = SvIV(imp_drh->ora_cache);
}
prefetch_rows =imp_sth->prefetch_rows;
prefetch_mem =imp_sth->prefetch_memory;
if (!cache_rows) { /*start with this value if not set then set default cache */
cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,0);
if(!prefetch_rows && !prefetch_mem){ /*if there are not prefetch rows make sure I set it here to the default*/
prefetch_rows=cache_rows;
}
}
else if (imp_dbh->RowCacheSize < 0) {/* for compaibility with DBI doc negitive value here means use the value as memory*/
prefetch_mem =-imp_dbh->RowCacheSize; /* cache_mem always +ve here */
prefetch_rows =0;
cache_rows=calc_cache_rows(imp_sth->cache_rows,(int)num_fields, imp_sth->est_width, has_longs,prefetch_mem);
/*The above fucntion will set the cache_rows using memory as the limit*/
}
else {
if (!prefetch_mem){
prefetch_rows = cache_rows; /*use the RowCacheSize*/
}
}
if (cache_rows <= prefetch_rows){
cache_rows=prefetch_rows;
/* is prefetch_rows are greater than the RowCahceSize then use prefetch_rows*/
}
OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT,
&prefetch_mem, sizeof(prefetch_mem), OCI_ATTR_PREFETCH_MEMORY,
imp_sth->errhp, status);
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status,
"OCIAttrSet OCI_ATTR_PREFETCH_MEMORY");
++num_errors;
}
OCIAttrSet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT,
&prefetch_rows, sizeof(prefetch_rows), OCI_ATTR_PREFETCH_ROWS,
imp_sth->errhp, status);
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_PREFETCH_ROWS");
++num_errors;
}
imp_sth->rs_array_size=cache_rows;
if (max_cache_rows){/* limited to 1 by a cursor or something else*/
imp_sth->rs_array_size=1;
}
if (imp_sth->row_cache_off){/*set the size of the Rows in Cache value*/
imp_dbh->RowsInCache =1;
imp_sth->RowsInCache =1;
}
else {
imp_dbh->RowsInCache=imp_sth->rs_array_size;
imp_sth->RowsInCache=imp_sth->rs_array_size;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 || oci_warn) /*will also display if oci_warn is on*/
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" cache settings DB Handle RowCacheSize=%d,Statement Handle "
"RowCacheSize=%d, OCI_ATTR_PREFETCH_ROWS=%lu, "
"OCI_ATTR_PREFETCH_MEMORY=%lu, Rows per Fetch=%d, Multiple Row Fetch=%s\n",
imp_dbh->RowCacheSize, imp_sth->RowCacheSize,
(unsigned long) (prefetch_rows), (unsigned long) (prefetch_mem),
cache_rows,(imp_sth->row_cache_off)?"Off":"On");
return num_errors;
}
/*recurses down the field's TDOs and saves the little bits it need for later use on a fetch fbh->obj */
int
describe_obj(SV *sth,imp_sth_t *imp_sth,OCIParam *parm,fbh_obj_t *obj,int level )
{
dTHX;
sword status;
OCIRef *type_ref;
if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ) {
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"At level=%d in description an embedded object \n",level);
}
/*Describe the field (OCIParm) we know it is a object or a collection */
/* Get the Actual TDO */
OCIAttrGet_parmdp(imp_sth,parm, &type_ref, 0, OCI_ATTR_REF_TDO, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIAttrGet");
return 0;
}
OCITypeByRef_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
type_ref,
&obj->tdo,
status);
int
dump_struct(imp_sth_t *imp_sth,fbh_obj_t *obj,int level){
dTHX;
int i;
/*dumps the contents of the current fbh->obj*/
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " level=%d type_name = %s\n",level,obj->type_name);
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " type_namel = %u\n",obj->type_namel);
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " parmdp = %p\n",obj->parmdp);
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " parmap = %p\n",obj->parmap);
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " tdo = %p\n",obj->tdo);
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " typecode = %s\n",oci_typecode_name(obj->typecode));
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " col_typecode = %d\n",obj->col_typecode);
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" element_typecode = %s\n",oci_typecode_name(obj->element_typecode));
PerlIO_printf(
DBIc_LOGPIO(imp_sth), " obj_ref = %p\n",obj->obj_ref);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_value = %p\n",obj->obj_value);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " obj_type = %p\n",obj->obj_type);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " is_final_type = %u\n",obj->is_final_type);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " field_count = %d\n",obj->field_count);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " fields = %p\n",obj->fields);
for (i = 0; i < obj->field_count;i++){
fbh_obj_t *fld = &obj->fields[i];
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" \n--->sub objects\n ");
dump_struct(imp_sth,fld,level+1);
}
PerlIO_printf(DBIc_LOGPIO(imp_sth), " \n--->done %s\n ",obj->type_name);
return 1;
}
int
dbd_describe(SV *h, imp_sth_t *imp_sth)
{
dTHX;
D_imp_dbh_from_sth;
D_imp_drh_from_dbh;
UV long_readlen;
ub4 num_fields;
int num_errors = 0;
int has_longs = 0;
int est_width = 0; /* estimated avg row width (for cache) */
int nested_cursors = 0;
ub4 i = 0;
sword status;
if (imp_sth->done_desc)
return 1; /* success, already done it */
imp_sth->done_desc = 1;
/* ora_trunc is checked at fetch time */
/* long_readlen: length for long/longraw (if >0), else 80 (ora app dflt) */
/* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */
long_readlen = (SvOK(imp_drh -> ora_long) && SvUV(imp_drh->ora_long)>0)
? SvUV(imp_drh->ora_long) : DBIc_LongReadLen(imp_sth);
/* set long_readlen for SELECT or PL/SQL with output placeholders */
imp_sth->long_readlen = long_readlen;
if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_fields test below */
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_describe skipped for %s\n",
oci_stmt_type_name(imp_sth->stmt_type));
/* imp_sth memory was cleared when created so no setup required here */
return 1;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_describe %s (%s, lb %lu)...\n",
oci_stmt_type_name(imp_sth->stmt_type),
DBIc_ACTIVE(imp_sth) ? "implicit" : "EXPLICIT", (unsigned long)long_readlen);
/* We know it's a select and we've not got the description yet, so if the */
/* sth is not 'active' (executing) then we need an explicit describe. */
if ( !DBIc_ACTIVE(imp_sth) ) {
OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
0, 0, 0, 0, OCI_DESCRIBE_ONLY, status);
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status,
ora_sql_error(imp_sth, "OCIStmtExecute/Describe"));
if (status != OCI_SUCCESS_WITH_INFO)
return 0;
}
}
OCIAttrGet_stmhp_stat(imp_sth, &num_fields, 0, OCI_ATTR_PARAM_COUNT, status);
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_PARAM_COUNT");
return 0;
}
if (num_fields == 0) {
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_describe skipped for %s (no fields returned)\n",
oci_stmt_type_name(imp_sth->stmt_type));
fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
if (!imp_sth->piece_size){ /*if not set use max value*/
imp_sth->piece_size=imp_sth->long_readlen;
}
if (fbh->dbtype == ORA_CLOB){
fbh->ftype = SQLT_CHR;
} else {
fbh->ftype = SQLT_BIN; /*other Binary*/
}
fbh->fetch_func = fetch_clbk_lob;
}
else if (imp_sth->piece_lob){ /*get by peice with polling slowest*/
fbh->piece_lob = 1;
fbh->define_mode = OCI_DYNAMIC_FETCH; /* piecwise fetch*/
fbh->disize = imp_sth->long_readlen; /*user set max value for the fetch*/
fbh->piece_size = imp_sth->piece_size; /*the size for each piece*/
fbh->fetch_cleanup = fetch_cleanup_pres_lobs; /* clean up buffer before each fetch*/
if (!imp_sth->piece_size){ /*if not set use max value*/
imp_sth->piece_size=imp_sth->long_readlen;
}
if (fbh->dbtype == ORA_CLOB){
fbh->ftype = SQLT_CHR;
}
else {
fbh->ftype = SQLT_BIN; /*other Binary */
}
fbh->fetch_func = fetch_get_piece;
}
else { /*auto lob fetch with locator by far the fastest*/
fbh->disize = sizeof(OCILobLocator*);/* Size of the lob locator ar we do not really get the lob! */
if (imp_sth->auto_lob) {
fbh->fetch_func = fetch_func_autolob;
}
else {
fbh->fetch_func = fetch_func_getrefpv;
}
fbh->bless = "OCILobLocatorPtr";
fbh->desc_t = OCI_DTYPE_LOB;
OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &fbh->desc_h, fbh->desc_t);
}
break;
#ifdef OCI_DTYPE_REF
case 111: /* REF */
fbh_setup_getrefpv(imp_sth, fbh, OCI_DTYPE_REF, "OCIRefPtr");
break;
#endif
case ORA_RSET: /* RSET */
fbh->ftype = fbh->dbtype;
fbh->disize = sizeof(OCIStmt *);
fbh->fetch_func = fetch_func_rset;
fbh->fetch_cleanup = fetch_cleanup_rset;
nested_cursors++;
break;
case 182: /* INTERVAL YEAR TO MONTH */
case 183: /* INTERVAL DAY TO SECOND */
case 185: /* TIME (ocidfn.h) */
case 186: /* TIME WITH TIME ZONE (ocidfn.h) */
case 187: /* TIMESTAMP */
case 188: /* TIMESTAMP WITH TIME ZONE */
case 189: /* INTERVAL YEAR TO MONTH (ocidfn.h) */
case 190: /* INTERVAL DAY TO SECOND */
case 232: /* TIMESTAMP WITH LOCAL TIME ZONE */
/* actually dependent on NLS default date format*/
fbh->disize = 75; /* XXX */
break;
default:
/* XXX unhandled type may lead to errors or worse */
fbh->ftype = fbh->dbtype;
fbh->disize = fbh->dbsize;
p = "Field %d has an Oracle type (%d) which is not explicitly supported%s";
if (DBIc_DBISTATE(imp_sth)->debug >= 1 || dbd_verbose >= 3 )
PerlIO_printf(DBIc_LOGPIO(imp_sth), p, i, fbh->dbtype, "\n");
if (PL_dowarn)
warn(p, i, fbh->dbtype, "");
break;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"Described col %2d: dbtype %d(%s), scale %d, prec %d, nullok %d, "
"name %s\n : dbsize %d, char_used %d, char_size %d, "
"csid %d, csform %d(%s), disize %d\n",
i, fbh->dbtype, sql_typecode_name(fbh->dbtype), fbh->scale,
fbh->prec, fbh->nullok, fbh->name, fbh->dbsize,
fbh->len_char_used, fbh->len_char_size,
fbh->csid,fbh->csform,oci_csform_name(fbh->csform), fbh->disize);
if (fbh->ftype == 5) /* XXX need to handle wide chars somehow */
fbh->disize += 1; /* allow for null terminator */
/* dbsize can be zero for 'select NULL ...' */
imp_sth->t_dbsize += fbh->dbsize;
if (!avg_width)
avg_width = fbh->dbsize;
est_width += avg_width;
if (DBIc_DBISTATE(imp_sth)->debug >= 2 || dbd_verbose >= 3 )
dbd_fbh_dump(imp_sth, fbh, (int)i, 0);
}/* end define of filed struct[i] fbh*/
imp_sth->est_width = est_width;
sth_set_row_cache(h, imp_sth,
(imp_dbh->max_nested_cursors) ? 0 :nested_cursors ,
(int)num_fields, has_longs );
/* Initialise cache counters */
imp_sth->in_cache = 0;
imp_sth->eod_errno = 0;
/*rs_array_init(imp_sth);*/
/* now set up the oci call with define by pos*/
for(i=1; i <= num_fields; ++i) {
imp_fbh_t *fbh = &imp_sth->fbh[i-1];
int ftype = fbh->ftype;
/* add space for STRING null term, or VAR len prefix */
sb4 define_len = (ftype==94||ftype==95) ? fbh->disize+4 : fbh->disize;
fb_ary_t *fb_ary;
if (fbh->clbk_lob || fbh->piece_lob ){/*init the cb_abuf with this call*/
fbh->fb_ary = fb_ary_cb_alloc(imp_sth->piece_size,define_len, imp_sth->rs_array_size);
} else {
fbh->fb_ary = fb_ary_alloc(define_len, imp_sth->rs_array_size);
}
fb_ary = fbh->fb_ary;
if (fbh->ftype == SQLT_BIN) {
define_len++;
/*add one extra byte incase the size of the lob is equal to the define_len*/
}
if (fbh->ftype == ORA_RSET) { /* RSET */
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp,
(dvoid*)&((OCIStmt **)fb_ary->abuf)[0],
OCI_HTYPE_STMT, status);
}
OCIDefineByPos_log_stat(imp_sth, imp_sth->stmhp,
&fbh->defnp,
imp_sth->errhp,
(ub4) i,
(fbh->desc_h) ? (dvoid*)&fbh->desc_h : fbh->clbk_lob ? (dvoid *) 0: fbh->piece_lob ? (dvoid *) 0:(dvoid*)fb_ary->abuf,
(fbh->desc_h) ? 0 : define_len,
(ub2)fbh->ftype,
fb_ary->aindp,
(ftype==94||ftype==95) ? NULL : fb_ary->arlen,
fb_ary->arcode,
fbh->define_mode,
status);
if (fbh->clbk_lob){
/* use a dynamic callback for persistent binary and char lobs*/
OCIDefineDynamic_log_stat(imp_sth, fbh->defnp,imp_sth->errhp,(dvoid *) fbh,status);
}
if (fbh->ftype == 108) { /* Embedded object bind it differently*/
if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"Field #%d is a object or colection of some sort. "
if (status != OCI_SUCCESS) {
oci_error(h,imp_sth->errhp, status, "OCIDefineObject");
++num_errors;
}
}
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIDefineByPos");
++num_errors;
}
#ifdef OCI_ATTR_CHARSET_FORM
if ( (fbh->dbtype == 1) && fbh->csform ) {
/* csform may be 0 when talking to Oracle 8.0 database*/
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" calling OCIAttrSet OCI_ATTR_CHARSET_FORM with csform=%d (%s)\n",
fbh->csform,oci_csform_name(fbh->csform) );
OCIAttrSet_log_stat(imp_sth, fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform,
(ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM, imp_sth->errhp, status );
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_CHARSET_FORM");
++num_errors;
}
}
#endif /* OCI_ATTR_CHARSET_FORM */
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_describe'd %d columns (row bytes: %d max, %d est avg, cache: %d)\n",
(int)num_fields, imp_sth->t_dbsize, imp_sth->est_width,
imp_sth->prefetch_rows);
return (num_errors>0) ? 0 : 1;
}
AV *
dbd_st_fetch(SV *sth, imp_sth_t *imp_sth){
dTHX;
D_imp_xxh(sth);
sword status;
D_imp_dbh_from_sth;
int num_fields = DBIc_NUM_FIELDS(imp_sth);
int ChopBlanks;
int err;
int i;
AV *av;
/* Check that execute() was executed sucessfully. This also implies */
/* that dbd_describe() executed sucessfuly so the memory buffers */
/* are allocated and bound. */
if ( !DBIc_ACTIVE(imp_sth) ) {
oci_error(sth, NULL, OCI_ERROR, imp_sth->nested_cursor ?
"nested cursor is defunct (parent row is no longer current)" :
"no statement executing (perhaps you need to call execute first)");
return Nullav;
}
for(i=0; i < num_fields; ++i) {
imp_fbh_t *fbh = &imp_sth->fbh[i];
if (fbh->fetch_cleanup)
fbh->fetch_cleanup(sth, fbh);
}
if (ora_fetchtest && DBIc_ROW_COUNT(imp_sth)>0) {
--ora_fetchtest; /* trick for testing performance */
status = OCI_SUCCESS;
}
else {
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth));
}
if (imp_sth->fetch_orient != OCI_DEFAULT) {
if (imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY)
croak ("attempt to use a scrollable cursor without first setting ora_exe_mode to OCI_STMT_SCROLLABLE_READONLY\n") ;
if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" Scrolling Fetch, position before fetch=%d, "
"Orientation = %s , Fetchoffset =%d\n",
imp_sth->fetch_position, oci_fetch_options(imp_sth->fetch_orient),
imp_sth->fetch_offset);
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1, imp_sth->fetch_orient,imp_sth->fetch_offset, status);
/*this will work without a round trip so might as well open it up for all statments handles*/
/* default and OCI_FETCH_NEXT are the same so this avoids miscaluation on the next value*/
if (status==OCI_NO_DATA){
return Nullav;
}
OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status);
if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" Scrolling Fetch, postion after fetch=%d\n",
imp_sth->fetch_position);
}
else {
if (imp_sth->row_cache_off){ /*Do not use array fetch or local cache */
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT, OCI_DEFAULT, status);
imp_sth->rs_fetch_count++;
imp_sth->rs_array_idx=0;
}
else { /*Array Fetch the New Normal Super speedy and very nice*/
imp_sth->rs_array_idx++;
if (imp_sth->rs_array_num_rows<=imp_sth->rs_array_idx && (imp_sth->rs_array_status==OCI_SUCCESS || imp_sth->rs_array_status==OCI_SUCCESS_WITH_INFO)) {
/* PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_fetch fields...b\n");*/
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp,imp_sth->errhp,imp_sth->rs_array_size,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status);
imp_sth->rs_array_status=status;
imp_sth->rs_fetch_count++;
if (oci_warn && (imp_sth->rs_array_status == OCI_SUCCESS_WITH_INFO)) {
oci_error(sth, imp_sth->errhp, status, "OCIStmtFetch");
}
OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->rs_array_num_rows,0,OCI_ATTR_ROWS_FETCHED, status);
imp_sth->rs_array_idx=0;
imp_dbh->RowsInCache =imp_sth->rs_array_size;
imp_sth->RowsInCache =imp_sth->rs_array_size;
if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 || oci_warn)
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"...Fetched %d rows\n",imp_sth->rs_array_num_rows);
}
imp_dbh->RowsInCache--;
imp_sth->RowsInCache--;
( run in 0.802 second using v1.01-cache-2.11-cpan-39bf76dae61 )