DBD-Oracle
view release on metacpan or search on metacpan
Makefile.PL view on Meta::CPAN
my @files = map { ($_,$_.'0') } qw(
oratclsh lsnrctl oemevent onrsd osslogin tnslsnr
tnsping trcasst trcroute cmctl cmadmin cmgw names namesctl otrccref
otrcfmt otrcrep otrccol
);
my @bad;
foreach (@files) {
my $file = "$ENV{ORACLE_HOME}/bin/$_";
my ($mode) = (stat($file))[2];
next unless defined $mode;
push @bad, $file if ($mode & 04000 and $mode & 00111)
or ($mode & 02000 and $mode & 00111);
}
return unless @bad;
print "\n";
warn "*** WARNING - YOUR ORACLE INSTALLATION HAS A SECURITY PROBLEM.$BELL\n";
warn " This is just a warning. It does not affect DBD::Oracle in any way.\n\n";
sleep 6;
mode = OCI_DEFAULT;
DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode);
flags = OCI_DEFAULT;
DBD_ATTRIB_GET_IV(attribs, "ora_flags", 9, svp, flags);
admhp = (OCIAdmin*)0;
if ((svp=DBD_ATTRIB_GET_SVP(attribs, "ora_pfile", 9)) && SvOK(*svp)) {
if (!SvPOK(*svp))
croak("ora_pfile is not a string");
str = (text*)SvPV(*svp, svp_len);
OCIHandleAlloc(imp_dbh->envhp, (dvoid**)&admhp, (ub4)OCI_HTYPE_ADMIN, (size_t)0, (dvoid**)0);
OCIAttrSet_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, (dvoid*)str, (ub4)svp_len, (ub4)OCI_ATTR_ADMIN_PFILE, (OCIError*)imp_dbh->errhp, status);
}
OCIDBStartup_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, flags, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCIDBStartup");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = &PL_sv_yes;
}
if (admhp) OCIHandleFree_log_stat(imp_dbh, (dvoid*)admhp, (ub4)OCI_HTYPE_ADMIN, status);
#else
croak("OCIDBStartup not available");
#endif
void
ora_db_shutdown(dbh, attribs)
SV *dbh
SV *attribs
PREINIT:
#if defined(ORA_OCI_102)
ub4 mode;
OCIAdmin *admhp;
#endif
CODE:
#if defined(ORA_OCI_102)
SV **svp;
mode = OCI_DEFAULT;
DBD_ATTRIB_GET_IV(attribs, "ora_mode", 8, svp, mode);
admhp = (OCIAdmin*)0;
OCIDBShutdown_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, admhp, mode, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCIDBShutdown");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = &PL_sv_yes;
}
#else
croak("OCIDBShutdown not available");
#endif
void
ora_can_taf(dbh)
SV *dbh
PREINIT:
D_imp_dbh(dbh);
sword status;
ub4 can_taf = 0;
CODE:
#ifdef OCI_ATTR_TAF_ENABLED
OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
if (status != OCI_SUCCESS) {
# else
if ( 1 ) {
# endif
oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_TAF_ENABLED");
XSRETURN_IV(0);
}
else {
XSRETURN_IV(can_taf);
* e.g., 10.2.0.4 does not have it and 10.2.0.5 does
* see http://comments.gmane.org/gmane.comp.lang.perl.modules.dbi.general/16206
* We don't do versions to that accuracy so for AIX you have
* to wait until 11.2 for OCIPing.
*
* Further comments on dbi-dev
* "DBD::Oracle RTs a summary and request for help" suggested it
* was Oracle bug 5759845 and fixes in 10.2.0.2.
*/
#if !defined(ORA_OCI_102) || (defined(_AIX) && !defined(ORA_OCI_112))
OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
#else
vernum = ora_db_version(dbh,imp_dbh);
/* OCIPing causes server failures if called against server ver < 10.2 */
if (((int)((vernum>>24) & 0xFF) < 10 ) || (((int)((vernum>>24) & 0xFF) == 10 ) && ((int)((vernum>>20) & 0x0F) < 2 ))){
OCIServerVersion_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
} else {
OCIPing_log_stat(imp_dbh, imp_dbh->svchp,imp_dbh->errhp,status);
}
#endif
if (status != OCI_SUCCESS){
XSRETURN_IV(0);
} else {
XSRETURN_IV(1);
}
}
ub1 csform;
CODE:
csid = 0;
csform = SQLCS_IMPLICIT;
bufp = SvPV(data, data_len);
amtp = data_len;
/* if locator is CLOB and data is UTF8 and not in bytes pragma */
/* 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, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
ST(0) = &PL_sv_undef;
return;
}
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat(imp_dbh,
imp_dbh->envhp,
imp_dbh->errhp,
locator,
&csid,
status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
ST(0) = &PL_sv_undef;
return;
}
#endif /* OCI_ATTR_CHARSET_ID */
/* if data is utf8 but charset isn't then switch to utf8 csid */
csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
OCILobWrite_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
&amtp, (ub4)offset,
bufp, (ub4)data_len, OCI_ONE_PIECE,
NULL, NULL,
(ub2)0, csform , status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobWrite");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = &PL_sv_yes;
ub2 csid;
CODE:
csid = 0;
csform = SQLCS_IMPLICIT;
bufp = SvPV(data, data_len);
amtp = data_len;
/* if locator is CLOB and data is UTF8 and not in bytes pragma */
/* if (1 && SvUTF8(data) && !IN_BYTES) */
/* added by lab: */
/* LAB do something about length here? see above comment */
OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
ST(0) = &PL_sv_undef;
return;
}
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat(imp_dbh,
imp_dbh->envhp,
imp_dbh->errhp,
locator,
&csid,
status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetId");
ST(0) = &PL_sv_undef;
return;
}
#endif /* OCI_ATTR_CHARSET_ID */
/* if data is utf8 but charset isn't then switch to utf8 csid */
csid = (SvUTF8(data) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
&amtp, bufp, (ub4)data_len, OCI_ONE_PIECE,
NULL, NULL,
csid, csform, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobWriteAppend");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = &PL_sv_yes;
}
if (length > 0) {
SvPOK_on(dest_sv);
bufp_len = SvLEN(dest_sv); /* XXX bytes not chars? (lab: yes) */
bufp = SvPVX(dest_sv);
amtp = length; /* if utf8 and clob/nclob: in: chars, out: bytes */
/* http://www.lc.leidenuniv.nl/awcourse/oracle/appdev.920/a96584/oci16m40.htm#427818 */
/* 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: */
OCILobCharSetForm_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, locator, &csform, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobCharSetForm");
dest_sv = &PL_sv_undef;
return;
}
{
/* see rt 75163 */
boolean is_open;
OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &is_open, status);
if (status == OCI_SUCCESS && !is_open) {
OCILobFileOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
(ub1)OCI_FILE_READONLY, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobFileOpen");
dest_sv = &PL_sv_undef;
}
}
}
OCILobRead_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator,
&amtp, (ub4)offset, /* offset starts at 1 */
bufp, (ub4)bufp_len,
0, 0, (ub2)0, csform, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobRead");
dest_sv = &PL_sv_undef;
}
else {
SvCUR(dest_sv) = amtp; /* always bytes here */
*SvEND(dest_sv) = '\0';
void
ora_lob_trim(dbh, locator, length)
SV *dbh
OCILobLocator *locator
UV length
PREINIT:
D_imp_dbh(dbh);
sword status;
CODE:
OCILobTrim_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, length, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobTrim");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = &PL_sv_yes;
}
void
ora_lob_is_init(dbh, locator)
SV *dbh
OCILobLocator *locator
PREINIT:
D_imp_dbh(dbh);
sword status;
boolean is_init = 0;
CODE:
OCILobLocatorIsInit_log_stat(imp_dbh, imp_dbh->envhp,imp_dbh->errhp,locator,&is_init,status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobLocatorIsInit ora_lob_is_init");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSVuv(is_init));
}
void
ora_lob_length(dbh, locator)
SV *dbh
OCILobLocator *locator
PREINIT:
D_imp_dbh(dbh);
sword status;
ub4 len = 0;
CODE:
OCILobGetLength_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &len, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobGetLength ora_lob_length");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSVuv(len));
}
void
ora_lob_chunk_size(dbh, locator)
SV *dbh
OCILobLocator *locator
PREINIT:
D_imp_dbh(dbh);
sword status;
ub4 chunk_size = 0;
CODE:
OCILobGetChunkSize_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, locator, &chunk_size, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCILobGetChunkSize");
ST(0) = &PL_sv_undef;
}
else {
ST(0) = sv_2mortal(newSVuv(chunk_size));
}
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr
if (!errhp) {
sv_catpv(errstr, oci_status_name(status));
if (what) {
sv_catpv(errstr, " ");
sv_catpv(errstr, what);
}
return status;
}
while( ++recno
&& OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf,
(ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA
&& eg_status != OCI_INVALID_HANDLE
&& recno < 100
) {
if (debug >= 4 || recno>1/*XXX temp*/ || dbd_verbose >= 4 )
PerlIO_printf(DBIc_LOGPIO(imp_xxh),
" OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n",
what ? what : "<NULL>", (long)recno,
(eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
status, (long)eg_errcode, errbuf);
/* Free session pool resources. */
if (imp_drh->pool_hv) {
HE *pool_he;
hv_iterinit(imp_drh->pool_hv);
while ((pool_he = hv_iternext(imp_drh->pool_hv))) {
session_pool_t *pool = (session_pool_t*)SvPVX(HeVAL(pool_he));
/* Only destroy the session pool if there are no active sessions left.
If there are active sessions left, this is because "InactiveDestroy"
is set on one or more db handles. */
if (!pool->active_sessions) {
OCISessionPoolDestroy_log_stat(imp_drh, pool->poolhp, pool->errhp, status);
}
OCIHandleFree_log_stat(imp_drh, pool->poolhp, OCI_HTYPE_SPOOL, status);
OCIHandleFree_log_stat(imp_drh, pool->errhp, OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_drh, pool->envhp, OCI_HTYPE_ENV, status);
}
hv_undef(imp_drh->pool_hv);
}
if (imp_drh->charset_hv) {
hv_undef(imp_drh->charset_hv);
}
#endif
}
/* Get charset and ncharset IDs. */
if ((svp = DBD_ATTRIB_GET_SVP(attr, "ora_charset", 11))) {
/* Charset name from parameter; try looking up previously used ID. */
HE *charset_he = hv_fetch_ent(imp_drh->charset_hv, *svp, 0, 0);
charsetid = charset_he ? SvIV(HeVAL(charset_he)) : 0;
}
else {
/* Get charset ID from the NLS environment. */
size_t rsize;
OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &charsetid, 0, OCI_NLS_CHARSET_ID, 0, &rsize, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCINlsEnvironmentVariableGet(OCI_NLS_CHARSET_ID) Check NLS settings etc.");
return 0;
}
}
if ((svp = DBD_ATTRIB_GET_SVP(attr, "ora_ncharset", 12))) {
/* Charset name from parameter; try looking up previously used ID. */
HE *charset_he = hv_fetch_ent(imp_drh->charset_hv, *svp, 0, 0);
ncharsetid = charset_he ? SvIV(HeVAL(charset_he)) : 0;
}
else {
/* Get charset ID from the NLS environment. */
size_t rsize;
OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &ncharsetid, 0, OCI_NLS_NCHARSET_ID, 0, &rsize, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCINlsEnvironmentVariableGet(OCI_NLS_NCHARSET_ID) Check NLS settings etc.");
return 0;
}
}
if (charsetid && ncharsetid) {
/* Look up session pool initialized with the same dbname, uid/pwd, connection class, and charsets. */
SV *key_sv = pool_key(imp_dbh, dbname, uid, pwd, charsetid, ncharsetid);
DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, init_mode_sv, init_mode);
#if defined(USE_ITHREADS) || defined(MULTIPLICITY) || defined(USE_5005THREADS)
init_mode |= OCI_THREADED;
#endif
{
size_t rsize = 0;
/* Get CLIENT char and nchar charset id values */
OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &charsetid,(size_t) 0, OCI_NLS_CHARSET_ID, 0, &rsize ,status );
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCINlsEnvironmentVariableGet(OCI_NLS_CHARSET_ID) Check NLS settings etc.");
return 0;
}
OCINlsEnvironmentVariableGet_log_stat(imp_dbh, &ncharsetid,(size_t) 0, OCI_NLS_NCHARSET_ID, 0, &rsize ,status );
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCINlsEnvironmentVariableGet(OCI_NLS_NCHARSET_ID) Check NLS settings etc.");
return 0;
}
/*{
After using OCIEnvNlsCreate() to create the environment handle,
**the actual lengths and returned lengths of bind and define handles are
always in number of bytes**. This applies to the following calls:
This function sets nonzero charset and ncharset as client side
database and national character sets, replacing the ones specified
by NLS_LANG and NLS_NCHAR. When charset and ncharset are 0, it
behaves exactly the same as OCIEnvCreate(). Specifically, charset
controls the encoding for metadata and data with implicit form
attribute and ncharset controls the encoding for data with SQLCS_NCHAR
form attribute.
}*/
OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, NULL,
charsetid, ncharsetid, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc.");
return 0;
}
svp = DBD_ATTRIB_GET_SVP(attr, "ora_charset", 11);/*get the charset passed in by the user*/
if (svp) {
if (imp_dbh->using_drcp) {
/* Store lookup from charset name to charset ID. */
(void)hv_store_ent(imp_drh->charset_hv, *svp, newSViv(new_ncharsetid), 0);
}
#endif
}
if (new_charsetid || new_ncharsetid) { /* reset the ENV with the new charset from above*/
if (new_charsetid) charsetid = new_charsetid;
if (new_ncharsetid) ncharsetid = new_ncharsetid;
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
OCIEnvNlsCreate_log_stat(imp_dbh, &imp_dbh->envhp, init_mode, 0, NULL, NULL, NULL, 0, 0,
charsetid, ncharsetid, status );
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"OCIEnvNlsCreate. Check ORACLE_HOME (Linux) env var or PATH (Windows) and or NLS settings, permissions, etc");
return 0;
}
}
#ifdef ORA_OCI_112
if (!imp_dbh->using_drcp)
}
#ifdef ORA_OCI_112
if (imp_dbh->using_drcp) {
/* Try looking up session pool again, in case ora_charsetid/ora_ncharsetid were used to specify previously used charset IDs from the NLS environment. */
SV *key_sv = pool_key(imp_dbh, dbname, uid, pwd, charsetid, ncharsetid);
if ((pool = pool_fetch(imp_drh, key_sv))) {
imp_dbh->pool = pool;
/* Free the current environment handle and replace it with the session pool's environment handle. */
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
imp_dbh->envhp = pool->envhp;
}
sv_free(key_sv);
}
#endif
}
if (!imp_dbh->errhp) {
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status);
}
OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &charsetid, NULL,
OCI_ATTR_ENV_CHARSET_ID, imp_dbh->errhp, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_CHARSET_ID");
return 0;
}
OCIAttrGet_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, &ncharsetid, NULL,
OCI_ATTR_ENV_NCHARSET_ID, imp_dbh->errhp, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_ENV_NCHARSET_ID");
return 0;
}
/* At this point we have charsetid & ncharsetid
* note that it is possible for charsetid and ncharestid to
* be distinct if NLS_LANG and NLS_NCHAR are both used.
imp_dbh->pool = pool = (session_pool_t*)SvPVX(HeVAL(pool_he));
pool->envhp = imp_dbh->envhp;
sv_free(key_sv);
OCIHandleAlloc_ok(imp_dbh, pool->envhp, &pool->poolhp, OCI_HTYPE_SPOOL, status);
OCIHandleAlloc_ok(imp_dbh, pool->envhp, &authp, OCI_HTYPE_AUTHINFO, status);
/* Create an unshared error handle for use in pool creation and destruction. */
OCIHandleAlloc_ok(imp_dbh, pool->envhp, &pool->errhp, OCI_HTYPE_ERROR, status);
OCIAttrSet_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO,
imp_dbh->driver_name, (ub4)strlen(imp_dbh->driver_name),
OCI_ATTR_DRIVER_NAME, pool->errhp, status);
OCIAttrSet_log_stat(imp_dbh, pool->poolhp, OCI_HTYPE_SPOOL,
authp, (ub4)0, OCI_ATTR_SPOOL_AUTH, pool->errhp, status);
ora_parse_uid(imp_dbh, &uid, &pwd);
OCISessionPoolCreate_log_stat(
imp_dbh,
pool->envhp,
pool->errhp,
pool->poolhp,
&pool->pool_name,
&pool->pool_namel,
(OraText *) dbname,
(ub4)strlen(dbname),
imp_dbh->pool_min,
imp_dbh->pool_max,
imp_dbh->pool_incr,
(OraText *) uid,
(ub4)strlen(uid),
(OraText *) pwd,
(ub4)strlen(pwd),
OCI_SPC_HOMOGENEOUS | (imp_dbh->pool_rlb ? 0 : OCI_SPC_NO_RLB),
status);
if (status != OCI_SUCCESS) {
oci_error(dbh, pool->errhp, status, "OCISessionPoolCreate");
OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status);
OCIHandleFree_log_stat(imp_dbh, pool->poolhp, OCI_HTYPE_SPOOL,status);
OCIHandleFree_log_stat(imp_dbh, pool->errhp, OCI_HTYPE_ERROR, status);
/* Free the global error handle as well. */
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_dbh, pool->envhp, OCI_HTYPE_ENV, status);
(void)hv_delete_ent(imp_drh->pool_hv, HeSVKEY(pool_he), 0, 0);
return 0;
}
OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status);
}
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &authp, OCI_HTYPE_AUTHINFO, status);
OCIAttrSet_log_stat(imp_dbh, authp, (ub4) OCI_HTYPE_AUTHINFO,
&purity, (ub4) 0,(ub4) OCI_ATTR_PURITY, imp_dbh->errhp, status);
if (imp_dbh->pool_class) /*pool_class may or may not be used */
OCIAttrSet_log_stat(imp_dbh, authp, (ub4) OCI_HTYPE_AUTHINFO,
(OraText *) imp_dbh->pool_class, (ub4) imp_dbh->pool_classl,
(ub4) OCI_ATTR_CONNECTION_CLASS, imp_dbh->errhp, status);
/* Use session tagging to get a server session initalized with correct charsets. */
sprintf((char*)imp_dbh->session_tag, "csid=%d,ncsid=%d", charsetid, ncharsetid);
OCISessionGet_log_stat(imp_dbh, imp_dbh->envhp, imp_dbh->errhp, &imp_dbh->svchp, authp,
pool->pool_name, (ub4)strlen((char *)pool->pool_name),
imp_dbh->session_tag, (ub4)strlen((char *)imp_dbh->session_tag), &rettag, &rettagl, &imp_dbh->session_tag_found, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCISessionGet");
OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status);
return 0;
}
/* Update number of active sessions in the pool. */
++imp_dbh->pool->active_sessions;
OCIHandleFree_log_stat(imp_dbh, authp, OCI_HTYPE_AUTHINFO, status);
/* Get server and session handles from service context handle, allocated by OCISessionGet. */
OCIAttrGet_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, &imp_dbh->srvhp, NULL,
OCI_ATTR_SERVER, imp_dbh->errhp, status);
OCIAttrGet_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, &imp_dbh->seshp, NULL,
OCI_ATTR_SESSION, imp_dbh->errhp, status);
if (DBIc_DBISTATE(imp_dbh)->debug >= 4 || dbd_verbose >= 4 ) {
PerlIO_printf(
DBIc_LOGPIO(imp_dbh),
"Using DRCP with session settings min=%d, max=%d, and increment=%d\n",
imp_dbh->pool_min,
imp_dbh->pool_max,
imp_dbh->pool_incr);
if (imp_dbh->pool_class)
#endif /* ORA_OCI_112 */
SV **sess_mode_type_sv;
ub4 sess_mode_type = OCI_DEFAULT;
ub4 cred_type;
DBD_ATTRIB_GET_IV(attr, "ora_session_mode",16, sess_mode_type_sv, sess_mode_type);
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_dbh->seshp, OCI_HTYPE_SESSION, status);
OCIServerAttach_log_stat(imp_dbh, dbname,OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCIServerAttach");
OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
if (imp_dbh->envhp != imp_drh->envhp) {
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
}
return 0;
}
OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp,
(ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status);
cred_type = ora_parse_uid(imp_dbh, &uid, &pwd);
#ifdef ORA_OCI_112
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, (ub4)OCI_HTYPE_SESSION,
imp_dbh->driver_name, (ub4)strlen(imp_dbh->driver_name),
(ub4)OCI_ATTR_DRIVER_NAME, imp_dbh->errhp, status);
#endif
OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,cred_type, sess_mode_type, status);
if (status == OCI_SUCCESS_WITH_INFO) {
/* eg ORA-28011: the account will expire soon; change your password now */
oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
status = OCI_SUCCESS;
}
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
if (imp_dbh->envhp != imp_drh->envhp) {
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
}
return 0;
}
OCIAttrSet_log_stat(imp_dbh, imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX,
imp_dbh->seshp, (ub4) 0,(ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status);
#ifdef ORA_OCI_112
}
#endif
}
DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */
DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */
imp_dbh->ph_type = 1; /* SQLT_CHR "(ORANET TYPE) character string" */
return 1;
}
int
dbd_db_commit(SV *dbh, imp_dbh_t *imp_dbh)
{
dTHX;
sword status;
OCITransCommit_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCITransCommit");
return 0;
}
return 1;
}
int
dbd_st_cancel(SV *sth, imp_sth_t *imp_sth)
sword status;
status = OCIBreak(imp_sth->svchp, imp_sth->errhp);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIBreak");
return 0;
}
/* if we are using a scrolling cursor we should get rid of the
cursor by fetching row 0 */
if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY){
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status);
}
return 1;
}
int
dbd_db_rollback(SV *dbh, imp_dbh_t *imp_dbh)
{
dTHX;
sword status;
OCITransRollback_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCITransRollback");
return 0;
}
return 1;
}
int dbd_st_bind_col(SV *sth, imp_sth_t *imp_sth, SV *col, SV *ref, IV type, SV *attribs) {
dTHX;
int field;
DBIc_ACTIVE_off(imp_dbh);
/* Oracle will commit on an orderly disconnect. */
/* See DBI Driver.xst file for the DBI approach. */
if (refcnt == 1 ) {
#ifdef ORA_OCI_112
if (imp_dbh->using_drcp) {
sword status;
/* Release session, tagged for future retrieval. */
OCISessionRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp,
imp_dbh->session_tag, (ub4)strlen((char *)imp_dbh->session_tag), imp_dbh->session_tag_found ? OCI_DEFAULT : OCI_SESSRLS_RETAG, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCISessionRelease");
return 0;
}
/* Update number of active sessions in the pool */
--imp_dbh->pool->active_sessions;
}
else {
#endif
sword s_se, s_sd;
OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,
OCI_DEFAULT, s_se);
if (s_se) oci_error(dbh, imp_dbh->errhp, s_se, "OCISessionEnd");
OCIServerDetach_log_stat(imp_dbh, imp_dbh->srvhp, imp_dbh->errhp, OCI_DEFAULT, s_sd);
if (s_sd) oci_error(dbh, imp_dbh->errhp, s_sd, "OCIServerDetach");
if (s_se != OCI_SUCCESS || s_sd != OCI_SUCCESS)
return 0;
#ifdef ORA_OCI_112
}
#endif
}
/* We don't free imp_dbh since a reference still exists */
/* The DESTROY method is the only one to 'free' memory. */
/* Note that statement objects may still exists for this dbh! */
imp_dbh->taf_function = NULL;
}
if (imp_dbh->taf_ctx.dbh_ref) {
SvREFCNT_dec(SvRV(imp_dbh->taf_ctx.dbh_ref));
imp_dbh->taf_ctx.dbh_ref = NULL;
}
#ifdef ORA_OCI_112
if (imp_dbh->using_drcp) {
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
}
else {
#endif
OCIHandleFree_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->svchp, OCI_HTYPE_SVCCTX, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, status);
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
/* free session environment handle */
if (imp_dbh->envhp != imp_drh->envhp) {
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
if ( status == OCI_SUCCESS ) {
imp_dbh->envhp = NULL;
}
/* free global environment handle during destruction of last connection */
} else if ( (imp_dbh->envhp == imp_drh->envhp) && (SvTRUE(perl_get_sv("DBI::PERL_ENDING",0))) ) {
OCIHandleFree_log_stat(imp_dbh, imp_dbh->envhp, OCI_HTYPE_ENV, status);
if ( status == OCI_SUCCESS ) {
imp_dbh->envhp = NULL;
imp_drh->envhp = NULL;
}
}
#ifdef ORA_OCI_112
}
#endif
}
else {
/* A new error handle is allocated on each new connect, so it is also freed when
refcnt > 1. Note that we cannot have a common free here, since it is an error
to free the environment handle before the error handle. */
OCIHandleFree_log_stat(imp_dbh, imp_dbh->errhp, OCI_HTYPE_ERROR, status);
}
dbd_db_destroy_out:
DBIc_IMPSET_off(imp_dbh);
}
SV *
dbd_take_imp_data(SV *dbh, imp_xxh_t *imp_xxh, void* foo)
{
dTHX;
char *key = SvPV(keysv,kl);
int on = SvTRUE(valuesv);
int cacheit = 1;
if (kl==17 && strEQ(key, "ora_ncs_buff_mtpl") ) {
ora_ncs_buff_mtpl = SvIV (valuesv);
}
#ifdef ORA_OCI_112
else if (kl==15 && strEQ(key, "ora_driver_name") ) {
imp_dbh->driver_name = (char *) SvPV (valuesv, vl );
OCIAttrSet_log_stat(
imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION, imp_dbh->driver_name,
(ub4)vl, OCI_ATTR_DRIVER_NAME, imp_dbh->errhp, status);
}
else if (kl==8 && strEQ(key, "ora_drcp") ) {
imp_dbh->using_drcp = 1;
}
else if (kl==14 && strEQ(key, "ora_drcp_class") ) {
STRLEN vl;
imp_dbh->pool_class = (text *) SvPV (valuesv, vl );
imp_dbh->pool_classl= (ub4) vl;
if (SvTRUE(valuesv)) {
enable_taf(dbh, imp_dbh);
} else {
disable_taf(imp_dbh);
}
}
#ifdef OCI_ATTR_ACTION
else if (kl==10 && strEQ(key, "ora_action") ) {
imp_dbh->action = (char *) SvPV (valuesv, vl );
imp_dbh->actionl= (ub4) vl;
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status);
}
#endif
else if (kl==21 && strEQ(key, "ora_client_identifier") ) {
imp_dbh->client_identifier = (char *) SvPV (valuesv, vl );
imp_dbh->client_identifierl= (ub4) vl;
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_identifier,imp_dbh->client_identifierl,OCI_ATTR_CLIENT_IDENTIFIER,imp_dbh->errhp, status);
}
#ifdef OCI_ATTR_CLIENT_INFO
else if (kl==15 && strEQ(key, "ora_client_info") ) {
imp_dbh->client_info = (char *) SvPV (valuesv, vl );
imp_dbh->client_infol= (ub4) vl;
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->client_info,imp_dbh->client_infol,OCI_ATTR_CLIENT_INFO,imp_dbh->errhp, status);
}
#endif
#ifdef OCI_ATTR_MODULE
else if (kl==15 && strEQ(key, "ora_module_name") ) {
imp_dbh->module_name = (char *) SvPV (valuesv, vl );
imp_dbh->module_namel= (ub4) vl;
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->module_name,imp_dbh->module_namel,OCI_ATTR_MODULE,imp_dbh->errhp, status);
}
#endif
else if (kl==20 && strEQ(key, "ora_oci_success_warn") ) {
oci_warn = SvIV (valuesv);
}
else if (kl==11 && strEQ(key, "ora_objects")) {
ora_objects = SvIV (valuesv);
}
else if (kl==11 && (strEQ(key, "ora_verbose") || strEQ(key, "dbd_verbose"))) {
PerlIO_printf(DBIc_LOGPIO(imp_sth), " creating xml from string that is %lu long\n",(unsigned long)len);
if(len > MAX_OCISTRING_LEN) {
src_type = OCI_XMLTYPE_CREATE_CLOB;
if (DBIc_DBISTATE(imp_sth)->debug >=5 || dbd_verbose >= 5 )
PerlIO_printf(DBIc_LOGPIO(imp_sth),
" use a temp lob locator for large xml \n");
OCIDescriptorAlloc_ok(imp_dbh, imp_dbh->envhp, &src_ptr, OCI_DTYPE_LOB);
OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp,
(OCILobLocator *) src_ptr, (ub2) OCI_DEFAULT,
(ub1) OCI_DEFAULT, OCI_TEMP_CLOB, FALSE, OCI_DURATION_SESSION, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary");
}
csid = (SvUTF8(source) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
buflen = len;
OCILobWriteAppend_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, src_ptr,
&buflen, bufp, (ub4)len, OCI_ONE_PIECE,
NULL, NULL,
csid, csform, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobWriteAppend");
}
} else {
src_type = OCI_XMLTYPE_CREATE_OCISTRING;
" use a OCIStringAssignText for small xml \n");
OCIStringAssignText(imp_dbh->envhp,
imp_dbh->errhp,
bufp,
(ub2) (ub4)len,
(OCIString **) &src_ptr);
}
OCIXMLTypeCreateFromSrc_log_stat(imp_dbh,
imp_dbh->svchp,
imp_dbh->errhp,
(OCIDuration)OCI_DURATION_CALLOUT,
(ub1)src_type,
(dvoid *)src_ptr,
(sb4)OCI_IND_NOTNULL,
&xml,
status);
if (status != OCI_SUCCESS) {
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 */
"(%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 (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;
}
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;
}
sword status;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" pp_rebind_ph_rset_in: BEGIN\n calling OCIBindByName(stmhp=%p, "
"bndhp=%p, errhp=%p, name=%s, csrstmhp=%p, ftype=%d)\n",
imp_sth->stmhp, phs->bndhp, imp_sth->errhp, phs->name,
imp_sth_csr->stmhp, phs->ftype);
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
&imp_sth_csr->stmhp,
0,
(ub2)phs->ftype, 0,
NULL,
0, 0,
NULL,
(ub4)OCI_DEFAULT,
status
);
DBIc_LOGPIO(imp_sth),
" pp_exec_rset bind %s - allocating new sth...\n",
phs->name);
/* extproc deallocates everything for us */
if (is_extproc)
return 1;
if (!phs->desc_h || 1) { /* XXX phs->desc_t != OCI_HTYPE_STMT) */
if (phs->desc_h) {
OCIHandleFree_log_stat(imp_sth, phs->desc_h, phs->desc_t, status);
phs->desc_h = NULL;
}
phs->desc_t = OCI_HTYPE_STMT;
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &phs->desc_h, phs->desc_t, status);
}
phs->progv = (char*)&phs->desc_h;
phs->maxlen = 0;
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name,
(sb4)strlen(phs->name),
phs->progv,
0,
(ub2)phs->ftype,
/* I, MJE have no evidence that passing an indicator to this func
causes ORA-01001 (invalid cursor) errors. Also, without it
you cannot test the indicator to check we have a valid output
parameter. However, it would seem when you do specify an
indicator it always comes back as 0 so it is useless. */
DBIc_LOGPIO(imp_sth),
" returned cursor/statement state: %u\n", stmt_state);
}
/* We seem to get an indp of 0 even for a cursor which was never
opened and set to NULL. If this is the case we check the stmt state
and find the cursor is initialized but not executed - there is no
point in going any further if it is not executed - just return undef.
See RT 82663 */
if (stmt_state == OCI_STMT_STATE_INITIALIZED) {
OCIHandleFree_log_stat(imp_sth, (OCIStmt *)phs->desc_h,
OCI_HTYPE_STMT, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
return 0;
}
phs->desc_h = NULL;
phs->sv = newSV(0); /* undef */
return 1;
}
ptr = SvRV(phs->sv);
phs->progv = (void*) SvIV(ptr);
phs->maxlen = sizeof(OCIXMLType*);
}
else
croak("Unsupported named object type for bind parameter");
/* bind by name */
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
(dvoid *) NULL, /* value supplied in BindObject later */
0,
(ub2)phs->ftype, 0,
NULL,
0, 0,
NULL,
(ub4)OCI_DEFAULT,
status
);
PerlIO_printf(DBIc_LOGPIO(imp_sth), " bind %s as ftype %d (%s)\n",
phs->name, phs->ftype,sql_typecode_name(phs->ftype));
if (done != 1) {
return 0; /* the rebind failed */
}
at_exec = (phs->desc_h == NULL);
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
phs->progv,
phs->maxlen ? (sb4)phs->maxlen : 1, /* else bind "" fails */
(ub2)phs->ftype, &phs->indp,
NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */
&phs->arcode,
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
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"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(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 (SvUTF8(phs->sv) && !CS_IS_UTF8(csid))
csid = utf8_csid; /* not al32utf8_csid here on purpose */
"maxlen %lu, maxdata_size %lu)\n",
phs->name, neatsvpv(phs->sv,10),
(phs->is_inout) ? "inout" : "in",
(SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
phs->csid_orig, phs->csid, csid,
phs->ftype, sql_typecode_name(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 (phs->maxdata_size) {
OCIAttrSet_log_stat(imp_sth, 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;
}
imp_sth->exe_mode=OCI_DEFAULT;
}
if (debug >= 2 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"Statement Execute Mode is %d (%s)\n",
imp_sth->exe_mode,oci_exe_mode(imp_sth->exe_mode));
OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
(ub4)(is_select ? 0: 1),
0, 0, 0,(ub4)imp_sth->exe_mode,status);
if (status != OCI_SUCCESS) { /* may be OCI_ERROR or OCI_SUCCESS_WITH_INFO etc */
/* we record the error even for OCI_SUCCESS_WITH_INFO */
oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_sth,"OCIStmtExecute"));
/* but only bail out here if not OCI_SUCCESS_WITH_INFO */
if (status != OCI_SUCCESS_WITH_INFO)
return -2;
if (is_select) {
DBIc_ACTIVE_on(imp_sth);
DBIc_ROW_COUNT(imp_sth) = 0; /* reset (possibly re-exec'ing) */
row_count = 0;
/*reinit the rs_array as well
as we may have more than one exe on a prepare*/
rs_array_init(imp_sth);
}
else {
OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
}
if (debug >= 2 || dbd_verbose >= 3 ) {
ub2 sqlfncode;
OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status);
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n",
oci_stmt_type_name(imp_sth->stmt_type),
oci_status_name(status),
(long)row_count, sqlfncode, imp_sth->has_inout_params);
}
if (is_select && !imp_sth->done_desc) {
/* describe and allocate storage for results (if any needed) */
int utf8;
AV *tuples_utf8_av,*tuples_status_av;
int parma_index;
{
dTHX;
sword status;
ub1 csform;
ub2 csid;
int trace_level = DBIc_DBISTATE(imp_sth)->debug;
int i;
OCIBindByName_log_stat(imp_sth, imp_sth->stmhp, &phs->bndhp, imp_sth->errhp,
(text*)phs->name, (sb4)strlen(phs->name),
0,
(sb4)phs->maxlen,
(ub2)phs->ftype, 0,
NULL, /* ub2 *alen_ptr not needed with OCIBindDynamic */
0,
0, /* max elements that can fit in allocated array */
NULL, /* (ptr to) current number of elements in array */
(ub4)OCI_DATA_AT_EXEC,
status);
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
"do_bind_array_exec() (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(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 possible */
if ((utf8 & ARRAY_BIND_UTF8) && !CS_IS_UTF8(csid)) {
/* if the specified or default csid is not utf8 _compatible_ AND we have
* mixed utf8 and native (non-utf8) data, then it's a fatal problem
* utf8 _compatible_ means, can be upgraded to utf8, ie. utf8 or ascii */
", maxlen %lu, maxdata_size %lu)\n",
phs->name,
(phs->is_inout) ? "inout" : "in",
(utf8 ? "is-utf8" : "not-utf8"),
phs->csid_orig, phs->csid, csid,
phs->ftype, sql_typecode_name(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;
}
}
return 1;
}
}
}
/* Store array of bind typles, for use in OCIBindDynamic() callback. */
imp_sth->bind_tuples = tuples_av;
imp_sth->rowwise = (columns_av == NULL);
oci_mode = OCI_BATCH_ERRORS;
if(autocommit)
oci_mode |= OCI_COMMIT_ON_SUCCESS;
OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, imp_sth->stmhp, imp_sth->errhp,
exe_count, 0, 0, 0, oci_mode, exe_status);
OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
imp_sth->bind_tuples = NULL;
if (exe_status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, exe_status, ora_sql_error(imp_sth,"OCIStmtExecute"));
if(exe_status != OCI_SUCCESS_WITH_INFO)
return -2;
}
if (outparams){
if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) {
AV *av = (AV*)SvRV(sv);
I32 avlen = AvFILL(av);
for (j=0;j<=avlen;j++){
dbd_phs_avsv_complete(imp_sth, phs, j, debug);
}
}
}
}
OCIAttrGet_stmhp_stat(imp_sth, &num_errs, 0, OCI_ATTR_NUM_DML_ERRORS, status);
if (debug >= 6 || dbd_verbose >= 6 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" ora_st_execute_array %d errors in batch.\n",
num_errs);
if (num_errs) {
sv_setiv(err_count,num_errs);
}
SV *err_svs[3];
/*AV *err_av;*/
sb4 err_code;
err_svs[0] = newSViv((IV)0);
err_svs[1] = newSVpvn("", 0);
err_svs[2] = newSVpvn("S1000",5);
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &row_errhp, OCI_HTYPE_ERROR, status);
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &tmp_errhp, OCI_HTYPE_ERROR, status);
for(i = 0; (unsigned int) i < num_errs; i++) {
OCIParamGet_log_stat(imp_sth, imp_sth->errhp, OCI_HTYPE_ERROR,
tmp_errhp, (dvoid *)&row_errhp,
(ub4)i, status);
OCIAttrGet_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, &row_off, 0,
OCI_ATTR_DML_ROW_OFFSET, imp_sth->errhp, status);
if (debug >= 6 || dbd_verbose >= 6 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" ora_st_execute_array error in row %d.\n",
row_off);
sv_setpv(err_svs[1], "");
err_code = oci_error_get((imp_xxh_t *)imp_sth, row_errhp, exe_status, NULL, err_svs[1], debug);
sv_setiv(err_svs[0], (IV)err_code);
av_store(tuples_status_av, row_off,
newRV_noinc((SV *)(av_make(3, err_svs))));
}
OCIHandleFree_log_stat(imp_sth, tmp_errhp, OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_sth, row_errhp, OCI_HTYPE_ERROR, status);
/* Do a commit here if autocommit is set, since Oracle
doesn't do that for us when some rows are in error. */
if(autocommit) {
OCITransCommit_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCITransCommit");
return -2;
}
}
}
if(num_errs) {
return -2;
return 1;
}
int
dbd_st_rows(SV *sth, imp_sth_t *imp_sth)
{
dTHX;
ub4 row_count = 0;
sword status;
OCIAttrGet_stmhp_stat(imp_sth, &row_count, 0, OCI_ATTR_ROW_COUNT, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIAttrGet OCI_ATTR_ROW_COUNT");
return -1;
}
return row_count;
}
int
dbd_st_finish(SV *sth, imp_sth_t *imp_sth)
return 1;
if (!DBIc_ACTIVE(imp_dbh)) /* no longer connected */
return 1;
/*fetching on a cursor with row =0 will explicitly free any
server side resources this is what the next statment does,
not sure if we need this for non scrolling cursors they should die on
a OER(1403) no records)*/
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,
OCI_FETCH_NEXT,0, status);
if (status != OCI_SUCCESS && status != OCI_SUCCESS_WITH_INFO) {
oci_error(sth, imp_sth->errhp, status, "Finish OCIStmtFetch");
return 0;
}
return 1;
}
if (fbh->fb_ary)
fb_ary_free(fbh->fb_ary);
sv_free(fbh->name_sv);
/* see rt 75163 */
if (fbh->desc_h) {
boolean is_open;
sword status;
OCILobFileIsOpen_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, fbh->desc_h, &is_open, status);
if (status == OCI_SUCCESS && is_open) {
OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
fbh->desc_h, status);
}
OCIDescriptorFree_log(imp_sth, fbh->desc_h, fbh->desc_t);
}
if (fbh->obj) {
if (fbh->obj->obj_value)
OCIObjectFree(fbh->imp_sth->envhp, fbh->imp_sth->errhp, fbh->obj->obj_value, (ub2)0);
sv_free(phs->sv);
}
void
ora_free_templob(SV *sth, imp_sth_t *imp_sth, OCILobLocator *lobloc)
{
dTHX;
#if defined(OCI_HTYPE_DIRPATH_FN_CTX) /* >= 9.0 */
boolean is_temporary = 0;
sword status;
OCILobIsTemporary_log_stat(imp_sth, imp_sth->envhp, imp_sth->errhp, lobloc, &is_temporary, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobIsTemporary");
return;
}
if (is_temporary) {
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 ) {
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" OCILobFreeTemporary %s\n", oci_status_name(status));
}
OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobFreeTemporary");
return;
}
}
#endif
}
void
/* Don't free the OCI statement handle for a nested cursor. It will
be reused by Oracle on the next fetch. Indeed, we never
free these handles. Experiment shows that Oracle frees them
when they are no longer needed.
*/
/* get rid of describe handle if used*/
/* if we are using a scrolling cursor we should get rid of the
cursor by fetching row 0 */
if (imp_sth->exe_mode==OCI_STMT_SCROLLABLE_READONLY && DBIc_ACTIVE(imp_dbh)) {
OCIStmtFetch_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp, 0,OCI_FETCH_NEXT,0, status);
}
if (imp_sth->dschp){
OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
}
if (DBIc_DBISTATE(imp_sth)->debug >= 6 || dbd_verbose >= 6 )
PerlIO_printf(DBIc_LOGPIO(imp_sth), " dbd_st_destroy %s\n",
(PL_dirty) ? "(OCIHandleFree skipped during global destruction)" :
(imp_sth->nested_cursor) ?"(OCIHandleFree skipped for nested cursor)" : "");
if (!PL_dirty) { /* XXX not ideal, leak may be a problem in some cases */
if (!imp_sth->nested_cursor) {
OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status);
if (status != OCI_SUCCESS)
oci_error(sth, imp_sth->errhp, status, "OCIHandleFree");
}
}
/* Free off contents of imp_sth */
if (imp_sth->lob_refetch)
ora_free_lob_refetch(sth, imp_sth);
}
static void disable_taf(
imp_dbh_t *imp_dbh) {
sword status;
OCIFocbkStruct tafailover;
tafailover.fo_ctx = NULL;
tafailover.callback_function = NULL;
OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER,
(dvoid *) &tafailover, (ub4) 0,
(ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
return;
}
static int enable_taf(
SV *dbh,
imp_dbh_t *imp_dbh) {
boolean can_taf = 0;
sword status;
#ifdef OCI_ATTR_TAF_ENABLED
OCIAttrGet_log_stat(imp_dbh, imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
#endif
if (!can_taf){
croak("You are attempting to enable TAF on a server that is not TAF Enabled \n");
}
status = reg_taf_callback(dbh, imp_dbh);
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status, "Setting TAF Callback Failed! ");
if (!errhp) {
sv_catpv(errstr, oci_status_name(status));
if (what) {
sv_catpv(errstr, " ");
sv_catpv(errstr, what);
}
return status;
}
while( ++recno
&& OCIErrorGet_log_stat(imp_xxh, errhp, recno, (text*)NULL, &eg_errcode, errbuf,
(ub4)sizeof(errbuf), OCI_HTYPE_ERROR, eg_status) != OCI_NO_DATA
&& eg_status != OCI_INVALID_HANDLE
&& recno < 100) {
if (debug >= 4 || recno>1/*XXX temp*/)
PerlIO_printf(DBIc_LOGPIO(imp_xxh),
" OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n",
what ? what : "<NULL>", (long)recno,
(eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status),
status, (long)eg_errcode, errbuf);
char *
ora_sql_error(imp_sth_t *imp_sth, char *msg)
{
dTHX;
#ifdef OCI_ATTR_PARSE_ERROR_OFFSET
D_imp_dbh_from_sth;
SV *msgsv, *sqlsv;
char buf[99];
sword status = 0;
ub2 parse_error_offset = 0;
OCIAttrGet_stmhp_stat(imp_sth, &parse_error_offset, 0,
OCI_ATTR_PARSE_ERROR_OFFSET, status);
imp_dbh->parse_error_offset = parse_error_offset;
if (!parse_error_offset)
return msg;
sprintf(buf,"error possibly near <*> indicator at char %d in '",
parse_error_offset);
msgsv = sv_2mortal(newSVpv(buf,0));
sqlsv = sv_2mortal(newSVpv(imp_sth->statement,0));
sv_insert(sqlsv, parse_error_offset, 0, "<*>", 3);
sv_catsv(msgsv, sqlsv);
else imp_sth->statement = savepv(statement);
imp_sth->envhp = imp_dbh->envhp;
imp_sth->errhp = imp_dbh->errhp;
imp_sth->srvhp = imp_dbh->srvhp;
imp_sth->svchp = imp_dbh->svchp;
OCIHandleAlloc_ok(imp_dbh, imp_dbh->envhp, &imp_sth->stmhp, OCI_HTYPE_STMT, status);
OCIStmtPrepare_log_stat(imp_sth, imp_sth->stmhp, imp_sth->errhp,
(text*)imp_sth->statement, (ub4)strlen(imp_sth->statement),
OCI_NTV_SYNTAX, OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCIStmtPrepare");
OCIHandleFree_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, status);
return 0;
}
OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status);
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" dbd_st_prepare'd sql %s ( auto_lob%d, check_sql%d)\n",
oci_stmt_type_name(imp_sth->stmt_type),
imp_sth->auto_lob, ora_check_sql);
DBIc_IMPSET_on(imp_sth);
if (dbd_verbose >= 5 ) {
PerlIO_printf(DBIc_LOGPIO(imp_dbh), " In reg_taf_callback\n");
}
/* set the context up as a pointer to the taf callback struct*/
tafailover.fo_ctx = &imp_dbh->taf_ctx;
tafailover.callback_function = &taf_cbk;
/* register the callback */
OCIAttrSet_log_stat(imp_dbh, imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER,
(dvoid *) &tafailover, (ub4) 0,
(ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
return status;
}
#ifdef UTF8_SUPPORT
/* How many bytes are n utf8 chars in buffer */
static ub4
ora_utf8_to_bytes (ub1 *buffer, ub4 chars_wanted, ub4 max_bytes)
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);
}
phs->out_prepost_exec = lob_phs_post_execute;
/* accept input LOBs */
if (sv_isobject(phs->sv) && sv_derived_from(phs->sv, "OCILobLocatorPtr")) {
OCILobLocator *src;
OCILobLocator **dest;
src = INT2PTR(OCILobLocator *, SvIV(SvRV(phs->sv)));
dest = (OCILobLocator **) phs->progv;
OCILobLocatorAssign_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp, src, dest, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobLocatorAssign");
return 0;
}
}
/* create temporary LOB for PL/SQL placeholder */
else if (imp_sth->stmt_type == OCI_STMT_BEGIN ||
imp_sth->stmt_type == OCI_STMT_DECLARE) {
ub4 amtp;
(void)SvUPGRADE(phs->sv, SVt_PV);
amtp = SvCUR(phs->sv); /* XXX UTF8? */
/* Create a temp lob for non-empty string */
if (amtp > 0) {
ub1 lobtype = (phs->ftype == 112 ? OCI_TEMP_CLOB : OCI_TEMP_BLOB);
OCILobCreateTemporary_log_stat(imp_dbh, imp_dbh->svchp, imp_sth->errhp,
(OCILobLocator *) phs->desc_h, (ub2) OCI_DEFAULT,
(ub1) OCI_DEFAULT, lobtype, TRUE, OCI_DURATION_SESSION, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobCreateTemporary");
return 0;
}
if( ! phs->csid ) {
ub1 csform = SQLCS_IMPLICIT;
ub2 csid = 0;
OCILobCharSetForm_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
(OCILobLocator*)phs->desc_h,
&csform,
status );
if (status != OCI_SUCCESS)
return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
(OCILobLocator*)phs->desc_h,
&csid,
status );
if (status != OCI_SUCCESS)
return oci_error(sth, imp_sth->errhp, status, "OCILobCharSetId");
#endif /* OCI_ATTR_CHARSET_ID */
/* if data is utf8 but charset isn't then switch to utf8 csid */
csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" calling OCILobWrite phs->csid=%d phs->csform=%d amtp=%d\n",
phs->csid, phs->csform, amtp );
/* write lob data */
OCILobWrite_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
(OCILobLocator*)phs->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
0,0, phs->csid, phs->csform, status);
if (status != OCI_SUCCESS) {
return oci_error(sth, imp_sth->errhp, status, "OCILobWrite in dbd_rebind_ph_lob");
}
}
}
return 1;
}
sword ftype = fbh->ftype;
sword status;
/*
* We assume our caller has already done the
* equivalent of the following:
* (void)SvUPGRADE(dest_sv, SVt_PV);
*/
ub1 csform = SQLCS_IMPLICIT;
OCILobCharSetForm_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
lobl,
&csform,
status );
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
if (ftype != ORA_CLOB) {
oci_error(sth, imp_sth->errhp, OCI_ERROR,
"blob_read not currently supported for non-CLOB types with OCI 8 "
"(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
"so you don't need to call blob_read at all)");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
lobl, &loblen, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_mb_piece");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
loblen -= offset; /* only count from offset onwards */
amtp = (loblen > len) ? len : loblen;
buflen = 4 * amtp;
byte_destoffset = ora_utf8_to_bytes((ub1 *)(SvPVX(dest_sv)),
(ub4)destoffset, SvCUR(dest_sv));
if (loblen > 0) {
ub1 *dest_bufp;
ub1 *buffer;
New(42, buffer, buflen, ub1);
OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl,
&amtp, (ub4)1 + offset, buffer, buflen,
0, 0, (ub2)0 ,csform ,status );
/* lab 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status); */
if (dbis->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, "
"BufLen %lu, Got %lu\n",
fbh->field_num+1, oci_status_name(status), ul_t(loblen),
type_name = "BFILE";
else {
oci_error(sth, imp_sth->errhp, OCI_ERROR,
"blob_read not currently supported for non-LOB types with OCI 8 "
"(but with OCI 8 you can set $dbh->{LongReadLen} to the length you need,"
"so you don't need to call blob_read at all)");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl, &loblen, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobGetLength ora_blob_read_piece");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
OCILobCharSetForm_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
lobl,
&csform,
status );
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
sv_set_undef(dest_sv); /* signal error */
return 0;
}
DBIc_LOGPIO(imp_sth),
" blob_read field %d: ftype %d %s, offset %ld, len %lu."
"LOB csform %d, len %lu, amtp %lu, (destoffset=%ld)\n",
fbh->field_num+1, ftype, type_name, offset, ul_t(len),
csform,(unsigned long) (loblen), ul_t(amtp), destoffset);
if (loblen > 0) {
ub1 * bufp = (ub1 *)(SvPVX(dest_sv));
bufp += destoffset;
OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobl,
&amtp, (ub4)1 + offset, bufp, buflen,
0, 0, (ub2)0 , csform, status);
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu,"
"BufLen %lu, amtp %lu\n",
fbh->field_num+1, oci_status_name(status), ul_t(loblen),
ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
sword status;
if (!name)
name = "an unknown field";
/* this function is not called for NULL lobs */
/* The length is expressed in terms of bytes for BLOBs and BFILEs, */
/* and in terms of characters for CLOBs and NCLOBS */
OCILobGetLength_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_lob");
return 0;
}
if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */
int oraperl = DBIc_COMPAT(imp_sth);
D_imp_dbh_from_sth ;
D_imp_drh_from_dbh ;
buflen = amtp;
if (ftype == ORA_CLOB)
buflen = buflen*ora_ncs_buff_mtpl;
SvGROW(dest_sv, buflen+1);
if (loblen > 0) {
ub1 csform = 0;
OCILobCharSetForm_log_stat(imp_sth,
imp_sth->envhp,
imp_sth->errhp,
lobloc,
&csform,
status );
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobCharSetForm");
sv_set_undef(dest_sv);
return 0;
}
if (ftype == ORA_BFILE) {
OCILobFileOpen_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc,
(ub1)OCI_FILE_READONLY, status);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobFileOpen");
sv_set_undef(dest_sv);
return 0;
}
}
OCILobRead_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, lobloc,
&amtp, (ub4)1, SvPVX(dest_sv), buflen,
0, 0, (ub2)0, csform, status);
if (status != OCI_SUCCESS ) {
if (status == OCI_NEED_DATA ){
char buf[300];
sprintf(buf,"fetching %s. LOB and the read bufer is only %lubytes, and the ora_ncs_buff_mtpl is %d, which is too small. Try setting ora_ncs_buff_mtpl to %d",
name, (unsigned long)buflen, ora_ncs_buff_mtpl,ora_ncs_buff_mtpl+1);
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" OCILobRead %s %s: csform %d (%s), LOBlen %lu(%s), "
"LongReadLen %lu(%s), BufLen %lu(%s), Got %lu(%s)\n",
name, oci_status_name(status), csform, oci_csform_name(csform),
ul_t(loblen),buf ,
ul_t(imp_sth->long_readlen),buf, ul_t(buflen),buf, ul_t(amtp),buf);
}
if (ftype == ORA_BFILE) {
OCILobFileClose_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp,
lobloc, status);
}
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCILobFileClose");
sv_set_undef(dest_sv);
return 0;
}
/* tell perl what we've put in its dest_sv */
" getting value of object attribute named %s with typecode=%s\n",
name,oci_typecode_name(typecode));
}
switch (typecode)
{
case OCI_TYPECODE_INTERVAL_YM :
case OCI_TYPECODE_INTERVAL_DS :
OCIIntervalToText_log_stat(fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
attr_value,
str_buf,
(size_t) 200,
&str_len,
status);
str_buf[str_len+1] = '\0';
av_push(list, newSVpv( (char *) str_buf,0));
break;
case OCI_TYPECODE_TIMESTAMP_TZ :
case OCI_TYPECODE_TIMESTAMP_LTZ :
case OCI_TYPECODE_TIMESTAMP :
ub4_str_len = 200;
OCIDateTimeToText_log_stat(fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
attr_value,
&ub4_str_len,
str_buf,
status);
if (typecode == OCI_TYPECODE_TIMESTAMP_TZ || typecode == OCI_TYPECODE_TIMESTAMP_LTZ){
char s_tz_hour[3]="000";
char s_tz_min[3]="000";
} else {
str_buf[ub4_str_len+1] = '\0';
}
av_push(list, newSVpv( (char *) str_buf,0));
break;
case OCI_TYPECODE_DATE : /* fixed length string*/
ub4_str_len = 200;
OCIDateToText_log_stat(fbh->imp_sth,
fbh->imp_sth->errhp,
(CONST OCIDate *) attr_value,
&ub4_str_len,
str_buf,
status);
str_buf[ub4_str_len+1] = '\0';
av_push(list, newSVpv( (char *) str_buf,0));
break;
oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectNew");
return 0;
}
status=OCIObjectGetTypeRef(fbh->imp_sth->envhp,fbh->imp_sth->errhp, (dvoid*)value, type_ref);
if (status != OCI_SUCCESS) {
oci_error(sth, fbh->imp_sth->errhp, status, "OCIObjectGetTypeRef");
return 0;
}
OCITypeByRef_log_stat(fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
type_ref,
&tdo,status);
if (status != OCI_SUCCESS) {
oci_error(sth, fbh->imp_sth->errhp, status, "OCITypeByRef");
return 0;
}
The the obj_ind is for the entier object not the properties so you call it once it
gets all of the indicators for the objects so you pass it into OCIObjectGetAttr and that
function will set attr_null_status as in the get below.
5. interate over the attributes of the object
The thing to remember is that OCI and C have no way of representing a DB NULLs so we use the OCIInd find out
if the object or any of its properties are NULL, This is one little line in a 20 chapter book and even then
id only shows you examples with the C struct built in and only a single record. Nowhere does it say you can do it this way.
*/
OCIObjectGetAttr_log_stat(
fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
value, /* instance */
obj_ind, /* null_struct */
tdo, /* tdo */
(CONST oratext**)&fld->type_name, /* names */
&fld->type_namel, /* lengths */
1, /* name_count */
(ub4 *)0, /* indexes */
case OCI_TYPECODE_REF : /* embedded ADT */
croak("panic: OCI_TYPECODE_REF objets () are not supported ");
break;
case OCI_TYPECODE_NAMEDCOLLECTION : /*this works for both as I am using CONST OCIColl */
switch (obj->col_typecode) { /*there may be more thatn two I havn't found them yet mmight be XML??*/
case OCI_TYPECODE_TABLE : /* nested table */
case OCI_TYPECODE_VARRAY : /* variable array */
fld = &obj->fields[0]; /*get the field */
OCIIterCreate_log_stat(fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
(OCIColl*) value,
&itr,
status);
if (status != OCI_SUCCESS) {
/*not really an error just no data
oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterCreate");*/
status = OCI_SUCCESS;
av_push(list, &PL_sv_undef);
if(!get_object (sth,fld->value, fbh, fld,element,0,element_null))
return 0;
av_push(list, new_ora_object(fld->value, obj->element_typecode));
} else{ /* else, display the scaler type attribute */
get_attr_val(sth,list, fbh, obj->type_name, obj->element_typecode, element);
}
}
}
/*nasty surprise here. one has to get rid of the iterator or you will leak memory
not documented in oci or in demos */
OCIIterDelete_log_stat(fbh->imp_sth,
fbh->imp_sth->envhp,
fbh->imp_sth->errhp,
&itr,
status );
if (status != OCI_SUCCESS) {
oci_error(sth, fbh->imp_sth->errhp, status, "OCIIterDelete");
return 0;
}
break;
default:
sb2 indptr = 0;
ub2 rcode = 0;
sword status = OCI_NEED_DATA;
if (DBIc_DBISTATE(imp_sth)->debug >= 4 || dbd_verbose >= 4 ) {
PerlIO_printf(DBIc_LOGPIO(imp_sth), "in fetch_get_piece \n");
}
while (status == OCI_NEED_DATA){
OCIStmtGetPieceInfo_log_stat(fbh->imp_sth,
fbh->imp_sth->stmhp,
fbh->imp_sth->errhp,
&hdlptr,
&hdltype,
&in_out,
&iter,
&idx,
&piece,
status);
you have to check to ensure you have the right define handle from the OCIDefineByPos
I do it in the next if statement. So this will loop untill the handle changes at that point it exits the loop
during the loop I add the abuf to the cb_abuf using the buflen that is set above.
I get the actual buffer length by adding up all the pieces (buflen) as I go along
Another really anoying thing is once can only find out if there is data left over at the very end of the fetching of the colums
so I make it warn if the LongTruncOk. I could also do this before but that would not result in any of the good data getting
in
*/
if ( hdlptr==fbh->defnp){
OCIStmtSetPieceInfo_log_stat(fbh->imp_sth,
fbh->defnp,
fbh->imp_sth->errhp,
fb_ary->abuf,
&buflen,
piece,
(dvoid *)&indptr,
&rcode,status);
OCIStmtFetch_log_stat(fbh->imp_sth, fbh->imp_sth->stmhp,fbh->imp_sth->errhp,1,(ub2)OCI_FETCH_NEXT,OCI_DEFAULT,status);
if (status==OCI_SUCCESS_WITH_INFO && !DBIc_has(fbh->imp_sth,DBIcf_LongTruncOk)){
dTHR; /* for DBIc_ACTIVE_off */
DBIc_ACTIVE_off(fbh->imp_sth); /* eg finish */
oci_error(sth, fbh->imp_sth->errhp, status, "OCIStmtFetch, LongReadLen too small and/or LongTruncOk not set");
}
memcpy(fb_ary->cb_abuf+fb_ary->piece_count*imp_sth->piece_size,fb_ary->abuf,buflen );
fb_ary->piece_count++;/*used to tell me how many pieces I have, for debuffing in this case */
actual_bufl=actual_bufl+buflen;
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;
/*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);
if (status != OCI_SUCCESS) {
oci_error(sth, imp_sth->errhp, status, "OCITypeByRef");
return 0;
}
}
int
describe_obj_by_tdo(SV *sth,imp_sth_t *imp_sth,fbh_obj_t *obj,ub2 level ) {
dTHX;
sword status;
text *type_name, *schema_name;
ub4 type_namel, schema_namel;
OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp,imp_sth->errhp,obj->tdo,(ub4)0,OCI_OTYPE_PTR,(ub1)1,OCI_PTYPE_TYPE,imp_sth->dschp,status);
/*we have the Actual TDO so lets see what it is made up of by a describe*/
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIDescribeAny");
return 0;
}
OCIAttrGet_parmap(imp_sth, imp_sth->dschp,OCI_HTYPE_DESCRIBE, &obj->parmdp, 0, status);
if (status != OCI_SUCCESS) {
}
OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->obj_ref, 0, OCI_ATTR_REF_TDO, status);
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
return 0;
}
/*we will need a reff to the TDO for the pin operation*/
OCIObjectPin_log_stat(imp_sth, imp_sth->envhp,imp_sth->errhp, obj->obj_ref,(dvoid **)&obj->obj_type,status);
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIObjectPin");
return 0;
}
OCIAttrGet_parmdp(imp_sth, obj->parmdp, (dvoid *)&obj->is_final_type,(ub4 *) 0, OCI_ATTR_IS_FINAL_TYPE, status);
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIAttrGet");
return 0;
}
for (pos = 1; pos <= obj->field_count; pos++){
OCIParam *parmdf= (OCIParam *) 0;
fbh_obj_t *fld = &obj->fields[pos-1]; /*get the field holder*/
OCIParamGet_log_stat(imp_sth, (dvoid *) list_attr,(ub4) OCI_DTYPE_PARAM, imp_sth->errhp,(dvoid *)&parmdf, (ub4) pos ,status);
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIParamGet");
return 0;
}
OCIAttrGet_parmdp(imp_sth, (dvoid*)parmdf, (dvoid *)&fld->type_name,(ub4 *) &fld->type_namel, OCI_ATTR_NAME, status);
/* get the name of the attribute */
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));
for(i = 1; i <= num_fields; ++i) { /*start define of filed struct[i] fbh */
char *p;
ub4 atrlen;
int avg_width = 0;
imp_fbh_t *fbh = &imp_sth->fbh[i-1];
fbh->imp_sth = imp_sth;
fbh->field_num = i;
fbh->define_mode = OCI_DEFAULT;
OCIParamGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, imp_sth->errhp,
(dvoid**)&fbh->parmdp, (ub4)i, status);
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIParamGet");
return 0;
}
OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbtype, 0, OCI_ATTR_DATA_TYPE, status);
OCIAttrGet_parmdp(imp_sth, fbh->parmdp, &fbh->dbsize, 0, OCI_ATTR_DATA_SIZE, status);
/*may be a bug in 11 where the OCI_ATTR_DATA_SIZE my return 0 which should never happen*/
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. "
"Using OCIDefineObject and or OCIObjectPin \n",i);
}
Newz(1, fbh->obj, 1, fbh_obj_t);
fbh->obj->typecode=fbh->dbtype;
if (!describe_obj(h,imp_sth,fbh->parmdp,fbh->obj,0)){
++num_errors;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 5 || dbd_verbose >= 5 ){
dump_struct(imp_sth,fbh->obj,0);
}
OCIDefineObject_log_stat(imp_sth,fbh->defnp,imp_sth->errhp,fbh->obj->tdo,(dvoid**)&fbh->obj->obj_value,(dvoid**)&fbh->obj->obj_ind,status);
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");
#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 */
}
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);
}
*pwdp = strchr(*uidp, '/');
*(*pwdp)++ = '\0';
/* XXX look for '@', e.g. "u/p@d" and "u@d" and maybe "@d"? */
}
if (**uidp == '\0' && **pwdp == '\0') {
return OCI_CRED_EXT;
}
#ifdef ORA_OCI_112
if (!imp_dbh->using_drcp) {
#endif
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,
*uidp, strlen(*uidp),
(ub4) OCI_ATTR_USERNAME, imp_dbh->errhp, status);
OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp, OCI_HTYPE_SESSION,
(strlen(*pwdp)) ? *pwdp : NULL, strlen(*pwdp),
(ub4) OCI_ATTR_PASSWORD, imp_dbh->errhp, status);
#ifdef ORA_OCI_112
}
#endif
return OCI_CRED_RDBMS;
}
int
{
dTHX;
sword status;
#ifdef ORA_OCI_112
if (imp_dbh->using_drcp) {
return 0;
}
#endif
/* XXX should possibly create new session before ending the old so */
/* that if the new one can't be created, the old will still work. */
OCISessionEnd_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp,
imp_dbh->seshp, OCI_DEFAULT, status); /* XXX check status here?*/
OCISessionBegin_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, imp_dbh->seshp,
ora_parse_uid(imp_dbh, &uid, &pwd), (ub4) OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCISessionBegin");
return 0;
}
return 1;
}
#ifdef not_used_curently
"Unable to parse table name for LOB refetch");
if (!imp_sth->dschp){
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
if (status != OCI_SUCCESS) {
oci_error(sth,imp_sth->errhp, status, "OCIHandleAlloc");
}
}
OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
(ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_SYN, imp_sth->dschp, status);
if (status == OCI_SUCCESS) { /* There is a synonym, get the schema */
char *syn_schema=NULL;
char syn_name[100];
ub4 tn_len = 0, syn_schema_len = 0;
strncpy(syn_name,tablename,strlen(tablename));
/* Put the synonym name here for later user */
OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE,
&parmhp, 0, OCI_ATTR_PARAM, errhp, status);
OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&syn_schema, &syn_schema_len, OCI_ATTR_SCHEMA_NAME, errhp, status);
OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&tablename, &tn_len, OCI_ATTR_NAME, errhp, status);
strncpy(new_tablename,syn_schema,syn_schema_len);
new_tablename[syn_schema_len+1] = '\0';
new_tablename[syn_schema_len]='.';
strncat(new_tablename, tablename,tn_len);
tablename=new_tablename;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" lob refetch using a synonym named=%s for %s \n",
syn_name,tablename);
}
OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
(ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_TABLE, imp_sth->dschp, status);
if (status != OCI_SUCCESS) {
/* XXX this OCI_PTYPE_TABLE->OCI_PTYPE_VIEW fallback should actually be */
/* a loop that includes synonyms etc */
OCIDescribeAny_log_stat(imp_sth, imp_sth->svchp, errhp, tablename, strlen(tablename),
(ub1)OCI_OTYPE_NAME, (ub1)1, (ub1)OCI_PTYPE_VIEW, imp_sth->dschp, status);
if (status != OCI_SUCCESS) {
OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
return oci_error(sth, errhp, status, "OCIDescribeAny(view)/LOB refetch");
}
}
OCIAttrGet_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE,
&parmhp, 0, OCI_ATTR_PARAM, errhp, status);
if (!status ) {
OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&numcols, 0, OCI_ATTR_NUM_COLS, errhp, status);
}
if (!status ) {
OCIAttrGet_log_stat(imp_sth, parmhp, OCI_DTYPE_PARAM,
&collisthd, 0, OCI_ATTR_LIST_COLUMNS, errhp, status);
}
if (status != OCI_SUCCESS) {
OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch");
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" lob refetch from table %s, %d columns:\n",
tablename, numcols);
for (i = 1; i <= (long)numcols; i++) {
ub2 col_dbtype;
char *col_name;
ub4 col_name_len;
OCIParamGet_log_stat(imp_sth, collisthd, OCI_DTYPE_PARAM, errhp, (dvoid**)&colhd, i, status);
if (status)
break;
OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_dbtype, 0,
OCI_ATTR_DATA_TYPE, errhp, status);
if (status)
break;
OCIAttrGet_log_stat(imp_sth, colhd, OCI_DTYPE_PARAM, &col_name, &col_name_len,
OCI_ATTR_NAME, errhp, status);
if (status)
break;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" lob refetch table col %d: '%.*s' otype %d\n",
(int)i, (int)col_name_len,col_name, col_dbtype);
OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM);
colhd = NULL;
}
if (colhd)
OCIDescriptorFree_log(imp_sth, colhd, OCI_DTYPE_PARAM);
if (status != OCI_SUCCESS) {
oci_error(sth, errhp, status,
"OCIDescribeAny/OCIParamGet/OCIAttrGet/LOB refetch");
OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
return 0;
}
if (!lob_cols_hv)
return oci_error(sth, errhp, OCI_ERROR,
"LOB refetch failed, no lobs in table");
/* our bind params are in %imp_sth->all_params_hv
our table cols are in %lob_cols_hv
we now iterate through our bind params
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" lob refetch sql: %s\n", SvPVX(sql_select));
lr->stmthp = NULL;
lr->bindhp = NULL;
lr->rowid = NULL;
lr->parmdp_tmp = NULL;
lr->parmdp_lob = NULL;
OCIHandleAlloc_ok(imp_sth, imp_sth->envhp, &lr->stmthp, OCI_HTYPE_STMT, status);
OCIStmtPrepare_log_stat(imp_sth, lr->stmthp, errhp,
(text*)SvPVX(sql_select), SvCUR(sql_select), OCI_NTV_SYNTAX,
OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
Safefree(lr);
return oci_error(sth, errhp, status, "OCIStmtPrepare/LOB refetch");
}
/* bind the rowid input */
OCIDescriptorAlloc_ok(imp_sth, imp_sth->envhp, &lr->rowid, OCI_DTYPE_ROWID);
OCIBindByName_log_stat(imp_sth, lr->stmthp, &lr->bindhp, errhp, (text*)":rid", 4,
&lr->rowid, sizeof(OCIRowid*), SQLT_RDD, 0,0,0,0,0, OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
Safefree(lr);
return oci_error(sth, errhp, status, "OCIBindByPos/LOB refetch");
}
/* define the output fields */
for(i=0; i < lr->num_fields; ++i) {
if (!phs_svp)
croak("panic: LOB refetch for '%s' param (%ld) - name not found",fbh->name,(unsigned long)i+1);
phs = (phs_t*)(void*)SvPVX(*phs_svp);
fbh->special = phs;
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" lob refetch %d for '%s' param: ftype %d setup\n",
(int)i+1,fbh->name, fbh->dbtype);
fbh->fb_ary = fb_ary_alloc(fbh->disize, 1);
OCIDefineByPos_log_stat(imp_sth, lr->stmthp, &defnp, errhp, (ub4)i+1,
&fbh->desc_h, -1, (ub2)fbh->ftype,
fbh->fb_ary->aindp, 0, fbh->fb_ary->arcode, OCI_DEFAULT, status);
if (status != OCI_SUCCESS) {
OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
OCIHandleFree(lr->stmthp, OCI_HTYPE_STMT);
Safefree(lr);
fb_ary_free(fbh->fb_ary);
fbh->fb_ary = NULL;
return oci_error(sth, errhp, status, "OCIDefineByPos/LOB refetch");
}
}
OCIHandleFree_log_stat(imp_sth, imp_sth->dschp, OCI_HTYPE_DESCRIBE, status);
imp_sth->lob_refetch = lr; /* structure copy */
return 1;
}
int
post_execute_lobs(SV *sth, imp_sth_t *imp_sth, ub4 row_count) /* XXX leaks handles on error */
{
/* To insert a new LOB transparently (without using 'INSERT . RETURNING .') */
SV *phs_svp;
I32 i;
char *p;
hv_iterinit(imp_sth->all_params_hv);
while( (phs_svp = hv_iternextsv(imp_sth->all_params_hv, &p, &i)) != NULL ) {
phs_t *phs = (phs_t*)(void*)SvPVX(phs_svp);
if (phs->desc_h && !phs->is_inout){
OCILobFreeTemporary_log_stat(imp_sth, imp_sth->svchp, imp_sth->errhp, phs->desc_h, status);
/* boolean lobEmpty=1;*/
/* OCIAttrSet_log_stat(phs->desc_h, phs->desc_t,&lobEmpty, 0, OCI_ATTR_LOBEMPTY, imp_sth->errhp, status);*/
/* OCIHandleFree_log_stat(phs->desc_h, phs->desc_t, status);*/
}
/*this seem to cause an error later on so I just got rid of it for Now does */
/* not seem to kill anything */
}
}
return 1;
}
if (row_count == 0)
return 1; /* nothing to do */
if (row_count > 1)
return oci_error(sth, errhp, OCI_ERROR, "LOB refetch attempted for multiple rows");
if (!imp_sth->lob_refetch) {
if (!init_lob_refetch(sth, imp_sth))
return 0; /* init_lob_refetch already called oci_error */
}
lr = imp_sth->lob_refetch;
OCIAttrGet_stmhp_stat(imp_sth, lr->rowid, 0, OCI_ATTR_ROWID,status);
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status, "OCIAttrGet OCI_ATTR_ROWID /LOB refetch");
OCIStmtExecute_log_stat(imp_sth, imp_sth->svchp, lr->stmthp, errhp,1, 0, NULL, NULL, OCI_DEFAULT, status); /* execute and fetch */
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status,
ora_sql_error(imp_sth,"OCIStmtExecute/LOB refetch"));
for(i=0; i < lr->num_fields; ++i) {
imp_fbh_t *fbh = &lr->fbh_ary[i];
int rc = fbh->fb_ary->arcode[0];
phs_t *phs = (phs_t*)fbh->special;
amtp = SvCUR(phs->sv); /* XXX UTF8? */
if (rc == 1405) { /* NULL - return undef */
sv_set_undef(phs->sv);
status = OCI_SUCCESS;
}
else if (amtp > 0) { /* since amtp==0 & OCI_ONE_PIECE fail (OCI 8.0.4) */
if( ! fbh->csid ) {
ub1 csform = SQLCS_IMPLICIT;
ub2 csid = 0;
OCILobCharSetForm_log_stat(imp_sth,
imp_sth->envhp,
errhp,
(OCILobLocator*)fbh->desc_h,
&csform,
status );
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status, "OCILobCharSetForm");
#ifdef OCI_ATTR_CHARSET_ID
/* Effectively only used so AL32UTF8 works properly */
OCILobCharSetId_log_stat(imp_sth,
imp_sth->envhp,
errhp,
(OCILobLocator*)fbh->desc_h,
&csid,
status );
if (status != OCI_SUCCESS)
return oci_error(sth, errhp, status, "OCILobCharSetId");
#endif /* OCI_ATTR_CHARSET_ID */
/* if data is utf8 but charset isn't then switch to utf8 csid */
csid = (SvUTF8(phs->sv) && !CS_IS_UTF8(csid)) ? utf8_csid : CSFORM_IMPLIED_CSID(csform);
fbh->csid = csid;
fbh->csform = csform;
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
" calling OCILobWrite fbh->csid=%d fbh->csform=%d amtp=%d\n",
fbh->csid, fbh->csform, amtp );
OCILobWrite_log_stat(imp_sth, imp_sth->svchp, errhp,
(OCILobLocator*)fbh->desc_h, &amtp, 1, SvPVX(phs->sv), amtp, OCI_ONE_PIECE,
0,0, fbh->csid ,fbh->csform, status);
if (status != OCI_SUCCESS) {
return oci_error(sth, errhp, status, "OCILobWrite in post_execute_lobs");
}
} else { /* amtp==0 so truncate LOB to zero length */
OCILobTrim_log_stat(imp_sth, imp_sth->svchp, errhp, (OCILobLocator*)fbh->desc_h, 0, status);
if (status != OCI_SUCCESS) {
return oci_error(sth, errhp, status, "OCILobTrim in post_execute_lobs");
}
}
if (DBIc_DBISTATE(imp_sth)->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(
DBIc_LOGPIO(imp_sth),
void
ora_free_lob_refetch(SV *sth, imp_sth_t *imp_sth)
{
dTHX;
lob_refetch_t *lr = imp_sth->lob_refetch;
int i;
sword status;
if (lr->rowid)
OCIDescriptorFree_log(imp_sth, lr->rowid, OCI_DTYPE_ROWID);
OCIHandleFree_log_stat(imp_sth, lr->stmthp, OCI_HTYPE_STMT, status);
if (status != OCI_SUCCESS)
oci_error(sth, imp_sth->errhp, status, "ora_free_lob_refetch/OCIHandleFree");
for(i=0; i < lr->num_fields; ++i) {
imp_fbh_t *fbh = &lr->fbh_ary[i];
ora_free_fbh_contents(sth, fbh);
}
sv_free(lr->fbh_ary_sv);
Safefree(imp_sth->lob_refetch);
text buf[2];
ub4 vernum;
if( imp_dbh->server_version > 0 ) {
return imp_dbh->server_version;
}
/* XXX should possibly create new session before ending the old so */
/* that if the new one can't be created, the old will still work. */
OCIServerRelease_log_stat(imp_dbh, imp_dbh->svchp, imp_dbh->errhp, buf, 2,OCI_HTYPE_SVCCTX, &vernum , status);
if (status != OCI_SUCCESS) {
oci_error(dbh, imp_dbh->errhp, status, "OCISessionServerRelease");
return 0;
}
imp_dbh->server_version = vernum;
return vernum;
}
How to output arguments that are handles to opaque entities (OCIEnv*, etc)?
Output of pointer address is a quick n' dirty way of identifying
any number of handles that may be allocated.... yuck...
It sure would be nice to give something more mnemonic! (and meaningful!)
XXX Turn pointers into variable names by adding a prefix letter and, where
appropriate an &, thus: "...,&p%ld,...",
If done well the log will read like a compilable program.
*/
#define OCIServerRelease_log_stat(impdbh,sc,errhp,b,bl,ht,ver,stat) \
stat =OCIServerRelease(sc,errhp,b,bl,ht,ver);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIServerRelease(%p)=%s\n",\
OciTp, sc,oci_status_name(stat)),stat \
: stat
#define OCISessionRelease_log_stat(impdbh,svchp,errhp,tag,tagl,mode,stat) \
stat =OCISessionRelease(svchp, errhp, tag, tagl, mode);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCISessionRelease(svchp=%p,tag=\"%s\",mode=%u)=%s\n",\
OciTp, svchp,tag,mode,oci_status_name(stat)),stat \
: stat
#define OCISessionPoolDestroy_log_stat(impdbh, ph, errhp,stat ) \
stat =OCISessionPoolDestroy(ph, errhp,OCI_DEFAULT);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCISessionPoolDestroy(ph=%p)=%s\n",\
OciTp, ph,oci_status_name(stat)),stat \
: stat
#define OCISessionGet_log_stat(impdbh,envhp,errhp,sh,ah,pn,pnl,tag,tagl,rettag,rettagl,found,stat) \
stat =OCISessionGet(envhp, errhp, sh, ah,pn,pnl,tag,tagl,rettag,rettagl,found, OCI_SESSGET_SPOOL);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCISessionGet(envhp=%p,sh=%p,ah=%p,pn=%p,pnl=%d,tag=\"%s\",found=%d)=%s\n",\
OciTp, envhp,sh,ah,pn,pnl,tag,*found,oci_status_name(stat)),stat \
: stat
#define OCISessionPoolCreate_log_stat(impdbh,envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,mode,stat) \
stat =OCISessionPoolCreate(envhp,errhp,ph,pn,pnl,dbn,dbl,sn,sm,si,un,unl,pw,pwl,mode);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCISessionPoolCreate(envhp=%p,ph=%p,pn=%p,pnl=%p,min=%d,max=%d,incr=%d, un=%s,unl=%lu,pw=%s,pwl=%lu,mode=%u)=%s\n",\
OciTp, envhp,ph,pn,pnl,sn,sm,si,un,(unsigned long)unl,pw,(unsigned long)pwl,mode,oci_status_name(stat)),stat \
: stat
#if defined(ORA_OCI_102)
#define OCIPing_log_stat(impdbh,sc,errhp,stat) \
stat =OCIPing(sc,errhp,OCI_DEFAULT);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIPing(%p)=%s\n",\
OciTp, sc,oci_status_name(stat)),stat \
: stat
#endif
#define OCIServerVersion_log_stat(impdbh,sc,errhp,b,bl,ht,stat) \
stat =OCIServerVersion(sc,errhp,b,bl,ht);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIServerVersion_log_stat(%p,%s)=%s\n",\
OciTp, sc,b,oci_status_name(stat)),stat \
: stat
#define OCIStmtGetPieceInfo_log_stat(impsth,stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece,stat) \
stat =OCIStmtGetPieceInfo(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIStmtGetPieceInfo_log_stat(%p,%p,%u)=%s\n",\
OciTp, (void*)errhp,fbh,*piece,oci_status_name(stat)),stat \
: stat
#define OCIStmtSetPieceInfo_log_stat(impsth,ptr,errhp,buf,blen,p,indp,rc,stat) \
stat =OCIStmtSetPieceInfo(ptr,OCI_HTYPE_DEFINE,errhp, buf, blen, p,indp,rc);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIStmtSetPieceInfo_log_stat(%p,%p,%d,%p)=%s\n",\
OciTp, (void*)errhp,fbh,piece,blen,oci_status_name(stat)),stat \
: stat
#define OCIDefineDynamic_log_stat(impsth,defnp,errhp,fbh,stat) \
stat =OCIDefineDynamic(defnp,errhp,fbh,(OCICallbackDefine) presist_lob_fetch_cbk );\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIDefineDynamic_log_stat(%p,%p,%p)=%s\n",\
OciTp, (void*)defnp, (void*)errhp,fbh,oci_status_name(stat)),stat \
: stat
#define OCIXMLTypeCreateFromSrc_log_stat(impdbh,svchp,errhp,duration,src_type,src_ptr,ind,xml,stat) \
stat =OCIXMLTypeCreateFromSrc (svchp,errhp,duration,(ub1)src_type,(dvoid *)src_ptr,(sb4)ind, xml);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIXMLTypeCreateFromSrc_log_stat(%p,%p,%d,%d,%p,%d,%p)=%s\n",\
OciTp, (void*)svchp,(void*)errhp, duration, src_type, src_ptr, ind, xml, oci_status_name(stat)),stat \
: stat
#define OCILobFileIsOpen_log_stat(impdbh,envhp,errhp,loc,is_open,stat) \
stat = OCILobFileIsOpen(envhp,errhp,loc,is_open);\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCILobFileIsOpen_log_stat(%p,%p,%p,%p,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp, loc, is_open, *is_open,oci_status_name(stat)),stat : stat
#define OCILobLocatorIsInit_log_stat(impdbh,envhp,errhp,loc,is_initp,stat) \
stat =OCILobLocatorIsInit (envhp,errhp,loc,is_initp );\
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCILobLocatorIsInit_log_stat(%p,%p,%p,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,loc,*is_initp,oci_status_name(stat)),stat \
: stat
#define OCIObjectPin_log_stat(impsth,envhp,errhp,or,ot,stat) \
stat = OCIObjectPin(envhp,errhp,or,(OCIComplexObject *)0,OCI_PIN_LATEST,OCI_DURATION_TRANS,OCI_LOCK_NONE,ot);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sObjectPin_log_stat(%p,%p,%p,%p)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,or,ot,oci_status_name(stat)),stat \
: stat
/*
#define OCICollGetElem_log_stat(envhp,errhp,v,i,ex,e,ne,stat)\
stat = OCICollGetElem(envhp,errhp, v,i,ex,e,ne);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
"%sOCICollGetElem_log_stat(%p,%p,%d,%d,%d,%d,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,v,i,ex,e,ne,oci_status_name(stat)),stat \
: stat
*/
/*
#define OCITableFirst_log_stat(envhp,errhp,v,i,stat)\
stat = OCITableFirst(envhp,errhp,v,i);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
"%sOCITableFirst_log_stat(%p,%p,%d,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,v,i,oci_status_name(stat)),stat \
: stat
*/
#define OCIObjectGetAttr_log_stat(impsth,envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue, attrtdo, stat) \
stat = OCIObjectGetAttr(envhp,errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo); \
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIObjectGetAttr_log_stat(%p,%p,%p,%p,%p,%p,%p,%d,%p,%d,%p,%p,%p,%p)=%s\n",\
OciTp, (void*)envhp,(void*)errhp,instance,nullstruct,tdo,names,lengths,namecount,indexes,indexcount,attrnullstatus,attrnullstruct,attrvalue,attrtdo,oci_status_name(stat)),stat \
: stat
#define OCIIntervalToText_log_stat(impsth,envhp,errhp,di,sb,ln,sl,stat) \
stat = OCIIntervalToText(envhp,errhp, *(OCIInterval**)di,3,3,sb,ln,sl);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIIntervalToText(%p,%p,%p,%s)=%s\n",\
OciTp, (void*)errhp, di,sl,sb,oci_status_name(stat)),stat \
: stat
#define OCIDateTimeToText_log_stat(impsth,envhp,errhp,d,sl,sb,stat) \
stat = OCIDateTimeToText(envhp,errhp, *(OCIDateTime**)d,(CONST text*) 0,(ub1) 0,6, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIDateTimeToText(%p,%p,%p,%s)=%s\n",\
OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \
: stat
#define OCIDateToText_log_stat(impsth,errhp,d,sl,sb,stat) \
stat = OCIDateToText(errhp, (CONST OCIDate *) d,(CONST text*) 0,(ub1) 0, (CONST text*) 0, (ub4) 0,(ub4 *)sl,sb );\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sDateToText_log_stat(%p,%p,%p,%s)=%s\n",\
OciTp, (void*)errhp, d,sl,sb,oci_status_name(stat)),stat \
: stat
#define OCIIterDelete_log_stat(impsth,envhp,errhp,itr,stat) \
stat = OCIIterDelete(envhp,errhp,itr );\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIIterDelete_log_stat(%p,%p,%p)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,itr,oci_status_name(stat)),stat \
: stat
#define OCIIterCreate_log_stat(impsth,envhp,errhp,coll,itr,stat) \
stat = OCIIterCreate(envhp,errhp,coll,itr);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sIterCreate_log_stat(%p,%p,%p)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,(void*)coll,oci_status_name(stat)),stat \
: stat
/*
#define OCICollSize_log_stat(envhp,errhp,coll,coll_siz,stat)\
stat = OCICollSize(envhp,errhp,(CONST OCIColl *)coll,coll_siz);\
(DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
"%sOCICollSize_log_stat(%p,%p,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp,oci_status_name(stat)),stat \
: stat
*/
#define OCIDefineObject_log_stat(impsth,defnp,errhp,tdo,eo_buff,eo_ind,stat) \
stat = OCIDefineObject(defnp,errhp,tdo,eo_buff,0,eo_ind, 0);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sOCIDefineObject(%p,%p,%p)=%s\n",\
OciTp, (void*)defnp, (void*)errhp, (void*)tdo,oci_status_name(stat)),stat \
: stat
#define OCITypeByName_log(impsth,envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo,stat) \
stat = OCITypeByName(envhp,errhp,svchp,sn,snl,tn,tnl,vn,vnl,duration,option,tdo); \
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sTypeByName(%p,%p,%p,%s,%d,%s,%d,\"\",0,%d,%d,%p)=%s\n", \
OciTp, (void*)envhp, (void*)errhp, (void*)svchp, sn,snl,tn,tnl,duration,option,tdo,oci_status_name(stat)), stat \
:stat
#define OCITypeByRef_log_stat(impsth,envhp,errhp,ref,tdo,stat) \
stat = OCITypeByRef(envhp,errhp,ref,OCI_DURATION_TRANS,OCI_TYPEGET_ALL,tdo);\
(DBD_OCI_TRACEON(impsth)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sTypeByRef(%p,%p,%p)=%s\n",\
OciTp, (void*)envhp, (void*)errhp, (void*)ref,oci_status_name(stat)),stat \
: stat
/* added by lab */
#define OCILobCharSetId_log_stat(impxxh, envhp, errhp, locp, csidp, stat ) \
stat = OCILobCharSetId( envhp, errhp, locp, csidp ); \
(DBD_OCI_TRACEON(impxxh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobCharSetId(%p,%p,%p,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp, (void*)locp, *csidp, oci_status_name(stat)),stat \
: stat
/* added by lab */
#define OCILobCharSetForm_log_stat(impxxh, envhp, errhp, locp, formp, stat ) \
stat = OCILobCharSetForm( envhp, errhp, locp, formp ); \
(DBD_OCI_TRACEON(impxxh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobCharSetForm(%p,%p,%p,%d)=%s\n",\
OciTp, (void*)envhp, (void*)errhp, (void*)locp, *formp, oci_status_name(stat)),stat \
: stat
/* added by lab */
#define OCINlsEnvironmentVariableGet_log_stat(impdbh, valp, size, item, charset, rsizep ,stat ) \
stat = OCINlsEnvironmentVariableGet( valp, size, item, charset, rsizep ); \
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sNlsEnvironmentVariableGet(%d,%lu,%d,%d,%lu)=%s\n",\
OciTp, *valp, (unsigned long)size, item, charset, (unsigned long)*rsizep, oci_status_name(stat)),stat \
: stat
/* added by lab */
#define OCIEnvNlsCreate_log_stat(impdbh, envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ,stat ) \
stat = OCIEnvNlsCreate(envp, mode, ctxp, f1, f2, f3, sz, usremepp ,chset, nchset ); \
(DBD_OCI_TRACEON(impdbh)) \
? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sEnvNlsEnvCreate(%p,%s,%d,%d,%p,%p,%p,%d,%p,%d,%d)=%s\n", \
OciTp, (void*)envp, oci_mode(mode),mode, ctxp, (void*)f1, (void*)f2, (void*)f3, sz, (void*)usremepp ,chset, nchset, oci_status_name(stat)),stat \
: stat
#define OCIAttrGet_log_stat(impxxh, th,ht,ah,sp,at,eh,stat) \
stat = OCIAttrGet(th,ht,ah,sp,at,eh); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \
OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_attr_name(at),(void*)eh,\
oci_status_name(stat)),stat : stat
#define OCIAttrGet_d_log_stat(impsth, th,ht,ah,sp,at,eh,stat) \
stat = OCIAttrGet(th,ht,ah,sp,at,eh); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sAttrGet(%p,%s,%p,%p,%s,%p)=%s\n", \
OciTp, (void*)th,oci_hdtype_name(ht),(void*)ah,pul_t(sp),oci_dtype_attr_name(at),(void*)eh,\
oci_status_name(stat)),stat : stat
#define OCIAttrGet_parmap(imp_sth,dh, ht, p1, l, stat) \
OCIAttrGet_log_stat(imp_sth, dh, ht, \
(void*)(p1), (l), OCI_ATTR_PARAM, imp_sth->errhp, stat)
#define OCIAttrGet_parmdp(imp_sth, parmdp, p1, l, a, stat) \
OCIAttrGet_d_log_stat(imp_sth, parmdp, OCI_DTYPE_PARAM, \
(void*)(p1), (l), (a), imp_sth->errhp, stat)
#define OCIAttrGet_stmhp_stat(imp_sth, p1, l, a, stat) \
OCIAttrGet_log_stat(imp_sth, imp_sth->stmhp, OCI_HTYPE_STMT, \
(void*)(p1), (l), (a), imp_sth->errhp, stat)
#define OCIAttrGet_stmhp_stat2(imp_sth, stmhp, p1, l, a, stat) \
OCIAttrGet_log_stat(imp_sth, stmhp, OCI_HTYPE_STMT, \
(void*)(p1), (l), (a), imp_sth->errhp, stat)
#define OCIAttrSet_log_stat(impxxh,th,ht,ah,s1,a,eh,stat) \
stat=OCIAttrSet(th,ht,ah,s1,a,eh); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sAttrSet(%p,%s, %p,%lu,Attr=%s,%p)=%s\n", \
OciTp, (void*)th,oci_hdtype_name(ht),(void *)ah,ul_t(s1),oci_attr_name(a),(void*)eh, \
oci_status_name(stat)),stat : stat
#define OCIBindByName_log_stat(impsth,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(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%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=%s,%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)),(cu ? *(int*)cu : 0 ) ,oci_bind_options(md),ul_t((md)), \
oci_status_name(stat)),stat : stat
#define OCIBindArrayOfStruct_log_stat(impsth,bp,ep,sd,si,sl,sr,stat) \
stat=OCIBindArrayOfStruct(bp,ep,sd,si,sl,sr); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%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(impsth,bh,eh,icx,cbi,ocx,cbo,stat) \
stat=OCIBindDynamic(bh,eh,icx,cbi,ocx,cbo); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sBindDynamic(%p,%p,%p,%p,%p,%p)=%s\n", \
OciTp, (void*)bh,(void*)eh,(void*)icx,(void*)cbi, \
(void*)ocx,(void*)cbo, \
oci_status_name(stat)),stat : stat
#define OCIDefineByPos_log_stat(impsth,sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m,stat) \
stat=OCIDefineByPos(sh,dp,eh,p1,vp,vs,dt,ip,rp,cp,m); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sDefineByPos(%p,%p,%p,%lu,%p,%ld,%u,%p,%p,%p,mode=%s,%lu)=%s\n", \
OciTp, (void*)sh,(void*)dp,(void*)eh,ul_t((p1)),(void*)(vp), \
sl_t(vs),(ub2)dt,(void*)(ip),(ub2*)(rp),(ub2*)(cp),oci_define_options(m),ul_t(m), \
oci_status_name(stat)),stat : stat
#define OCIDescribeAny_log_stat(impsth,sh,eh,op,ol,opt,il,ot,dh,stat) \
stat=OCIDescribeAny(sh,eh,op,ol,opt,il,ot,dh); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sDescribeAny(%p,%p,%p,%lu,%u,%u,%u,%p)=%s\n", \
OciTp, (void*)sh,(void*)eh,(void*)op,ul_t(ol), \
(ub1)opt,(ub1)il,(ub1)ot,(void*)dh, \
oci_status_name(stat)),stat : stat
#define OCIDescriptorAlloc_ok(impxxh,envhp, p1, t) \
if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sDescriptorAlloc(%p,%p,%s,0,0)\n", \
OciTp,(void*)envhp,(void*)(p1),oci_hdtype_name(t)); \
if (OCIDescriptorAlloc((envhp), (void**)(p1), (t), 0, 0)==OCI_SUCCESS); \
else croak("OCIDescriptorAlloc (type %d) failed",t)
#define OCIDescriptorFree_log(impxxh,d,t) \
if (DBD_OCI_TRACEON(impxxh)) PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sDescriptorFree(%p,%s)\n", OciTp, (void*)d,oci_hdtype_name(t)); \
OCIDescriptorFree(d,t)
#define OCIEnvInit_log_stat(impdbh,ev,md,xm,um,stat) \
stat=OCIEnvInit(ev,md,xm,um); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sEnvInit(%p,%lu,%lu,%p)=%s\n", \
OciTp, (void*)ev,ul_t(md),ul_t(xm),(void*)um, \
oci_status_name(stat)),stat : stat
#define OCIErrorGet_log_stat(impxxh, hp,rn,ss,ep,bp,bs,t, stat) \
((stat = OCIErrorGet(hp,rn,ss,ep,bp,bs,t)), \
((DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sErrorGet(%p,%lu,\"%s\",%p,\"%s\",%lu,%lu)=%s\n", \
OciTp, (void*)hp,ul_t(rn),OciTstr(ss),psl_t(ep), \
bp,ul_t(bs),ul_t(t), oci_status_name(stat)),stat : stat))
#define OCIHandleAlloc_log_stat(impxxh,ph,hp,t,xs,ump,stat) \
stat=OCIHandleAlloc(ph,hp,t,xs,ump); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sHandleAlloc(%p,%p,%s,%lu,%p)=%s\n", \
OciTp, (void*)ph,(void*)hp,oci_hdtype_name(t),ul_t(xs),(void*)ump, \
oci_status_name(stat)),stat : stat
#define OCIHandleAlloc_ok(impxxh,envhp, p1, t, stat) \
OCIHandleAlloc_log_stat(impxxh,(envhp),(void**)(p1),(t),0,0, stat); \
if (stat==OCI_SUCCESS) ; \
else croak("OCIHandleAlloc(%s) failed",oci_hdtype_name(t))
#define OCIHandleFree_log_stat(impxxh,hp,t,stat) \
stat=OCIHandleFree( (hp), (t)); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sHandleFree(%p,%s)=%s\n",OciTp,(void*)hp,oci_hdtype_name(t), \
oci_status_name(stat)),stat : stat
#define OCILobGetLength_log_stat(impxxh,sh,eh,lh,l,stat) \
stat=OCILobGetLength(sh,eh,lh,l); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobGetLength(%p,%p,%p,%p)=%s\n", \
OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(l), \
oci_status_name(stat)),stat : stat
#define OCILobGetChunkSize_log_stat(impdbh,sh,eh,lh,cs,stat) \
stat=OCILobGetChunkSize(sh,eh,lh,cs); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sLobGetChunkSize(%p,%p,%p,%p)=%s\n", \
OciTp, (void*)sh,(void*)eh,(void*)lh,pul_t(cs), \
oci_status_name(stat)),stat : stat
#define OCILobFileOpen_log_stat(impxxh,sv,eh,lh,mode,stat) \
stat=OCILobFileOpen(sv,eh,lh,mode); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobFileOpen(%p,%p,%p,%u)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh,(ub1)mode, \
oci_status_name(stat)),stat : stat
#define OCILobFileClose_log_stat(impsth,sv,eh,lh,stat) \
stat=OCILobFileClose(sv,eh,lh); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sLobFileClose(%p,%p,%p)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh, \
oci_status_name(stat)),stat : stat
/*Added by JPS for Jeffrey.Klein*/
#define OCILobCreateTemporary_log_stat(impdbh,sv,eh,lh,csi,csf,lt,ca,dur,stat) \
stat=OCILobCreateTemporary(sv,eh,lh,csi,csf,lt,ca,dur); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sLobCreateTemporary(%p,%p,%p,%lu,%lu,%lu,%lu,%lu)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh, \
ul_t(csi),ul_t(csf),ul_t(lt),ul_t(ca),ul_t(dur), \
oci_status_name(stat)),stat : stat
/*end add*/
#define OCILobFreeTemporary_log_stat(impxxh,sv,eh,lh,stat) \
stat=OCILobFreeTemporary(sv,eh,lh); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobFreeTemporary(%p,%p,%p)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh, \
oci_status_name(stat)),stat : stat
#define OCILobIsTemporary_log_stat(impsth,ev,eh,lh,istemp,stat) \
stat=OCILobIsTemporary(ev,eh,lh,istemp); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sLobIsTemporary(%p,%p,%p,%p)=%s\n", \
OciTp, (void*)ev,(void*)eh,(void*)lh,(void*)istemp, \
oci_status_name(stat)),stat : stat
/*Added by JPS for Jeffrey.Klein */
#define OCILobLocatorAssign_log_stat(impdbh,sv,eh,src,dest,stat) \
stat=OCILobLocatorAssign(sv,eh,src,dest); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sLobLocatorAssign(%p,%p,%p,%p)=%s\n", \
OciTp,(void*)sv,(void*)eh,(void*)src,(void*)dest, \
oci_status_name(stat)),stat : stat
/*end add*/
#define OCILobRead_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf,stat) \
stat=OCILobRead(sv,eh,lh,am,of,bp,bl,cx,cb,csi,csf); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobRead(%p,%p,%p,%p,%lu,%p,%lu,%p,%p,%u,%u)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
(void*)bp,ul_t(bl),(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
oci_status_name(stat)),stat : stat
#define OCILobTrim_log_stat(impxxh,sv,eh,lh,l,stat) \
stat=OCILobTrim(sv,eh,lh,l); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobTrim(%p,%p,%p,%lu)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh,ul_t(l), \
oci_status_name(stat)),stat : stat
#define OCILobWrite_log_stat(impxxh,sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf,stat) \
stat=OCILobWrite(sv,eh,lh,am,of,bp,bl,p1,cx,cb,csi,csf); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobWrite(%p,%p,%p,%p,%lu,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am),ul_t(of), \
(void*)bp,ul_t(bl),(ub1)p1, \
(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
oci_status_name(stat)),stat : stat
#define OCILobWriteAppend_log_stat(impxxh,sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf,stat) \
stat=OCILobWriteAppend(sv,eh,lh,am,bp,bl,p1,cx,cb,csi,csf); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sLobWriteAppend(%p,%p,%p,%p,%p,%lu,%u,%p,%p,%u,%u)=%s\n", \
OciTp, (void*)sv,(void*)eh,(void*)lh,pul_t(am), \
(void*)bp,ul_t(bl),(ub1)p1, \
(void*)cx,(void*)cb,(ub2)csi,(ub1)csf, \
oci_status_name(stat)),stat : stat
#define OCIParamGet_log_stat(impsth,hp,ht,eh,pp,ps,stat) \
stat=OCIParamGet(hp,ht,eh,pp,ps); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sParamGet(%p,%lu,%p,%p,%lu,%s)=%s\n", \
OciTp, (void*)hp,ul_t((ht)),(void*)eh,(void*)pp,ul_t(ps), \
oci_hdtype_name(ht),oci_status_name(stat)),stat : stat
#define OCIServerAttach_log_stat(imp_dbh, dbname,md,stat) \
stat=OCIServerAttach( imp_dbh->srvhp, imp_dbh->errhp, \
(text*)dbname, (sb4)strlen(dbname), md); \
(DBD_OCI_TRACEON(imp_dbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(imp_dbh), \
"%sServerAttach(%p, %p, \"%s\", %lu, mode=%s,%lu)=%s\n", \
OciTp, (void*)imp_dbh->srvhp,(void*)imp_dbh->errhp, dbname, \
ul_t(strlen(dbname)), oci_mode(md),ul_t(md),oci_status_name(stat)),stat : stat
#define OCIStmtExecute_log_stat(impsth,sv,st,eh,i,ro,si,so,md,stat) \
stat=OCIStmtExecute(sv,st,eh,i,ro,si,so,md); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sStmtExecute(%p,%p,%p,%lu,%lu,%p,%p,mode=%s,%lu)=%s\n", \
OciTp, (void*)sv,(void*)st,(void*)eh,ul_t((i)), \
ul_t((ro)),(void*)(si),(void*)(so),oci_exe_mode(md),ul_t((md)), \
oci_status_name(stat)),stat : stat
#define OCIStmtFetch_log_stat(impsth,sh,eh,nr,or,os,stat) \
stat=OCIStmtFetch2(sh,eh,nr,or,os,OCI_DEFAULT); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sStmtFetch(%p,%p,%lu,%u,%d)=%s\n", \
OciTp, (void*)sh,(void*)eh,ul_t(nr),(ub2)or,(ub2)os, \
oci_status_name(stat)),stat : stat
#define OCIStmtPrepare_log_stat(impsth,sh,eh,s1,sl,l,m,stat) \
stat=OCIStmtPrepare(sh,eh,s1,sl,l,m); \
(DBD_OCI_TRACEON(impsth)) ? PerlIO_printf(DBD_OCI_TRACEFP(impsth), \
"%sStmtPrepare(%p,%p,'%s',%lu,%lu,%lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,s1,ul_t(sl),ul_t(l),ul_t(m), \
oci_status_name(stat)),stat : stat
#define OCIServerDetach_log_stat(impdbh,sh,eh,md,stat) \
stat=OCIServerDetach(sh,eh,md); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sServerDetach(%p,%p,mode=%s,%lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \
oci_status_name(stat)),stat : stat
#define OCISessionBegin_log_stat(impdbh,sh,eh,uh,cr,md,stat) \
stat=OCISessionBegin(sh,eh,uh,cr,md); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sSessionBegin(%p,%p,%p,%lu,mode=%s %lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,(void*)uh,ul_t(cr),oci_mode(md),ul_t(md), \
oci_status_name(stat)),stat : stat
#define OCISessionEnd_log_stat(impdbh,sh,eh,ah,md,stat) \
stat=OCISessionEnd(sh,eh,ah,md); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sSessionEnd(%p,%p,%p,mode=%s %lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,(void*)ah,oci_mode(md),ul_t(md), \
oci_status_name(stat)),stat : stat
#define OCITransCommit_log_stat(impxxh,sh,eh,md,stat) \
stat=OCITransCommit(sh,eh,md); \
(DBD_OCI_TRACEON(impxxh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impxxh), \
"%sTransCommit(%p,%p,%lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,ul_t(md), \
oci_status_name(stat)),stat : stat
#define OCITransRollback_log_stat(impdbh,sh,eh,md,stat) \
stat=OCITransRollback(sh,eh,md); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sTransRollback(%p,%p,mode=%s %lu)=%s\n", \
OciTp, (void*)sh,(void*)eh,oci_mode(md),ul_t(md), \
oci_status_name(stat)),stat : stat
#define OCIDBStartup_log_stat(impdbh,svchp,errhp,admhp,mode,flags,stat) \
stat=OCIDBStartup(svchp,errhp,admhp,mode,flags); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIDBStartup(%p,%p,%p,%u,%u)=%s\n", \
OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode,flags, \
oci_status_name(stat)),stat : stat
#define OCIDBShutdown_log_stat(impdbh,svchp,errhp,admhp,mode,stat) \
stat=OCIDBShutdown(svchp,errhp,admhp,mode); \
(DBD_OCI_TRACEON(impdbh)) ? PerlIO_printf(DBD_OCI_TRACEFP(impdbh), \
"%sOCIDBShutdown(%p,%p,%p,%u)=%s\n", \
OciTp, (void*)svchp,(void*)errhp,(void*)admhp,mode, \
oci_status_name(stat)),stat : stat
#endif /* !DBD_OCI_TRACEON */
( run in 0.562 second using v1.01-cache-2.11-cpan-49f99fa48dc )