Drop Table
Support Forum for database administrators and web based access to important newsgroups related to databases
[svn:dbd-oracle] r3723 - in dbd-oracle/trunk: . tAuthor: byterock
Date: Tue Mar 28 08:47:33 2006
New Revision: 3723
Modified:
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
dbd-oracle/trunk/t/31lob.t
Log:
new code for Lobs from Jeffrey.Klein@priority-health.com
Modified: dbd-oracle/trunk/dbdimp.c
====================
====================
====================
================
==
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Tue Mar 28 08:47:33 2006
@@ -104,7 +104,7 @@
/* Under Cygwin there are issues with setting environment variables
* at runtime such that Windows-native libraries loaded by a Cygwin
* process can see those changes.
- *
+ *
* Cygwin maintains its own cache of environment variables, and also
* only writes to the Windows environment using the "_putenv" win32
* call. This call writes to a Windows C runtime cache, rather than
@@ -113,7 +113,7 @@
* In order to change environment variables so that the Oracle client
* DLL can see the change, the win32 function SetEnvironmentVariab
le
* must be called. This function gives an interface to that API.
- *
+ *
* It is only available when building under Cygwin, and is used by
* the testsuite.
*
@@ -255,7 +255,7 @@
/*recursive_lock_t lock; */
/*perl_cond user_cond;*/ /* For user-level conditions */
} shared_sv;
-
+
int
@@ -282,26 +282,26 @@
shared_dbh_priv_svp = (DBD_ATTRIB_OK(attr)
? hv_fetch((HV*)SvRV(a
ttr), "ora_db
h_share", 13, 0):NULL) ;
shared_dbh_priv_sv = shared_dbh_priv_svp? *shared_dbh_priv_svp
:NULL ;
- if (shared_dbh_priv_sv && SvROK(shared_dbh_pri
v_sv))
- shared_dbh_priv_sv = SvRV(shared_dbh_priv
_sv) ;
-
+ if (shared_dbh_priv_sv && SvROK(shared_dbh_pri
v_sv))
+ shared_dbh_priv_sv
= SvRV(shared_dbh_priv
_sv) ;
+
if (shared_dbh_priv_sv)
{
MAGIC * mg ;
SvLOCK (shared_dbh_priv_sv)
;
-
+
/* some magic from shared.xs (no public api yet :-( */
mg = mg_find(shared_dbh_p
riv_sv, PERL_MAGIC_shared_sc
alar) ;
-
+
shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ; /*sharedsv_find(*sh
ared_dbh_priv_sv) ;*/
if (!shared_dbh_ssv)
croak ("value of ora_dbh_share must be a scalar that is shared") ;
-
+
shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_s
sv -> sv) ;
shared_dbh_len = SvCUR((shared_dbh_ss
v -> sv)) ;
- if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t))
+ if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t))
croak ("Invalid value for ora_dbh_dup") ;
-
+
if (shared_dbh_len == sizeof (imp_dbh_t)) {
/* initialize from shared data */
memcpy (((char *)imp_dbh) + DBH_DUP_OFF, ((char *)shared_dbh) + DBH_DUP_OFF,
DBH_DUP_LEN) ;
@@ -314,7 +314,7 @@
shared_dbh = NULL ;
}
}
-#endif
+#endif
/* Check if we should re-use a ProC connection and not connect ourselves. */
DBD_ATTRIB_GET_IV(at
tr, " ora_use_proc_connect
ion", 23,
@@ -453,9 +453,9 @@
"OCIEnvNlsCreate. Check ORACLE_HOME env var, NLS settings, permissions, etc.
");
return 0;
}
-
+
/* update the hard-coded csid constants for unicode charsets */
- utf8_csid = OCINlsCharSetNameToI
d(imp_dbh->envhp, (void*)"
UTF8");
+ utf8_csid = OCINlsCharSetNameToI
d(imp_dbh->envhp, (void*)"
UTF8");
al32utf8_csid = OCINlsCharSetNameToI
d(imp_dbh->envhp, (void*)"AL32UTF8");
al16utf16_csid = OCINlsCharSetNameToI
d(imp_dbh->envhp, (void*)"AL16UTF16");
@@ -531,7 +531,7 @@
/* We don't have a way to get the actual charsetid & ncharsetid in use
* but we only care about UTF8 so we'll just check for that and use the
* the hardcoded utf8_csid if found
- */
+ */
char buf[81];
char *nls = ora_env_var("NLS_LANG", buf, sizeof(buf)-1);
if (nls && strlen(nls) >= 4 && !strcasecmp(nls + strlen(nls) - 4, "utf8"))
@@ -540,10 +540,10 @@
if (nls && strlen(nls) >= 4 && !strcasecmp(nls + strlen(nls) - 4, "utf8"))
ncharsetid = utf8_csid;
}
-#endif
+#endif
#endif
- /* At this point we have charsetid & ncharsetid
+ /* 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.
* BTW: NLS_NCHAR is set as follows: NSL_LANG=AL32UTF8
@@ -603,7 +603,7 @@
return 0;
}
- OCIAttrSet_log_stat(
imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp,
+ OCIAttrSet_log_stat(
imp_dbh->svchp, OCI_HTYPE_SVCCTX, imp_dbh->srvhp,
(ub4) 0, OCI_ATTR_SERVER, imp_dbh->errhp, status);
OCIHandleAlloc_ok(im
p_dbh->envhp, &imp_dbh->authp, OCI_HTYPE_SESSION, status
);
@@ -657,7 +657,7 @@
memcpy(SvPVX(shared_
dbh_priv_sv) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_
OFF, DBH_DUP_LEN) ;
SvSETMAGIC(shared_db
h_priv_sv);
imp_dbh->shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_s
sv->sv);
- }
+ }
#endif
return 1;
@@ -746,10 +746,10 @@
void
dbd_db_destroy(SV *dbh, imp_dbh_t *imp_dbh)
{
- dTHX ;
+ dTHX ;
int refcnt = 1 ;
sword status;
-
+
#if defined(USE_ITHREADS
) && defined(PERL_MAGIC_s
hared_scalar)
if (DBIc_IMPSET(imp_dbh
) && imp_dbh->shared_dbh) {
SvLOCK (imp_dbh->shared_dbh_priv_sv) ;
@@ -941,7 +941,7 @@
/* only here for : or ? outside of a comment or literal */
- start = dest; /* save name inc colon */
+ start = dest; /* save name inc colon */
*dest++ = *src++;
if (*start == '?') { /* X/Open standard */
sprintf(start,":p%d", ++idx); /* '?' -> ':p1' (etc) */
@@ -1036,7 +1036,7 @@
-static int
+static int
dbd_rebind_ph_char(S
V *sth, imp_sth_t *imp_sth, phs_t *phs, ub2 **alen_ptr_p
tr)
{
STRLEN value_len;
@@ -1055,7 +1055,7 @@
if (DBIS->debug >= 2) {
char *val = neatsvpv(phs->sv,0);
PerlIO_printf(DBILOG
FP, " bind %s <== %.1000s (", phs->name, val);
- if (!SvOK(phs->sv))
+ if (!SvOK(phs->sv))
PerlIO_printf(DBILOG
FP, "NULL, ");
PerlIO_printf(DBILOG
FP, "size %ld/%ld/%ld, ",
(long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen);
@@ -1125,8 +1125,8 @@
* This allows passing cursor refs as "in" to pl/sql (but only if you got the
* cursor from pl/sql to begin with)
*/
-int
- pp_rebind_ph_rset_in
(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
+int
+pp_rebind_ph_rset_i
n(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
/*dTHR; -- do we need to do this??? */
SV * sth_csr = phs->sv;
@@ -1158,7 +1158,7 @@
int
-pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
+pp_exec_rset(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
{
if (pre_exec) { /* pre-execute - allocate a statement handle */
dSP;
@@ -1248,7 +1248,7 @@
}
-static int
+static int
dbd_rebind_ph(SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
ub2 *alen_ptr = NULL;
@@ -1332,10 +1332,10 @@
if (csform) {
/* set OCI_ATTR_CHARSET_FOR
M before we get the default OCI_ATTR_CHARSET_ID *
/
- OCIAttrSet_log_stat
(phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ OCIAttrSet_log_sta
t(phs->bndhp, (ub4) OCI_HTYPE_BIND,
&csform, (ub4) 0, (ub4) OCI_ATTR_CHARSET_FOR
M, imp_sth->errhp, status);
if ( status != OCI_SUCCESS ) {
- oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_st
h,"OCIAttrS
et (OCI_ATTR_CHARSET_FO
RM)"));
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_st
h,"OCIAttrS
et (OCI_ATTR_CHARSET_FO
RM)"));
return 0;
}
}
@@ -1364,10 +1364,10 @@
if (csid) {
- OCIAttrSet_log_stat
(phs->bndhp, (ub4) OCI_HTYPE_BIND,
+ OCIAttrSet_log_sta
t(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_st
h,"OCIAttrS
et (OCI_ATTR_CHARSET_ID
)"));
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_st
h,"OCIAttrS
et (OCI_ATTR_CHARSET_ID
)"));
return 0;
}
}
@@ -1376,7 +1376,7 @@
OCIAttrSet_log_stat(
phs->bndhp, (ub4)OCI_HTYPE_BIND,
neatsvpv(phs->sv,0), (ub4)phs->maxdata_size, (ub4)OCI_ATTR_MAXDAT
A_SIZE, imp
_sth->errhp, status);
if ( status != OCI_SUCCESS ) {
- oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_st
h,"OCIAttrS
et (OCI_ATTR_MAXDATA_SI
ZE)"));
+ oci_error(sth, imp_sth->errhp, status, ora_sql_error(imp_st
h,"OCIAttrS
et (OCI_ATTR_MAXDATA_SI
ZE)"));
return 0;
}
}
@@ -1417,6 +1417,7 @@
if (SvROK(newvalue)
&& !IS_DBI_HANDLE(newva
lue) /* dbi handle allowed for cursor variables */
&& !SvAMAGIC(newvalue)
/* overload magic allowed (untested) */
+ && !sv_derived_from(new
value, "OCILobLocatorPtr" ) /* input LOB locato
r*/
)
croak("Can't bind a reference (%s)", neatsvpv(newvalue,0)
);
if (SvTYPE(newvalue) > SVt_PVLV) /* hook for later array logic? */
@@ -1729,7 +1730,7 @@
AV *av = (AV*)SvRV(sv);
I32 avlen = AvFILL(av);
if (avlen >= 0)
- dbd_phs_avsv_complet
e(phs, avlen, debug);
+ dbd_phs_avsv_complet
e(phs, avlen, debug);
}
else
dbd_phs_sv_complete(
phs, sv, debug);
@@ -1755,7 +1756,7 @@
#ifdef UTF8_SUPPORT
if (ftype == 112 && CS_IS_UTF8(ncharseti
d) ) {
- return ora_blob_read_mb_pie
ce(sth, imp_sth, fbh, bufsv,
+ return ora_blob_read_mb_pie
ce(sth, imp_sth, fbh, bufsv,
offset, len, destoffset);
}
#endif /* UTF8_SUPPORT */
@@ -1856,6 +1857,7 @@
{
if (phs->desc_h)
OCIDescriptorFree_lo
g(phs->desc_h, phs->desc_t);
+
sv_free(phs->ora_field);
sv_free(phs->sv);
}
@@ -1941,8 +1943,14 @@
hv_iterinit(hv);
while( (sv = hv_iternextsv(hv, &key, &retlen)) != NULL ) {
if (sv != &sv_undef) {
- phs_t *phs = (phs_t*)(void*)SvPVX
(sv);
- ora_free_phs_conte
nts(phs);
+ phs_t *phs = (phs_t*)(void*)SvPVX
(sv);
+
+
+ if (phs->desc_h && phs->desc_t == OCI_DTYPE_LOB)
+ ora_free_templob(sth
, imp_sth, (OCILobLocator*)phs->desc_h);
+
+
+ ora_free_phs_content
s(phs);
}
}
sv_free((SV*)imp_sth
->all_params_hv);
@@ -1986,7 +1994,7 @@
/* int oraperl = DBIc_COMPAT(imp_sth)
; */
if (kl==13 && strEQ(key, "NUM_OF_PARAMS")) /* handled by DBI */
- return Nullsv;
+ return Nullsv;
if (!imp_sth->done_desc && !dbd_describe(sth, imp_sth)) {
STRLEN lna;
Modified: dbd-oracle/trunk/oci8.c
====================
====================
====================
================
==
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Tue Mar 28 08:47:33 2006
@@ -328,7 +328,7 @@
/* [I'm not now sure why this is here - from a patch sometime ago - Tim]
*/
ub4 cache_mem;
IV cache_mem_iv;
- D_imp_dbh_from_sth ;
+ D_imp_dbh_from_sth ;
D_imp_drh_from_dbh ;
if (SvOK(imp_drh->ora_cache_o)) cache_mem_iv = -SvIV(imp_drh -> ora_cac
he_o);
@@ -389,37 +389,37 @@
Binding RETURNING...INTO variables
As mentioned in the previous section, an OCI application implements the plac
eholders in the RETURNING clause as
-pure OUT bind variables. An application must adhere to the following rules
when working with these bind variables:
+pure OUT bind variables. An application must adhere to the following rules
when working with these bind variables:
1.Bind RETURNING clause placeholders in OCI_DATA_AT_EXEC mode using OCIBindB
yName() or
- OCIBindByPos(), followed by a call to OCIBindDynamic() for each placeho
lder.
+ OCIBindByPos(), followed by a call to OCIBindDynamic() for each placeho
lder.
Note: The OCI only supports the callback mechanism for RETURNING clause bind
s. The polling mechanism is
- not supported.
+ not supported.
2.When binding RETURNING clause placeholders, you must supply a valid out bi
nd function as the ocbfp
- parameter of the OCIBindDynamic() call. This function must provide stor
age to hold the returned data.
+ parameter of the OCIBindDynamic() call. This function must provide stor
age to hold the returned data.
3.The icbfp parameter of OCIBindDynamic() call should provide a "dummy" func
tion which returns NULL values
- when called.
- 4.The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE.
+ when called.
+ 4.The piecep parameter of OCIBindDynamic() must be set to OCI_ONE_PIECE.
5.No duplicate binds are allowed in a DML statement with a RETURNING clause
(i.e., no duplication between bind
- variables in the DML section and the RETURNING section of the statement
).
+ variables in the DML section and the RETURNING section of the statement
).
When a callback function is called, the OCI_ATTR_ROWS_RETURN
ED attribute of
the bind handle tells the
application the number of rows being returned in that particular iteration.
Thus, when the callback is called the first
time in a particular iteration (i.e., index=0), the user can allocate space
for all the rows which will be returned for that
bind variable. When the callback is called subsequently (with index>0) withi
n the same iteration, the user can merely
-increment the buffer pointer to the correct memory within the allocated spa
ce to retrieve the data.
+increment the buffer pointer to the correct memory within the allocated spa
ce to retrieve the data.
Every bind handle has a OCI_ATTR_MAXDATA_SIZ
E attribute. This attribute spec
ifies the number of bytes to be
-allocated on the server to accommodate the client-side bind data after any
necessary character set conversions.
+allocated on the server to accommodate the client-side bind data after any
necessary character set conversions.
Note: Character set conversions performed when data is sent to the server ma
y result in the data expanding or
- contracting, so its size on the client may not be the same as its size
on the server.
+ contracting, so its size on the client may not be the same as its size
on the server.
An application will typically set OCI_ATTR_MAXDATA_SIZ
E to the maximum size
of the column or the size of the
PL/SQL variable, depending on how it is used. Oracle issues an error if OCI_
ATTR_MAXDATA_SIZE is not a large
-enough value to accommodate the data after conversion, and the operation wi
ll fail.
+enough value to accommodate the data after conversion, and the operation wi
ll fail.
*/
sb4
@@ -508,7 +508,7 @@
fetch_func_varfield(
SV *sth, imp_fbh_t *fbh, SV *dest_sv)
{
D_imp_sth(sth);
- D_imp_dbh_from_sth ;
+ D_imp_dbh_from_sth ;
D_imp_drh_from_dbh ;
fb_ary_t *fb_ary = fbh->fb_ary;
char *p = (char*)&fb_ary->abuf[0];
@@ -522,7 +522,7 @@
if (bytelen < datalen) { /* will be truncated */
int oraperl = DBIc_COMPAT(imp_sth)
;
- if (DBIc_has(imp_sth,DB
Icf_LongTruncOk)
+ if (DBIc_has(imp_sth,DB
Icf_LongTruncOk)
|| (oraperl && SvIV(imp_drh->ora_trunc))) {
/* user says truncation is ok */
/* Oraperl recorded the truncation in ora_errno so we */
@@ -538,7 +538,7 @@
return 0;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3)
PerlIO_printf(DBILOG
FP, " fetching field %d of %d. LONG value truncate
d from %lu to %lu.\n",
fbh->field_num+1, DBIc_NUM_FIELDS(imp_
sth),
ul_t(datalen), ul_t(bytelen));
@@ -659,8 +659,8 @@
/* ------ */
-int
- dbd_rebind_ph_rset(S
V *sth, imp_sth_t *imp_sth, phs_t *phs)
+int
+dbd_rebind_ph_rset(
SV *sth, imp_sth_t *imp_sth, phs_t *phs)
{
/* Only do this part for inout cursor refs because pp_exec_rset only gets ca
lled for all the output params */
if (phs->is_inout) {
@@ -675,19 +675,30 @@
/* ------ */
+static int
+fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV
*dest_sv, char *name);
static int
lob_phs_post_execute
(SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)
{
if (pre_exec)
return 1;
+ /* fetch PL/SQL LOB data */
+ if (imp_sth->auto_lob && (
+ imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT
_DECLARE )) {
+
+ return fetch_lob(sth, imp_sth, (OCILobLocator*) phs->desc_h, phs->ftyp
e, phs->sv, phs->name);
+ }
+
sv_setref_pv(phs->sv, "OCILobLocatorPtr", (void*)phs->desc_h);
+
return 1;
}
-int
- dbd_rebind_ph_lob(SV
*sth, imp_sth_t *imp_sth, phs_t *phs)
+int
+dbd_rebind_ph_lob(S
V *sth, imp_sth_t *imp_sth, phs_t *phs)
{
+ D_imp_dbh_from_sth
;
sword status;
ub4 lobEmpty = 0;
@@ -716,6 +727,79 @@
phs->maxlen = sizeof(OCILobLocator
*);
if (phs->is_inout)
phs->out_prepost_exec = lob_phs_post_execute
;
+ /* accept input LOBs */
+
+ if (sv_derived_from(phs
->sv, "OCILobLocatorPtr")) {
+ OCILobLocator *src;
+ OCILobLocator **dest;
+ src = INT2PTR(OCILobLocato
r *, SvIV(SvRV(phs->sv)));
+ dest = (OCILobLocator **) phs->progv;
+
+ OCILobLocatorAssign_
log_stat(imp_dbh->svchp, imp_sth->errhp, src, de
st, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, "OCILobLocatorAssign");
+ return 0;
+ }
+ }
+
+#if !defined(ORA_OCI_8)
+ /* create temporary LOB for PL/SQL placeholder */
+
+ else if (imp_sth->auto_lob && (imp_sth->stmt_type == OCI_STMT_BEGIN ||
+ imp_sth->stmt_type == OCI_STMT_DECLARE)) {
+ ub4 amtp;
+
+ SvUPGRADE(phs->sv, SVt_PV); /* just in case */
+ 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
);
+
+ OCILobCreateTemporar
y_log_stat(imp_dbh->svchp, imp_sth->errhp,
+ (OCILobLocator *) phs->desc_h, (ub2) OCI_DEFAULT,
+ (ub1) OCI_DEFAULT, lobtype, TRUE, OCI_DURATION_SESSION
, stat
us);
+
+ if (status != OCI_SUCCESS) {
+ oci_error(sth, imp_sth->errhp, status, " OCILobCreateTemporar
y");
+ return 0;
+ }
+
+ if( ! phs->csid ) {
+ ub1 csform = SQLCS_IMPLICIT;
+ ub2 csid = 0;
+ OCILobCharSetForm_lo
g_stat( imp_sth->envhp, imp_sth->errhp,
(OCILobLocator*)phs->desc_h, &csform, status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, imp_sth->errhp, status, "OCILobCha
rSetForm");
+#ifdef OCI_ATTR_CHARSET_ID
+ /* Effectively only used so AL32UTF8 works properly */
+ OCILobCharSetId_log_
stat( imp_sth->envhp, imp_sth->errhp, (O
CILobLocator*)phs->desc_h, &csid, status );
+ if (status != OCI_SUCCESS)
+ return oci_error(sth, imp_sth->errhp, status, "OCILobCha
rSetId");
+#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
);
+ phs->csid = csid;
+ phs->csform = csform;
+ }
+
+ if (DBIS->debug >= 3)
+ PerlIO_printf(DBILOG
FP, " calling OCILobWrite phs->csi
d=%d phs->csform=%d amtp=%d\n",
+ phs->csid, phs->csform, amtp );
+
+ /* write lob data */
+
+ OCILobWrite_log_stat
(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 i
n dbd_rebind_ph_lob");
+ }
+ }
+ }
+#endif
return 1;
}
@@ -723,7 +807,7 @@
#ifdef UTF8_SUPPORT
ub4
- ora_blob_read_mb_pie
ce(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh,
+ora_blob_read_mb_pi
ece(SV *sth, imp_sth_t *imp_sth, imp_fbh_t *fbh,
SV *dest_sv, long offset, UV len, long destoffset)
{
ub4 loblen = 0;
@@ -756,7 +840,7 @@
return 0;
}
- OCILobGetLength_log_
stat(imp_sth->svchp, imp_sth->errhp,
+ OCILobGetLength_log_
stat(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_pie
ce");
@@ -768,9 +852,9 @@
amtp = (loblen > len) ? len : loblen;
buflen = 4 * amtp;
- byte_destoffset = ora_utf8_to_bytes((u
b1 *)(SvPVX(dest_sv)),
+ byte_destoffset = ora_utf8_to_bytes((u
b1 *)(SvPVX(dest_sv)),
(ub4)destoffset, SvCUR(dest_sv));
-
+
if (loblen > 0) {
ub1 *dest_bufp;
ub1 *buffer;
@@ -813,7 +897,7 @@
if (dbis->debug >= 3)
PerlIO_printf(DBILOG
FP, " blob_read field %d, ftype %d, offset %ld, len %
ld, destoffset %ld, retlen %lu\n",
fbh->field_num+1, ftype, offset, len, destoffset, ul_t(amtp));
-
+
SvCUR_set(dest_sv, byte_destoffset+amtp
);
*SvEND(dest_sv) = '\0'; /* consistent with perl sv_setpvn etc */
SvPOK_on(dest_sv);
@@ -951,30 +1035,31 @@
static int
- fetch_func_autolob(S
V *sth, imp_fbh_t *fbh, SV *dest_sv)
+fetch_lob(SV *sth, imp_sth_t *imp_sth, OCILobLocator* lobloc, int ftype, SV
*dest_sv, char *name)
{
ub4 loblen = 0;
ub4 buflen;
ub4 amtp = 0;
int loblen_is_chars;
- imp_sth_t *imp_sth = fbh->imp_sth;
- OCILobLocator *lobloc = (OCILobLocator*)fbh->desc_h;
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 */
OCILobGetLength_log_
stat(imp_sth->svchp, imp_sth->errhp, lobloc, &loblen, st
atus);
if (status != OCI_SUCCESS) {
- oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_func_autolob
");
- return 0;
+ oci_error(sth, imp_sth->errhp, status, "OCILobGetLength fetch_lob");
+ return 0;
}
- loblen_is_chars = (fbh->ftype == 112);
+ loblen_is_chars = (ftype == 112);
if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */
int oraperl = DBIc_COMPAT(imp_sth)
;
- D_imp_dbh_from_sth ;
+ D_imp_dbh_from_sth
;
D_imp_drh_from_dbh ;
/* move setting amtp up to ensure error message OK */
@@ -987,8 +1072,8 @@
}
else {
char buf[300];
- sprintf(buf,"fetching field %d of %d. LOB value truncated from %ld to
%ld. %s",
- fbh->field_num+1, DBIc_NUM_FIELDS(imp_
sth), ul_t(loblen), ul_t(amtp),
+ sprintf(buf,"fetching %s. LOB value truncated from %ld to %ld. %s",
+ name, ul_t(loblen), ul_t(amtp),
"DBI attribute LongReadLen too small and/or LongTruncOk not set");
oci_error_err(sth, NULL, OCI_ERROR, buf, 24345); /* appropriate ORA error nu
mber */
sv_set_undef(dest_sv
);
@@ -1028,7 +1113,7 @@
return 0;
}
- if (fbh->dbtype == 114) {
+ if (ftype == 114) {
OCILobFileOpen_log_s
tat(imp_sth->svchp, imp_sth->errhp, lobloc,
(ub1)OCI_FILE_READON
LY, status);
if (status != OCI_SUCCESS) {
@@ -1043,11 +1128,11 @@
0, 0, (ub2)0, csform, status);
if (DBIS->debug >= 3)
PerlIO_printf(DBILOG
FP,
- " OCILobRead field %d %s: csform %d, LOBlen %luc, LongReadLen %luc
, BufLen %lub, Got %luc\n",
- fbh->field_num+1, oci_status_name(stat
us), csform, ul_t(loblen),
- ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
+ " OCILobRead %s %s: csform %d, LOBlen %luc, LongReadLen %luc, BufL
en %lub, Got %luc\n",
+ name, oci_status_name(stat
us), csform, ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
- if (fbh->dbtype == 114) {
+ if (ftype == 114) {
OCILobFileClose_log_
stat(imp_sth->svchp, imp_sth->errhp,
lobloc, status);
}
@@ -1056,12 +1141,12 @@
sv_set_undef(dest_sv
);
return 0;
}
-
+
/* tell perl what we've put in its dest_sv */
SvCUR(dest_sv) = amtp;
*SvEND(dest_sv) = '\0';
- if (fbh->ftype == 112 && CSFORM_IMPLIES_UTF8(
csform)) /* Don't set UTF8 on
BLOBs */
- SvUTF8_on(dest_sv);
+ if (ftype == 112 && CSFORM_IMPLIES_UTF8(
csform)) /* Don't set UTF8 on BLOB
s */
+ SvUTF8_on(dest_sv);
ora_free_templob(sth
, imp_sth, lobloc);
}
else { /* LOB length is 0 */
@@ -1071,9 +1156,9 @@
*SvEND(dest_sv) = '\0';
if (DBIS->debug >= 3)
PerlIO_printf(DBILOG
FP,
- " OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu, BufLen %lu,
Got %lu\n",
- fbh->field_num+1, "SKIPPED", ul_t(loblen),
- ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
+ " OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, BufLen %lu, Got %
lu\n",
+ name, "SKIPPED", ul_t(loblen),
+ ul_t(imp_sth->long_readlen), ul_t(buflen), ul_t(amtp));
}
SvPOK_on(dest_sv);
@@ -1081,6 +1166,15 @@
return 1;
}
+static int
+fetch_func_autolob(
SV *sth, imp_fbh_t *fbh, SV *dest_sv)
+{
+ char name[64];
+ sprintf(name, "field %d of %d", fbh->field_num, DBIc_NUM_FIELDS(fbh->im
p_sth));
+
+ return fetch_lob(sth, fbh->imp_sth, (OCILobLocator*)fbh->desc_h, fbh->f
type, dest_sv, name);
+}
+
static int
fetch_func_getrefpv(
SV *sth, imp_fbh_t *fbh, SV *dest_sv)
@@ -1224,6 +1318,9 @@
long_readlen = (SvOK(imp_drh -> ora_long) && SvUV(imp_drh->ora_long)>0)
? SvUV(imp_drh->ora_long) : DBIc_LongReadLen(imp
_sth);
+ /* set long_readlen for SELECT or PL/SQL with output placeholders */
+ imp_sth->long_readlen = long_readlen;
+
if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see num_f
ields test below */
if (DBIS->debug >= 3)
PerlIO_printf(DBILOG
FP, " dbd_describe skipped for %s\n",
@@ -1444,7 +1541,6 @@
(int)num_fields, has_longs
);
- imp_sth->long_readlen = long_readlen;
/* Initialise cache counters */
imp_sth->in_cache = 0;
imp_sth->eod_errno = 0;
@@ -1483,7 +1579,7 @@
/* csform may be 0 when talking to Oracle 8.0 database */
if (DBIS->debug >= 3)
PerlIO_printf(DBILOG
FP, " calling OCIAttrSet OCI_ATTR_CHARSET_FOR
M with c
sform=%d\n", fbh->csform );
- OCIAttrSet_log_stat(
fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid
*) &fbh->csform,
+ OCIAttrSet_log_stat(
fbh->defnp, (ub4) OCI_HTYPE_DEFINE, (dvoid
*) &fbh->csform,
(ub4) 0, (ub4) OCI_ATTR_CHARSET_FOR
M, imp_sth->errhp, status );
if (status != OCI_SUCCESS) {
oci_error(h, imp_sth->errhp, status, "OCIAttrSet OCI_ATTR_CHARSET_FOR
M");
@@ -1582,7 +1678,7 @@
&& ora_dbtype_is_long(f
bh->dbtype)/* field is a LONG */
) {
int oraperl = DBIc_COMPAT(imp_sth)
;
- D_imp_dbh_from_sth ;
+ D_imp_dbh_from_sth ;
D_imp_drh_from_dbh ;
if (DBIc_has(imp_sth,DB
Icf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_t
runc))) {
@@ -1855,7 +1951,7 @@
OCIHandleFree_log_st
at(dschp, OCI_HTYPE_DESCRIBE, status);
return oci_error(sth, errhp, status, " OCIDescribeAny(view)
/LOB refetch");
}
- }
+ }
OCIAttrGet_log_stat(
dschp, OCI_HTYPE_DESCRIBE,
&parmhp, 0, OCI_ATTR_PARAM, errhp, status);
@@ -2086,7 +2182,12 @@
SV *dbh = (SV*)DBIc_MY_H(imp_d
bh);
if (!imp_sth->auto_lob)
- return 1; /* application doesn't want magical lob handling */
+ return 1; /* application doesn't want magical lob handling */
+
+
+ if (imp_sth->stmt_type == OCI_STMT_BEGIN || imp_sth->stmt_type == OCI_STMT
_DECLARE)
+ return 1; /* PL/SQL is handled by lob_phs_post_execute
*/
+
if (row_count == 0)
return 1; /* nothing to do */
if (row_count > 1)
Modified: dbd-oracle/trunk/ocitrace.h
====================
====================
====================
================
==
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Tue Mar 28 08:47:33 2006
@@ -199,6 +199,22 @@
" %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*/
+
+#if !defined(ORA_OCI_8)
+#define OCILobCreateTemporar
y_log_stat(sv,eh,lh,
csi,csf,lt,ca,dur,st
at) \
+ stat=OCILobCreateT
emporary(sv,eh,lh,cs
i,csf,lt,ca,dur);
\
+ (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OC
I_TRACEFP, \
+ " %sLobCreateTemporary
(%p,%p,%p,%lu,%lu,%l
u,%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
+#else
+#define OCILobCreateTemporar
y_log_stat(sv,eh,lh,
stat) \
+ stat=0 /* Actually, this should be a compile error */
+#endif
+
+/*end add*/
#if !defined(ORA_OCI_8)
#define OCILobFreeTemporary_
log_stat(sv,eh,lh,st
at) \
@@ -223,6 +239,16 @@
#define OCILobIsTemporary_lo
g_stat(ev,eh,lh,iste
mp,stat) \
stat=0
#endif
+/*Added by JPS for Jeffrey.Klein */
+
+#define OCILobLocatorAssign_
log_stat(sv,eh,src,d
est,stat) \
+ stat=OCILobLocatorAs
sign(sv,eh,src,dest)
; \
+ (DBD_OCI_TRACEON) ? PerlIO_printf(DBD_OC
I_TRACEFP, \
+ " %sLobLocatorAssign(%
p,%p,%p,%p)=%s\n", \
+ OciTp,(void*)sv,(voi
d*)eh,(void*)src,(vo
id*)dest, \
+ oci_status_name(stat
)),stat : stat
+
+/*end add*/
#define OCILobRead_log_stat(
sv,eh,lh,am,of,bp,bl
,cx,cb,csi,csf,stat)
\
stat=OCILobRead(sv,e
h,lh,am,of,bp,bl,cx,
cb,csi,csf); \
Modified: dbd-oracle/trunk/t/31lob.t
====================
====================
====================
================
==
--- dbd-oracle/trunk/t/31lob.t (original)
+++ dbd-oracle/trunk/t/31lob.t Tue Mar 28 08:47:33 2006
@@ -1,7 +1,7 @@
#!/usr/bin/perl
use strict;
-use Test::More tests => 2;
+use Test::More tests => 9;
use DBD::Oracle qw(:ora_types);
use DBI;
@@ -47,6 +47,126 @@
$sth->execute;
is (ref $loc, "OCILobLocatorPtr", "returned valid locator");
+sub temp_lob_count {
+ my $dbh = shift;
+ my $stmt = "
+ SELECT cache_lobs + nocache_lobs AS temp_lob_count
+ FROM v\$temporary_lobs templob,
+ v\$session sess
+ WHERE sess.sid = templob.sid
+ AND sess.audsid = userenv('sessionid')
";
+ my ($count) = $dbh-> selectrow_array($stm
t);
+ return $count;
+}
+
+## test writing / reading large data
+{
+ # LOB locators cannot span transactions - turn off AutoCommit
+ local $dbh->{AutoCommit} = 0;
+ my ( $large_value, $len );
+
+ # get a new locator
+ $stmt = "INSERT INTO $table (id,data) VALUES (3, EMPTY_BLOB())";
+ $dbh->do($stmt);
+ $stmt = "SELECT data FROM $table WHERE id = ?";
+ $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } );
+ $id = 3;
+ $sth->bind_param( 1, $id );
+ $sth->execute;
+ ($loc) = $sth->fetchrow;
+
+ is( ref $loc, "OCILobLocatorPtr", "returned valid locator" );
+
+ # write string > 32k
+ $large_value = 'ABCD' x 10_000;
+
+ $dbh->ora_lob_write( $loc, 1, $large_value );
+ is( $dbh-> ora_lob_length($loc)
, length($large_value)
, "returned length"
);
+ is( $dbh->ora_lob_read( $loc, 1, length($large_value)
),
+ $large_value, "returned written value" );
+
+ ## PL/SQL TESTS
+ SKIP: {
+ ## test calling PL/SQL with LOB placeholder
+ my $plsql_testcount = 4;
+
+ $stmt = "BEGIN ? := DBMS_LOB.GETLENGTH( ? ); END;";
+ $sth = $dbh->prepare( $stmt, { ora_auto_lob => 0 } );
+ $sth->bind_param_inout( 1, \$len, 16 );
+ $sth->bind_param( 2, $loc, { ora_type => ORA_BLOB } );
+ $sth->execute;
+
+ # ORA-00600: internal error code
+ # ORA-00900: invalid SQL statement
+ # ORA-06550: PLS-00201: identifier 'DBMS_LOB.GETLENGTH' must be dec
lared
+ # ORA-06553: PLS-00213: package STANDARD not accessible
+
+ if ( $dbh->err && grep { $dbh->err == $_ } ( 600, 900, 6550, 6
553 ) ) {
+ skip "Your Oracle server doesn't support PL/SQL", $plsql_testco
unt
+ if $dbh->err == 900;
+ skip
+ "Your Oracle PL/SQL package DBMS_LOB is not properly installe
d", $plsql_testcount
+ if $dbh->err == 6550;
+ skip "Your Oracle PL/SQL is not properly installed", $plsql_tes
tcount
+ if $dbh->err == 6553 || $dbh->err == 600;
+ }
+
+ is( $len, length($large_value)
, "returned length via PL/SQL" );
+
+
+
+ $stmt = "
+ DECLARE
+ -- testing IN, OUT, and IN OUT:
+ -- p_out will be set to LOWER(p_in)
+ -- p_inout will be set to p_inout || p_in
+
+ PROCEDURE lower_lob(p_in BLOB, p_out OUT BLOB, p_inout IN OUT BLOB) IS
+ pos INT;
+ buffer RAW(1024);
+ BEGIN
+ DBMS_LOB. CREATETEMPORARY(p_ou
t, TRUE);
+ pos := 1;
+ WHILE pos <= DBMS_LOB.GETLENGTH(p_in)
+ LOOP
+ buffer := DBMS_LOB.SUBSTR(p_in, 1024, pos);
+
+ DBMS_LOB.WRITEAPPEND(p_out, UTL_RAW.LENGTH(buffer),
+ UTL_RAW. CAST_TO_RAW(LOWER(UT
L_RAW. CAST_TO_VARCHAR2(buf
fer))));
+
+ DBMS_LOB. WRITEAPPEND(p_inout,
UTL_RAW.LENGTH(buffer), buffer);
+
+ pos := pos + 1024;
+ END LOOP;
+ END;
+ BEGIN
+ lower_lob(:in, :out, :inout);
+ END; ";
+
+ my $out;
+ my $inout = lc $large_value;
+
+ local $dbh->{LongReadLen} = length($large_value)
* 2;
+
+ $sth = $dbh->prepare( $stmt, { ora_auto_lob => 1 } );
+ $sth->bind_param( ':in', $large_value, { ora_type => ORA_BLOB
});
+ $sth->bind_param_inout( ':out', \$out, 100, { ora_type => ORA_
BLOB } );
+ $sth->bind_param_inout( ':inout', \$inout, 100, { ora_type =>
ORA_BLOB } );
+ $sth->execute;
+
+ skip "Your Oracle PL/SQL installation does not implement temporary
LOBS", 3
+ if $dbh->err && $dbh->err == 6550;
+
+ is($out, lc($large_value), "returned LOB as string");
+ is($inout, lc($large_value).$large_value, "returned IN/OUT LOB as s
tring");
+
+ undef $sth;
+ # lobs are freed with statement handle
+
+ is(temp_lob_count($d
bh), 0, "no temp lobs left");
+ }
+}
+
$dbh->do("DROP TABLE $table");
$dbh->disconnect;
Post Follow-up to this message
Sponsored Links
Show a Printable Version
Email This Page to Someone!
Receive updates to this thread
