Author: byterock
Date: Tue Jun 24 07:05:38 2008
New Revision: 11449
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
Log:
Added (finally) ora_verbose for DBD only tracking from John Scoles and thanks
to H.Merijn Brand
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Tue Jun 24 07:05:38 2008
@@ -1,4 +1,5 @@
=head1 Changes in DBD-Oracle 1.22(svn rev xxxx) 2008
+ Added (finally) ora_verbose for DBD only tracking from John Scoles and
thanks to H.Merijn Brand
Fix for rt.cpan.org Ticket #=32396 from John Scoles
Fix for memory leak that snuck into 1.21 from John Scoles
Fix for rt.cpan.org Ticket #=36069: Problem with synonym from John Scoles
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Tue Jun 24 07:05:38 2008
@@ -1436,6 +1436,26 @@
Note that this attribute also applies to C<execute_array>, since that
method is implemented using C<execute_for_fetch>.
+=item ora_verbose
+
+Use this value to enable DBD::Oracle only tracing. Works the same way as
DBI->trace(level), simply
+set the oar_verbose attribute on the connect() to the trace level you desire.
+
+For example:
+
+ my $dbh = DBI->connect($dsn, "", "", {ora_verbose=>6});
+
+Will set the DBD::Oracle trace level to 6, which is this level that will trace
most of the calls to OCI.
+
+
+=back
+
+. call will promote the level to DBD-Unify,
+showing both the DBI layer debugging messages as well as the DBD-Unify debug
messages.
+It is however also possible to trace only the DBD-Unify without the DBI->trace
()
+call by using the uni_verbose attribute on connect (). Currently, the
following
+levels are defined
+
=back
=head2 Prepare Attributes
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Tue Jun 24 07:05:38 2008
@@ -41,6 +41,7 @@
int ora_fetchtest; /* intrnal test only, not thread safe */
int is_extproc = 0;
+int dbd_verbose = 0; /* DBD only debugging*/
ub2 charsetid = 0;
ub2 ncharsetid = 0;
@@ -368,14 +369,14 @@
if (DBIc_has(imp_dbh, DBIcf_IMPSET)) {
/* dbi_imp_data from take_imp_data */
if (DBIc_has(imp_dbh, DBIcf_ACTIVE)) {
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >= 2)
PerlIO_printf(DBILOGFP, "dbd_db_login6 skip connect\n");
/* tell our parent we've adopted an active child */
++DBIc_ACTIVE_KIDS(DBIc_PARENT_COM(imp_dbh));
return 1;
}
/* not ACTIVE so connect not skipped */
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >= 2 )
PerlIO_printf(DBILOGFP,
"dbd_db_login6 IMPSET but not ACTIVE so connect not skipped\n");
}
@@ -411,7 +412,7 @@
shared_dbh -> refcnt++ ;
imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ;
imp_dbh -> shared_dbh = shared_dbh ;
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >= 2)
PerlIO_printf(DBILOGFP, " dbd_db_login: use shared Oracle
database handles.\n");
} else {
shared_dbh = NULL ;
@@ -425,7 +426,7 @@
imp_dbh->get_oci_handle = oci_db_handle;
- if (DBIS->debug >= 6 )
+ if (DBIS->debug >= 6 || dbd_verbose >= 6)
dump_env_to_trace();
if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_envhp", 9)) && SvOK(*svp)) {
@@ -674,7 +675,7 @@
* be distinct if NLS_LANG and NLS_NCHAR are both used.
* BTW: NLS_NCHAR is set as follows: NSL_LANG=AL32UTF8
*/
- if (DBIS->debug >= 3) {
+ if (DBIS->debug >= 3 || dbd_verbose >= 3) {
PerlIO_printf(DBILOGFP," charsetid=%d ncharsetid=%d "
"(csid: utf8=%d al32utf8=%d)\n",
charsetid, ncharsetid, utf8_csid, al32utf8_csid);
@@ -920,7 +921,10 @@
int on = SvTRUE(valuesv);
int cacheit = 1;
- if (kl==10 && strEQ(key, "AutoCommit")) {
+ if (kl==11 && strEQ(key, "ora_verbose")) {
+ dbd_verbose = SvIV (valuesv);
+ }
+ else if (kl==10 && strEQ(key, "AutoCommit")) {
DBIc_set(imp_dbh,DBIcf_AutoCommit, on);
}
else if (kl==12 && strEQ(key, "RowCacheSize")) {
@@ -968,7 +972,10 @@
/* AutoCommit FETCH via DBI */
- if (kl==10 && strEQ(key, "AutoCommit")) {
+ if (kl==11 && strEQ(key, "ora_verbose")) {
+ retsv = newSViv (dbd_verbose);
+ }
+ else if (kl==10 && strEQ(key, "AutoCommit")) {
retsv = boolSV(DBIc_has(imp_dbh,DBIcf_AutoCommit));
}
else if (kl==12 && strEQ(key, "RowCacheSize")) {
@@ -1029,13 +1036,13 @@
len = SvLEN(source);
bufp = SvPV(source, len);
- if (DBIS->debug >=3)
+ if (DBIS->debug >=3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " creating xml from string that is %d
long\n",len);
if(len > MAX_OCISTRING_LEN) {
src_type = OCI_XMLTYPE_CREATE_CLOB;
- if (DBIS->debug >=5)
+ if (DBIS->debug >=5 || dbd_verbose >=5)
PerlIO_printf(DBILOGFP, " use a temp lob locator for large xml \n");
OCIDescriptorAlloc_ok(imp_dbh->envhp, &src_ptr, OCI_DTYPE_LOB);
@@ -1060,7 +1067,7 @@
} else {
src_type = OCI_XMLTYPE_CREATE_OCISTRING;
- if (DBIS->debug >=5)
+ if (DBIS->debug >=5 || dbd_verbose >=5 )
PerlIO_printf(DBILOGFP, " use a OCIStringAssignText for small xml \n");
@@ -1223,7 +1230,7 @@
*dest = '\0';
if (imp_sth->all_params_hv) {
DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv);
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >=2 )
PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct
placeholders\n",
(int)DBIc_NUM_PARAMS(imp_sth));
}
@@ -1360,7 +1367,7 @@
}
arr=(AV*)(SvRV(phs->sv));
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d\n",
phs->array_numstruct);
}
@@ -1372,7 +1379,7 @@
int numarrayentries=av_len( arr );
if( numarrayentries >= 0 ){
phs->array_numstruct = numarrayentries+1;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
array_numstruct=%d (calculated) \n",
phs->array_numstruct);
}
@@ -1380,7 +1387,7 @@
}
/* Fix charset */
csform = phs->csform;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): original
csform=%d\n",
(int)csform);
}
@@ -1414,14 +1421,14 @@
if( length+1 > maxlen ){
maxlen=length+1;
}
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): length(array[%d])=%d\n",
i,(int)length);
}
}
if(SvUTF8(item) ){
flag_data_is_utf8=1;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=true\n", i);
}
if (csform != SQLCS_NCHAR) {
@@ -1431,14 +1438,14 @@
else if (CSFORM_IMPLIES_UTF8(SQLCS_IMPLICIT))
csform = SQLCS_IMPLICIT;
/* else leave csform == 0 */
- if (trace_level)
+ if (trace_level || dbd_verbose >= 1 )
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): rebinding %s with UTF8 value %s", phs->name,
(csform == SQLCS_NCHAR) ? "so setting
csform=SQLCS_IMPLICIT" :
(csform == SQLCS_IMPLICIT) ? "so setting
csform=SQLCS_NCHAR" :
"but neither CHAR nor NCHAR are unicode\n");
}
}else{
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): is_utf8(array[%d])=false\n", i);
}
}
@@ -1446,12 +1453,12 @@
}
if( phs->maxlen <=0 ){
phs->maxlen=maxlen;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
phs->maxlen calculated =%ld\n",
(long)maxlen);
}
} else{
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): phs->maxlen forsed =%ld\n",
(long)maxlen);
}
@@ -1482,7 +1489,7 @@
croak("Unable to bind %s - %d structures by %d bytes requires too much
memory.",
phs->name, need_allocate_rows, buflen );
}else{
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table():
ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n",
need_allocate_rows,buflen);
}
@@ -1515,7 +1522,7 @@
phs->array_buf[ phs->maxlen*i + itemlen ]=0;
phs->array_indicators[i]=0;
phs->array_lengths[i]=itemlen+1; /* Zero byte */
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
"Copying length=%d array[%d]='%s'.\n",
itemlen,i,str);
@@ -1523,7 +1530,7 @@
}else{
/* Mark NULL */
phs->array_indicators[i]=1;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_varchar2_table(): "
"Copying length=%d array[%d]=NULL (length==0 or
! str) .\n",
itemlen,i);
@@ -1532,7 +1539,7 @@
}else{
/* Mark NULL */
phs->array_indicators[i]=1;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): "
"Copying length=? array[%d]=NULL av_fetch
failed.\n", i);
}
@@ -1589,7 +1596,7 @@
if ( flag_data_is_utf8 && !CS_IS_UTF8(csid))
csid = utf8_csid; /* not al32utf8_csid here on purpose */
- if (trace_level >= 3)
+ if (trace_level >= 3 || dbd_verbose >= 3 )
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_varchar2_table(): bind %s <== %s
"
"(%s, %s, csid %d->%d->%d, ftype %d, csform %d->%d, maxlen %lu,
maxdata_size %lu)\n",
phs->name, neatsvpv(phs->sv,0),
@@ -1634,7 +1641,7 @@
croak("dbd_phs_ora_varchar2_table_fixup_after_execute(): bad bind
variable. ARRAY reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
}
- if (trace_level >= 1){
+ if (trace_level >= 1 || dbd_verbose >= 1){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%ld \n",
phs->name,
@@ -1673,7 +1680,7 @@
/* NULL */
if( item ){
SvSetMagicSV(item,&PL_sv_undef);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
SvSetMagicSV(item,&PL_sv_undef);\n",
i
@@ -1681,7 +1688,7 @@
}
}else{
av_store(arr,i,&PL_sv_undef);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = undef;
av_store(arr,i,&PL_sv_undef);\n",
i
@@ -1691,7 +1698,7 @@
}else{
if( (phs->array_indicators[i] == -2) ||
(phs->array_indicators[i] > 0) ){
/* Truncation occurred */
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): Placeholder '%s': data
truncated at %d row.\n",
phs->name,i);
@@ -1702,7 +1709,7 @@
if( item ){
sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]);
SvPOK_only_UTF8(item);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
"sv_setpvn_mg(item,phs->array_buf+phs->maxlen*i,phs->array_lengths[i]); \n",
@@ -1711,7 +1718,7 @@
}
}else{
av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute(): arr[%d] = '%s'; "
"av_store(arr,i,newSVpvn(phs->array_buf+phs->maxlen*i,phs->array_lengths[i]));
\n",
@@ -1722,7 +1729,7 @@
}
}
}
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_varchar2_table_fixup_after_execute():
scalar(@arr)=%ld.\n",
(long)av_len(arr)+1);
@@ -1757,7 +1764,7 @@
}
arr=(AV*)(SvRV(phs->sv));
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
array_numstruct=%d\n",
phs->array_numstruct);
}
@@ -1769,7 +1776,7 @@
int numarrayentries=av_len( arr );
if( numarrayentries >= 0 ){
phs->array_numstruct = numarrayentries+1;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n",
phs->array_numstruct);
}
@@ -1787,7 +1794,7 @@
default:
phs->maxlen=sizeof(double);
}
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
phs->maxlen calculated =%ld\n",
(long)phs->maxlen);
}
@@ -1800,12 +1807,12 @@
/* Zero means "use current array length". */
phs->ora_maxarray_numentries=phs->array_numstruct;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries assumed=phs->array_numstruct=%d\n",
phs->array_numstruct);
}
}else{
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_maxarray_numentries=%d\n",
phs->ora_maxarray_numentries);
}
@@ -1823,7 +1830,7 @@
croak("Unable to bind %s - %d structures by %d bytes requires too much
memory.",
phs->name, need_allocate_rows, buflen );
}else{
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table():
ora_realloc_phs_array(,need_allocate_rows=%d,buflen=%d) succeeded.\n",
need_allocate_rows,buflen);
}
@@ -1877,7 +1884,7 @@
}
}
phs->array_lengths[i]=sizeof(int);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): "
"(integer) array[%d]=%d%s\n",
i,
*(int*)(phs->array_buf+phs->maxlen*i),
@@ -1898,7 +1905,7 @@
/* as phs->array_buf=malloc(), proper alignment
is guaranteed */
*(double*)(phs->array_buf+phs->maxlen*i)=val;
phs->array_indicators[i]=0;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): "
"let (double) array[%d]=%lf - NOT
NULL\n",
i, val);
@@ -1908,7 +1915,7 @@
/* Defined NaN assumed =0 */
*(double*)(phs->array_buf+phs->maxlen*i)=0;
phs->array_indicators[i]=0;
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
STRLEN l;
char *p=SvPV(item,l);
@@ -1919,7 +1926,7 @@
}else{
/* NULL */
phs->array_indicators[i]=1;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): "
"let (double) array[%d] NULL\n",
i);
@@ -1927,7 +1934,7 @@
}
}
phs->array_lengths[i]=sizeof(double);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_rebind_ph_number_table(): "
"(double) array[%d]=%lf%s\n",
i,
*(double*)(phs->array_buf+phs->maxlen*i),
@@ -1939,7 +1946,7 @@
}else{
/* item not defined, mark NULL */
phs->array_indicators[i]=1;
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): "
"Copying length=? array[%d]=NULL av_fetch
failed.\n", i);
}
@@ -1998,7 +2005,7 @@
croak("dbd_phs_ora_number_table_fixup_after_execute(): bad bind
variable. ARRAY reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
}
- if (trace_level >= 1){
+ if (trace_level >= 1 || dbd_verbose >= 1 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): Called for
'%s' : array_numstruct=%d, maxlen=%ld \n",
phs->name,
@@ -2044,7 +2051,7 @@
/* NULL */
if( item ){
SvSetMagicSV(item,&PL_sv_undef);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): arr[%d] = undef;
SvSetMagicSV(item,&PL_sv_undef);\n",
i
@@ -2052,7 +2059,7 @@
}
}else{
av_store(arr,i,&PL_sv_undef);
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): arr[%d] = undef;
av_store(arr,i,&PL_sv_undef);\n",
i
@@ -2062,7 +2069,7 @@
}else{
if( (phs->array_indicators[i] == -2) ||
(phs->array_indicators[i] > 0) ){
/* Truncation occurred */
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): Placeholder '%s': data
truncated at %d row.\n",
phs->name,i);
@@ -2073,7 +2080,7 @@
if( item ){
switch(phs->ora_internal_type){
case SQLT_INT:
- if (trace_level >= 4){
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): (int) set arr[%d] = %d \n",
i, *(int*)(phs->array_buf+phs->maxlen*i)
@@ -2082,7 +2089,7 @@
sv_setiv_mg(item,*(int*)(phs->array_buf+phs->maxlen*i));
break;
case SQLT_FLT:
- if (trace_level >= 4){
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): (double) set arr[%d] = %lf \n",
i,
*(double*)(phs->array_buf+phs->maxlen*i)
@@ -2090,7 +2097,7 @@
}
sv_setnv_mg(item,*(double*)(phs->array_buf+phs->maxlen*i));
}
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
STRLEN l;
char *str= SvPOK(item) ? SvPV(item,l) : "<unprintable>"
;
PerlIO_printf(DBILOGFP,
@@ -2101,7 +2108,7 @@
}else{
switch(phs->ora_internal_type){
case SQLT_INT:
- if (trace_level >= 4){
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): (int) store new arr[%d] = %d
\n",
i, *(int*)(phs->array_buf+phs->maxlen*i)
@@ -2110,7 +2117,7 @@
av_store(arr,i,newSViv(
*(int*)(phs->array_buf+phs->maxlen*i) ));
break;
case SQLT_FLT:
- if (trace_level >= 4){
+ if (trace_level >= 4 || dbd_verbose >= 4 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute(): (double) store new arr[%d] =
%lf \n",
i,
*(double*)(phs->array_buf+phs->maxlen*i)
@@ -2118,7 +2125,7 @@
}
av_store(arr,i,newSVnv(
*(double*)(phs->array_buf+phs->maxlen*i) ));
}
- if (trace_level >= 3){
+ if (trace_level >= 3 || dbd_verbose >= 3 ){
STRLEN l;
char *str;
SV**pitem=av_fetch(arr,i,0);
@@ -2135,7 +2142,7 @@
}
}
}
- if (trace_level >= 2){
+ if (trace_level >= 2 || dbd_verbose >= 2 ){
PerlIO_printf(DBILOGFP,
"dbd_phs_ora_number_table_fixup_after_execute():
scalar(@arr)=%ld.\n",
(long)av_len(arr)+1);
@@ -2164,7 +2171,7 @@
}
- if (DBIS->debug >= 2) {
+ if (DBIS->debug >= 2 || dbd_verbose >=2 ) {
char *val = neatsvpv(phs->sv,0);
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (1): bind %s <==
%.1000s (", phs->name, val);
if (!SvOK(phs->sv))
@@ -2231,7 +2238,7 @@
phs->alen = value_len + phs->alen_incnull;
- if (DBIS->debug >= 3) {
+ if (DBIS->debug >= 3 || dbd_verbose >=3) {
UV neatsvpvlen = (UV)DBIc_DBISTATE(imp_sth)->neatsvpvlen;
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_char() (2): bind %s <==
'%.*s' (size %ld/%ld, otype %d, indp %d, at_exec %d)\n",
phs->name,
@@ -2258,7 +2265,7 @@
D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
sword status;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " 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->stmhp, &phs->bndhp, imp_sth->errhp,
@@ -2276,7 +2283,7 @@
oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_RSET");
return 0;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " pp_rebind_ph_rset_in: END\n");
return 2;
}
@@ -2293,7 +2300,7 @@
int count;
sword status;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " bind %s - allocating new sth...\n",
phs->name);
/* extproc deallocates everything for us */
@@ -2335,7 +2342,7 @@
PUTBACK;
FREETMPS;
LEAVE;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " bind %s - allocated %s...\n",
phs->name, neatsvpv(phs->sv, 0));
@@ -2345,7 +2352,7 @@
SV * sth_csr = phs->sv;
D_impdata(imp_sth_csr, imp_sth_t, sth_csr);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3 )
PerlIO_printf(DBILOGFP, " bind %s - initialising new %s for
cursor 0x%lx...\n",
phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv);
@@ -2382,7 +2389,7 @@
SV* ptr;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " in dbd_rebind_ph_xml\n");
/*go and create the XML dom from the passed in value*/
@@ -2427,7 +2434,7 @@
oci_error(sth, imp_sth->errhp, status, "OCIBindByName SQLT_NTY");
return 0;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " pp_rebind_ph_nty: END\n");
@@ -2455,7 +2462,7 @@
ub1 csform;
ub2 csid;
- if (trace_level >= 5)
+ if (trace_level >= 5 || dbd_verbose >= 5 )
PerlIO_printf(DBILOGFP, "dbd_rebind_ph() (1): rebinding %s as
%s (%s, ftype %d, csid %d, csform %d, inout %d)\n",
phs->name, (SvPOK(phs->sv) ? neatsvpv(phs->sv,0) :
"NULL"),(SvUTF8(phs->sv) ? "is-utf8" : "not-utf8"),
phs->ftype, phs->csid, phs->csform, phs->is_inout);
@@ -2484,7 +2491,7 @@
if (done == 2) { /* the dbd_rebind_* did the OCI bind call itself
successfully */
- if (trace_level >= 3)
+ if (trace_level >= 3 || dbd_verbose >= 3 )
PerlIO_printf(DBILOGFP, " bind %s done with ftype
%d\n",
phs->name, phs->ftype);
return 1;
@@ -2534,7 +2541,7 @@
csform = SQLCS_IMPLICIT;
else if (CSFORM_IMPLIES_UTF8(SQLCS_NCHAR))
csform = SQLCS_NCHAR; /* else leave csform == 0 */
- if (trace_level)
+ if (trace_level || dbd_verbose >= 1)
PerlIO_printf(DBILOGFP, "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" :
@@ -2563,7 +2570,7 @@
if (SvUTF8(phs->sv) && !CS_IS_UTF8(csid))
csid = utf8_csid; /* not al32utf8_csid here on purpose */
- if (trace_level >= 3)
+ if (trace_level >= 3 || dbd_verbose >= 3 )
PerlIO_printf(DBILOGFP, "dbd_rebind_ph(): bind %s <== %s "
"(%s, %s, csid %d->%d->%d, ftype %d, csform %d->%d, maxlen %lu,
maxdata_size %lu)\n",
phs->name, neatsvpv(phs->sv,0),
@@ -2642,7 +2649,7 @@
if (SvTYPE(newvalue) == SVt_PVLV && is_inout) /* may allow later */
croak("Can't bind ``lvalue'' mode scalar as inout parameter
(currently)");
- if (DBIS->debug >= 2) {
+ if (DBIS->debug >= 2 || dbd_verbose >=2) {
PerlIO_printf(DBILOGFP, "dbd_bind_ph(): bind %s <== %s (type
%ld",
name, neatsvpv(newvalue,0), (long)sql_type);
if (is_inout)
@@ -2870,7 +2877,7 @@
int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT);
- if (debug >= 2)
+ if (debug >= 2 || dbd_verbose >= 2)
PerlIO_printf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n",
oci_stmt_type_name(imp_sth->stmt_type), outparams,
imp_sth->has_lobs);
@@ -3369,7 +3376,7 @@
}
ftype = ftype; /* no unused */
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" blob_read field %d+1, ftype %d, offset %ld, len %ld,
destoffset %ld, retlen %ld\n",
field, imp_sth->fbh[field].ftype, offset, len, destoffset,
(long)retl);
@@ -3501,7 +3508,7 @@
}
if (is_temporary) {
- if (DBIS->debug >= 3) {
+ if (DBIS->debug >= 3 || dbd_verbose >=3 ) {
PerlIO_printf(DBILOGFP, " OCILobFreeTemporary %s\n",
oci_status_name(status));
}
OCILobFreeTemporary_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc,
status);
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Tue Jun 24 07:05:38 2008
@@ -245,6 +245,7 @@
/* ------ define functions and external variables ------ */
extern int ora_fetchtest;
+extern int dbd_verbose;
extern ub2 charsetid;
extern ub2 ncharsetid;
@@ -323,7 +324,6 @@
void * oci_st_handle(imp_sth_t *imp_sth, int handle_type, int flags);
void fb_ary_free(fb_ary_t *fb_ary);
-#include "ocitrace.h"
@@ -352,6 +352,7 @@
#define dbd_st_FETCH_attrib ora_st_FETCH_attrib
#define dbd_describe ora_describe
#define dbd_bind_ph ora_bind_ph
+#include "ocitrace.h"
/* end */
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Tue Jun 24 07:05:38 2008
@@ -405,7 +405,7 @@
OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE,
status);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s (pl%d,
auto_lob%d, check_sql%d)\n",
oci_stmt_type_name(imp_sth->stmt_type),
oparse_lng, imp_sth->auto_lob, ora_check_sql);
@@ -493,7 +493,7 @@
*alenp = phs->alen;
*indpp = &phs->indp;
*piecep = OCI_ONE_PIECE;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " in '%s' [%lu,%lu]: len %2lu,
ind %d%s\n",
phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen),
phs->indp,
(phs->desc_h) ? " via descriptor" : "");
@@ -578,7 +578,7 @@
*alenpp = &phs->alen;
*indpp = &phs->indp;
*rcodepp= &phs->arcode;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld,
piece %d%s\n",
phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen),
*piecep,
(phs->desc_h) ? " via descriptor" : "");
@@ -707,7 +707,7 @@
return 0;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " fetching field %d of %d.
LONG value truncated from %lu to %lu.\n",
fbh->field_num+1, DBIc_NUM_FIELDS(imp_sth),
ul_t(datalen), ul_t(bytelen));
@@ -760,7 +760,7 @@
if (fbh_nested->fetch_cleanup)
fbh_nested->fetch_cleanup(sth_nested, fbh_nested);
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" fetch_cleanup_rset - deactivating handle %s (defunct
nested cursor)\n",
neatsvpv(sth_nested, 0));
@@ -782,7 +782,7 @@
HV *init_attr = newHV();
int count;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" fetch_func_rset - allocating handle for cursor nested
within %s ...\n",
neatsvpv(sth, 0));
@@ -802,7 +802,7 @@
SvREFCNT_dec(init_attr);
PUTBACK; FREETMPS; LEAVE;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" fetch_func_rset - ... allocated %s for nested cursor\n",
neatsvpv(dest_sv, 0));
@@ -959,7 +959,7 @@
phs->csform = csform;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " calling OCILobWrite
phs->csid=%d phs->csform=%d amtp=%d\n",
phs->csid, phs->csform, amtp );
@@ -1041,7 +1041,7 @@
0, 0, (ub2)0 ,csform ,status );
/* lab 0, 0, (ub2)0, (ub1)SQLCS_IMPLICIT, status); */
- if (dbis->debug >= 3)
+ if (dbis->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen
%lu, LongReadLen %lu, BufLen %lu, Got %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));
@@ -1061,7 +1061,7 @@
else {
assert(amtp == 0);
SvGROW(dest_sv, byte_destoffset + 1);
- if (dbis->debug >= 3)
+ if (dbis->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu,
BufLen %lu, Got %lu\n",
fbh->field_num+1, "SKIPPED", (unsigned long)loblen,
@@ -1069,7 +1069,7 @@
(unsigned long)amtp);
}
- if (dbis->debug >= 3)
+ if (dbis->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " 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));
@@ -1160,7 +1160,7 @@
buflen = amtp;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" blob_read field %d: ftype %d %s, offset %ld, len %lu."
"LOB csform %d, len %lu, amtp %lu, (destoffset=%ld)\n",
@@ -1175,7 +1175,7 @@
&amtp, (ub4)1 + offset, bufp, buflen,
0, 0, (ub2)0 , csform, status);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu,
BufLen %lu, amtp %lu\n",
fbh->field_num+1, oci_status_name(status), ul_t(loblen),
@@ -1190,7 +1190,7 @@
}
else {
assert(amtp == 0);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" OCILobRead field %d %s: LOBlen %lu, LongReadLen %lu,
BufLen %lu, Got %lu\n",
fbh->field_num+1, "SKIPPED", ul_t(loblen),
@@ -1303,7 +1303,7 @@
OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc,
&amtp, (ub4)1, SvPVX(dest_sv), buflen,
0, 0, (ub2)0, csform, status);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" OCILobRead %s %s: csform %d, LOBlen %luc, LongReadLen
%luc, BufLen %lub, Got %luc\n",
name, oci_status_name(status), csform, ul_t(loblen),
@@ -1331,7 +1331,7 @@
/* tell perl what we've put in its dest_sv */
SvCUR(dest_sv) = amtp;
*SvEND(dest_sv) = '\0';
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP,
" OCILobRead %s %s: LOBlen %lu, LongReadLen %lu, BufLen
%lu, Got %lu\n",
name, "SKIPPED", ul_t(loblen),
@@ -1369,7 +1369,7 @@
fbh_setup_getrefpv(imp_fbh_t *fbh, int desc_t, char *bless)
{
dTHX;
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >=2)
PerlIO_printf(DBILOGFP,
" col %d: otype %d, desctype %d, %s", fbh->field_num,
fbh->dbtype, desc_t, bless);
fbh->ftype = fbh->dbtype;
@@ -1433,7 +1433,7 @@
SV *raw_sv;
/* get the data based on the type code*/
- if (DBIS->debug >= 5) {
+ if (DBIS->debug >= 5 || dbd_verbose >=5) {
PerlIO_printf(DBILOGFP, " getting value of object attribute named %s
with typecode=%s\n",name,oci_typecode_name(typecode));
}
@@ -1578,7 +1578,7 @@
fbh_obj_t *fld;
OCIInd *obj_ind;
- if (DBIS->debug >= 5) {
+ if (DBIS->debug >= 5 || dbd_verbose >=5) {
PerlIO_printf(DBILOGFP, " getting attributes of object named
%s with typecode=%s\n",obj->type_name,oci_typecode_name(obj->typecode));
}
@@ -1728,7 +1728,7 @@
fetch_func_oci_object(SV *sth, imp_fbh_t *fbh,SV *dest_sv)
{
dTHX;
- if (DBIS->debug >= 4) {
+ if (DBIS->debug >= 4 || dbd_verbose >=4) {
PerlIO_printf(DBILOGFP, " getting an embedded object named %s
with typecode=%s\n",fbh->obj->type_name,oci_typecode_name(fbh->obj->typecode));
}
@@ -1854,7 +1854,7 @@
fb_ary->cb_bufl=fbh->disize; /*reset this back to the max size for the
fetch*/
memset( fb_ary->cb_abuf, '\0', fbh->disize ); /*clean out the call back
buffer*/
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP," fetch_cleanup_pres_lobs \n");
return;
@@ -1872,7 +1872,7 @@
}
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP," fetch_cleanup_oci_object \n");
return;
}
@@ -1887,7 +1887,7 @@
imp_sth->rs_array_num_rows=0;
imp_sth->rs_array_idx=0;
imp_sth->rs_array_status=OCI_SUCCESS;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=3)
PerlIO_printf(DBILOGFP, " rs_array_init: rs_array_on=%d,
rs_array_size=%d\n",imp_sth->rs_array_on,imp_sth->rs_array_size);
}
@@ -1966,7 +1966,7 @@
if (imp_sth->rs_array_on && cache_rows>0)
imp_sth->rs_array_size=cache_rows>128?128:cache_rows; /*
restrict to 128 for now */
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" row cache OCI_ATTR_PREFETCH_ROWS %lu, OCI_ATTR_PREFETCH_MEMORY
%lu\n",
(unsigned long) (cache_rows), (unsigned long) (cache_mem));
@@ -1984,7 +1984,7 @@
dTHX;
sword status;
- if (DBIS->debug >= 5) {
+ if (DBIS->debug >= 5 || dbd_verbose >= 5) {
PerlIO_printf(DBILOGFP, "At level=%d in description an embedded
object \n",level);
}
/*Describe the field (OCIParm) we know it is a object or a collection */
@@ -1998,7 +1998,7 @@
return 0;
}
- if (DBIS->debug >= 6) {
+ if (DBIS->debug >= 6 || dbd_verbose >= 6) {
PerlIO_printf(DBILOGFP, "Geting the properties of object named
=%s at level %d\n",obj->type_name,level);
}
OCITypeByName_log_stat(imp_sth->envhp,imp_sth->errhp,imp_sth->svchp,obj->type_name,obj->type_namel,&obj->tdo,status);
@@ -2034,7 +2034,7 @@
OCIParam *list_attr= (OCIParam *) 0;
ub2 pos;
- if (DBIS->debug >= 6) {
+ if (DBIS->debug >= 6 || dbd_verbose >= 6) {
PerlIO_printf(DBILOGFP, "Object named =%s at level %d
is an Object\n",obj->type_name,level);
}
@@ -2100,7 +2100,7 @@
return 0;
}
- if (DBIS->debug >= 6) {
+ if (DBIS->debug >= 6 || dbd_verbose >= 6) {
PerlIO_printf(DBILOGFP, "Getting property #%d,
named=%s and its typecode is %d \n",pos,fld->type_name,fld->typecode);
}
@@ -2114,7 +2114,7 @@
} else {
/*well this is an embedded table or varray of some form so find
out what is in it*/
- if (DBIS->debug >= 6) {
+ if (DBIS->debug >= 6 || dbd_verbose >= 6) {
PerlIO_printf(DBILOGFP, "Object named =%s at level %d
is an Varray or Table\n",obj->type_name,level);
}
@@ -2219,14 +2219,14 @@
imp_sth->long_readlen = long_readlen;
if (imp_sth->stmt_type != OCI_STMT_SELECT) { /* XXX DISABLED, see
num_fields test below */
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " dbd_describe skipped for
%s\n",
oci_stmt_type_name(imp_sth->stmt_type));
/* imp_sth memory was cleared when created so no setup required here
*/
return 1;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " 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);
@@ -2251,7 +2251,7 @@
return 0;
}
if (num_fields == 0) {
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " dbd_describe skipped for %s (no fields
returned)\n",
oci_stmt_type_name(imp_sth->stmt_type));
/* imp_sth memory was cleared when created so no setup required here
*/
@@ -2450,14 +2450,14 @@
fbh->ftype = fbh->dbtype;
fbh->disize = fbh->dbsize;
p = "Field %d has an Oracle type (%d) which is
not explicitly supported%s";
- if (DBIS->debug >= 1)
+ if (DBIS->debug >= 1 || dbd_verbose >= 1)
PerlIO_printf(DBILOGFP, p, i, fbh->dbtype,
"\n");
if (dowarn)
warn(p, i, fbh->dbtype, "");
break;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" col %2d: dbtype %d, scale %d, prec %d, nullok %d, name
%s\n"
" : dbsize %d, char_used %d, char_size %d, csid
%d, csform %d, disize %d\n",
@@ -2476,7 +2476,7 @@
est_width += avg_width;
- if (DBIS->debug >= 2)
+ if (DBIS->debug >= 2 || dbd_verbose >= 2)
dbd_fbh_dump(fbh, (int)i, 0);
}/* end define of filed struct[i] fbh*/
@@ -2541,7 +2541,7 @@
if (fbh->ftype == 108) { /* Embedded object bind it
differently*/
- if (DBIS->debug >= 5){
+ if (DBIS->debug >= 5 || dbd_verbose >= 5){
PerlIO_printf(DBILOGFP,"Field #%d is a object
or colection of some sort. Using OCIDefineObject and or OCIObjectPin \n",i);
}
@@ -2553,7 +2553,7 @@
++num_errors;
}
- if (DBIS->debug >= 5){
+ if (DBIS->debug >= 5 || dbd_verbose >= 5){
dump_struct(imp_sth,fbh->obj,0);
}
@@ -2575,7 +2575,7 @@
#ifdef OCI_ATTR_CHARSET_FORM
if ( (fbh->dbtype == 1) && fbh->csform ) {
/* csform may be 0 when talking to Oracle 8.0 database*/
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " calling OCIAttrSet
OCI_ATTR_CHARSET_FORM with csform=%d\n", fbh->csform );
OCIAttrSet_log_stat( fbh->defnp, (ub4)
OCI_HTYPE_DEFINE, (dvoid *) &fbh->csform,
(ub4) 0, (ub4) OCI_ATTR_CHARSET_FORM,
imp_sth->errhp, status );
@@ -2588,7 +2588,7 @@
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" dbd_describe'd %d columns (row bytes: %d max, %d
est avg, cache: %d)\n",
(int)num_fields, imp_sth->t_dbsize, imp_sth->est_width,
imp_sth->cache_rows);
@@ -2628,7 +2628,7 @@
status = OCI_SUCCESS;
} else {
- if (DBIS->debug >= 3){
+ if (DBIS->debug >= 3 || dbd_verbose >= 3){
PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n",
DBIc_NUM_FIELDS(imp_sth));
}
@@ -2637,7 +2637,7 @@
if (imp_sth->exe_mode!=OCI_STMT_SCROLLABLE_READONLY)
croak ("attempt to use a scrollable cursor
without first setting ora_exe_mode to OCI_STMT_SCROLLABLE_READONLY\n") ;
- if (DBIS->debug >= 4)
+ if (DBIS->debug >= 4 || dbd_verbose >= 4)
PerlIO_printf(DBILOGFP," Scrolling Fetch,
postion before fetch=%d, Orientation = %s , Fetchoffset =%d\n",
imp_sth->fetch_position,oci_fetch_options(imp_sth->fetch_orient),imp_sth->fetch_offset);
@@ -2647,7 +2647,7 @@
/* defualt and OCI_FETCH_NEXT are the same so
this avoids miscaluation on the next value*/
OCIAttrGet_stmhp_stat(imp_sth,
&imp_sth->fetch_position, 0, OCI_ATTR_CURRENT_POSITION, status);
- if (DBIS->debug >= 4)
+ if (DBIS->debug >= 4 || dbd_verbose >= 4)
PerlIO_printf(DBILOGFP," Scrolling Fetch,
postion after fetch=%d\n",imp_sth->fetch_position);
} else {
@@ -2676,7 +2676,7 @@
if (status == OCI_NO_DATA) {
dTHR; /* for DBIc_ACTIVE_off */
DBIc_ACTIVE_off(imp_sth); /* eg finish */
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " dbd_st_fetch
no-more-data\n");
return Nullav;
}
@@ -2692,7 +2692,7 @@
av = DBIS->get_fbav(imp_sth);
- if (DBIS->debug >= 3) {
+ if (DBIS->debug >= 3 || dbd_verbose >= 3) {
PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields %s\n",
num_fields, oci_status_name(status));
}
@@ -2740,13 +2740,13 @@
ub4
actual_bufl=imp_sth->piece_size*(fb_ary->piece_count)+fb_ary->bufl;
if (fb_ary->piece_count==0){
- if (DBIS->debug >= 6)
+ if (DBIS->debug >= 6 ||
dbd_verbose >= 6)
PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (char/bytes) with callback
in 1 piece of %d (Char/Bytes)\n",actual_bufl,fb_ary->bufl);
memcpy(fb_ary->cb_abuf,fb_ary->abuf,fb_ary->bufl );
} else {
- if (DBIS->debug >= 6)
+ if (DBIS->debug >= 6 || dbd_verbose >=
6)
PerlIO_printf(DBILOGFP," Fetch persistent lob of %d (Char/Bytes) with callback
in %d piece(s) of %d (Char/Bytes) and one piece of %d
(Char/Bytes)\n",actual_bufl,fb_ary->piece_count,fbh->piece_size,fb_ary->bufl);
memcpy(fb_ary->cb_abuf+imp_sth->piece_size*(fb_ary->piece_count),fb_ary->abuf,fb_ary->bufl
);
@@ -2810,7 +2810,7 @@
oci_error(sth, imp_sth->errhp, OCI_ERROR, buf);
}
- if (DBIS->debug >= 5){
+ if (DBIS->debug >= 5 || dbd_verbose >= 5){
PerlIO_printf(DBILOGFP, "\n %p (rc=%d): %s\n",
av, i,neatsvpv(sv,0));
}
}
@@ -3021,7 +3021,7 @@
strncat(new_tablename, tablename,tablename_len);
tablename=new_tablename;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " lob refetching a
synonym named=%s for %s \n", syn_name,tablename);
}
@@ -3053,7 +3053,7 @@
return oci_error(sth, errhp, status,
"OCIDescribeAny/OCIAttrGet/LOB refetch");
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " lob refetch from table %s, %d
columns:\n", tablename, numcols);
for (i = 1; i <= (long)numcols; i++) {
@@ -3072,7 +3072,7 @@
OCI_ATTR_NAME, errhp, status);
if (status)
break;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " lob refetch table col %d:
'%.*s' otype %d\n",
(int)i, (int)col_name_len,col_name, col_dbtype);
if (col_dbtype != SQLT_CLOB && col_dbtype != SQLT_BLOB)
@@ -3140,7 +3140,7 @@
while( (sv_other =
hv_iternextsv(lob_cols_hv, &p_other, &i)) != NULL ) {
if (phs->ftype !=
SvIV(sv_other))
continue;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 ||
dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
"
both %s and %s have type %d - ambiguous\n",
neatsvpv(sv,0), neatsvpv(sv_other,0), (int)SvIV(sv_other));
@@ -3154,7 +3154,7 @@
sprintf(sql_field, "%s%s \"%s\"",
(SvCUR(sql_select)>7)?", ":"", p,
&phs->name[1]);
sv_catpv(sql_select, sql_field);
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" lob refetch %s param:
otype %d, matched field '%s' %s(%s)\n",
phs->name, phs->ftype, p,
@@ -3171,7 +3171,7 @@
}
if (!matched) {
++unmatched_params;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >=
3)
PerlIO_printf(DBILOGFP,
" lob refetch %s
param: otype %d, UNMATCHED\n",
phs->name, phs->ftype);
@@ -3187,7 +3187,7 @@
sv_catpv(sql_select, " from ");
sv_catpv(sql_select, tablename);
sv_catpv(sql_select, " where rowid = :rid for update"); /* get
row with lock */
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" lob refetch sql: %s\n",
SvPVX(sql_select));
lr->stmthp = NULL;
@@ -3227,7 +3227,7 @@
fbh->name,i+1);
phs = (phs_t*)(void*)SvPVX(*phs_svp);
fbh->special = phs;
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP,
" lob refetch %d for '%s'
param: ftype %d setup\n",
(int)i+1,fbh->name, fbh->dbtype);
@@ -3340,7 +3340,7 @@
fbh->csform = csform;
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3)
PerlIO_printf(DBILOGFP, " calling OCILobWrite
fbh->csid=%d fbh->csform=%d amtp=%d\n",
fbh->csid, fbh->csform, amtp );
@@ -3357,7 +3357,7 @@
return oci_error(sth, errhp, status, "OCILobTrim in
post_execute_lobs");
}
}
- if (DBIS->debug >= 3)
+ if (DBIS->debug >= 3 || dbd_verbose >= 3 )
PerlIO_printf(DBILOGFP,
" lob refetch %d for '%s' param: ftype %d, len
%ld: %s %s\n",
i+1,fbh->name, fbh->dbtype, ul_t(amtp),
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Tue Jun 24 07:05:38 2008
@@ -6,7 +6,7 @@
Macros named "_log_stat" return status in last parameter.
*/
-#define DBD_OCI_TRACEON (DBIS->debug >= 6)
+#define DBD_OCI_TRACEON (DBIS->debug >= 6 || dbd_verbose>=6)
#define DBD_OCI_TRACEFP (DBILOGFP)
#define OciTp ("\tOCI") /* OCI Trace Prefix */
#define OciTstr(s) ((s) ? (text*)(s) : (text*)"<NULL>")
@@ -47,7 +47,7 @@
#define
OCIXMLTypeCreateFromSrc_log_stat(svchp,envhp,src_type,src_ptr,xml,stat)\
stat =OCIXMLTypeCreateFromSrc
(svchp,envhp,(OCIDuration)OCI_DURATION_CALLOUT,(ub1)src_type,(dvoid
*)src_ptr,(sb4)OCI_IND_NOTNULL, xml);\
- (DBD_OCI_TRACEON) \
+ (DBD_OCI_TRACEON) \
? PerlIO_printf(DBD_OCI_TRACEFP,\
"%sOCIXMLTypeCreateFromSrc_log_stat(%p,%p,%p,%p,%p)=%s\n",\
OciTp, (void*)svchp,(void*)envhp, src_type,
src_ptr,oci_status_name(stat)),stat \
