[svn:dbd-oracle] r15364 - in dbd-oracle/trunk: . t
[email protected] Thu, 9 Aug 2012 09:46:44 -0700 (PDT)
| Newsgroups | perl.dbd.oracle.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: mjevans
Date: Thu Aug 9 09:46:43 2012
New Revision: 15364
Added:
dbd-oracle/trunk/t/39attr.t (contents, props changed)
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/t/38taf.t (contents, props changed)
Log:
loads of TAF changes
more tests for attributes
removed loads of code duplicated in connect for attributes which are
set in STORE by default
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Thu Aug 9 09:46:43 2012
@@ -9,7 +9,7 @@
- fix finding client in situation where client and server both
installed but different architectures (patch by H.Merijn Brand)
- - fix memeory leak in TAF handling - the TAF function was leaked
+ - fix memory leak in TAF handling - the TAF function was leaked
(Martin J. Evans)
- fix issue with taf_function being set to a scalar which goes
@@ -18,6 +18,21 @@
- fix RT46739 if a connection breaks the environment handle is
not thrown away (Martin J. Evans)
+ - ora_driver_name was not defaulted to the correct DBD::Oracle
+ version (Martin J. Evans)
+
+ - ora_driver_name, ora_client_info, ora_client_identifier,
+ ora_action and ora_oci_success_warn were set twice (if specified)
+ on connect as they were not deleted from the connect attributes
+ once handled. Code now leaves the setting to the later STORE DBI
+ calls (Martin J. Evans)
+
+ - ora_taf_function can now be a code reference as well as a string
+ (Martin J. Evans)
+
+ - the ora_taf_function is now passed a third argument of the
+ connection handle (Martin J. Evans)
+
[CHANGE IN BEHAVIOUR]
- In future versions taf_sleep will be withdrawn as you can simply
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Thu Aug 9 09:46:43 2012
@@ -20,8 +20,6 @@
#include "Oracle.h"
-
-
/* XXX DBI should provide a better version of this */
#define IS_DBI_HANDLE(h) \
(SvROK(h) && SvTYPE(SvRV(h)) == SVt_PVHV && \
@@ -422,63 +420,17 @@
DBD_ATTRIB_GET_IV( attr, "ora_drcp_max", 12, svp, imp_dbh->pool_max);
if (DBD_ATTRIB_TRUE(attr,"ora_drcp_incr",13,svp))
DBD_ATTRIB_GET_IV( attr, "ora_drcp_incr", 13, svp, imp_dbh->pool_incr);
-
-
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_driver_name", 15)) && SvOK(*svp)) {
- STRLEN svp_len;
- if (!SvPOK(*svp))
- croak("ora_driver_name is not a string");
- imp_dbh->driver_name = (char *) SvPV (*svp, svp_len );
- imp_dbh->driver_namel= (ub4) svp_len;
- OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->driver_name,imp_dbh->driver_namel,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
- }
- else {
- OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION,(text*)"DBDO1.28",7,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
- }
-#endif /*ORA_OCI_112*/
-
-#ifdef OCI_ATTR_ACTION
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_action", 10)) && SvOK(*svp)) {
- STRLEN svp_len;
- if (!SvPOK(*svp))
- croak("ora_action is not a string");
- imp_dbh->action = (char *) SvPV (*svp, svp_len );
- imp_dbh->actionl= (ub4) svp_len;
- 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
-#ifdef OCI_ATTR_MODULE
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_module_name", 15)) && SvOK(*svp)) {
- STRLEN svp_len;
- if (!SvPOK(*svp))
- croak("ora_module_name is not a string");
- imp_dbh->module_name = (char *) SvPV (*svp, svp_len );
- imp_dbh->module_namel= (ub4) svp_len;
- 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);
+ imp_dbh->driver_name = "DBD01.47_00";
- }
+#ifdef ORA_OCI_112
+ OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION,
+ imp_dbh->driver_name,
+ (ub4)strlen(imp_dbh->driver_name),
+ OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
#endif
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_client_identifier", 21)) && SvOK(*svp)) {
- STRLEN svp_len;
- if (!SvPOK(*svp))
- croak("ora_client_identifier is not a string");
- imp_dbh->client_identifier = (char *) SvPV (*svp, svp_len );
- imp_dbh->client_identifierl= (ub4) svp_len;
- 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
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_client_info", 15)) && SvOK(*svp)) {
- STRLEN svp_len;
- if (!SvPOK(*svp))
- croak("ora_client_info is not a string");
- imp_dbh->client_info = (char *) SvPV (*svp, svp_len );
- imp_dbh->client_infol= (ub4) svp_len;
- 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
/* TAF Events */
imp_dbh->using_taf = 0;
@@ -486,22 +438,37 @@
imp_dbh->using_taf = 1;
imp_dbh->taf_sleep = 5; /* 5 second default */
+ /* avoid later STORE: */
+ /* See DBI::DBB problem with ATTRIBI_DELETE until DBI 1.607 */
+ /* DBD_ATTRIB_DELETE(attr, "ora_taf", 7); */
+ (void)hv_delete((HV*)SvRV(attr), "ora_taf", 7, G_DISCARD);
+
DBD_ATTRIB_GET_IV( attr, "ora_taf_sleep", 13, svp, imp_dbh->taf_sleep);
- if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_taf_function", 16)) && SvOK(*svp)) {
- STRLEN svp_len;
- char *fn;
+ /* avoid later STORE: */
+ /* See DBI::DBB problem with ATTRIBI_DELETE until DBI 1.607 */
+ /* DBD_ATTRIB_DELETE(attr, "ora_taf_sleep", 13); */
+ (void)hv_delete((HV*)SvRV(attr), "ora_taf_sleep", 13, G_DISCARD);
- if (!SvPOK(*svp))
- croak("ora_taf_function is not a string");
- fn = SvPV(*svp, svp_len);
- imp_dbh->taf_function = (char *)safemalloc(svp_len + 1);
- strcpy(imp_dbh->taf_function, fn);
+ if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_taf_function", 16)) && SvOK(*svp)) {
+ if ((SvROK(*svp) && (SvTYPE(SvRV(*svp)) == SVt_PVCV)) ||
+ (SvPOK(*svp))) {
+ imp_dbh->taf_function = newSVsv(*svp);
+ } else {
+ croak("ora_taf_function needs to be a string or code reference");
+ }
+ /* avoid later STORE: */
+ /* See DBI::DBB problem with ATTRIB_DELETE until DBI 1.607 */
+ /* DBD_ATTRIB_DELETE(attr, "ora_taf_function", 16); */
+ (void)hv_delete((HV*)SvRV(attr), "ora_taf_function", 16, G_DISCARD);
}
+#ifdef DONT_DO_NOW
if (DBIc_DBISTATE(imp_dbh)->debug || dbd_verbose >= 3)
PerlIO_printf(
DBIc_LOGPIO(imp_dbh),
"taf sleep = %d, taf_function = %s\n",
- imp_dbh->taf_sleep, imp_dbh->taf_function ? imp_dbh->taf_function : "");
+ imp_dbh->taf_sleep,
+ (imp_dbh->taf_function ? imp_dbh->taf_function : "");
+#endif
}
imp_dbh->server_version = 0;
@@ -512,18 +479,6 @@
if (DBD_ATTRIB_TRUE(attr,"ora_verbose",11,svp))
DBD_ATTRIB_GET_IV( attr, "ora_verbose", 11, svp, dbd_verbose);
-
- /* check to see if success_warn is set. This will */
- /* warn after some sucessfull operations for tuning results */
- if (DBD_ATTRIB_TRUE(attr,"ora_oci_success_warn",20,svp))
- DBD_ATTRIB_GET_IV( attr, "ora_oci_success_warn", 20, svp, oci_warn);
-
- /* check to see if ora_objects set*/
- /* with this set any embedded types will go into a DBD::Oracle::Object */
- /* rather than just an ref array */
- if (DBD_ATTRIB_TRUE(attr,"ora_objects",11,svp))
- DBD_ATTRIB_GET_IV( attr, "ora_objects",11, svp, ora_objects);
-
if (DBIc_DBISTATE(imp_dbh)->debug >= 6 || dbd_verbose >= 6 )
dump_env_to_trace(imp_dbh);
@@ -945,14 +900,15 @@
if (!can_taf){
croak("You are attempting to enable TAF on a server that is not TAF Enabled \n");
}
-
+#ifdef DONT_DO_KNOW
if (DBIc_DBISTATE(imp_dbh)->debug >= 4 || dbd_verbose >= 4 ) {
PerlIO_printf(
DBIc_LOGPIO(imp_dbh),
"Setting up TAF with wait time of %d seconds\n",
imp_dbh->taf_sleep);
}
- status = reg_taf_callback(imp_dbh);
+#endif
+ status = reg_taf_callback(dbh, imp_dbh);
if (status != OCI_SUCCESS) {
oci_error(dbh, NULL, status,
"Setting TAF Callback Failed! ");
@@ -1135,10 +1091,16 @@
(ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
}
+
if (imp_dbh->taf_function) {
- Safefree(imp_dbh->taf_function);
+ SvREFCNT_dec(imp_dbh->taf_function);
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) {
@@ -1180,8 +1142,9 @@
#ifdef ORA_OCI_112
else if (kl==15 && strEQ(key, "ora_driver_name") ) {
imp_dbh->driver_name = (char *) SvPV (valuesv, vl );
- imp_dbh->driver_namel= (ub4) vl;
- OCIAttrSet_log_stat(imp_dbh, imp_dbh->seshp,OCI_HTYPE_SESSION, imp_dbh->driver_name,imp_dbh->driver_namel,OCI_ATTR_DRIVER_NAME,imp_dbh->errhp, status);
+ 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;
@@ -1205,16 +1168,9 @@
imp_dbh->using_taf = 1;
}
else if (kl==16 && strEQ(key, "ora_taf_function") ) {
- STRLEN svp_len;
- char *fn;
-
- if (imp_dbh->taf_function) {
- Safefree(imp_dbh->taf_function);
- }
-
- fn = SvPV(valuesv, svp_len);
- imp_dbh->taf_function = (char *)safemalloc(svp_len + 1);
- strcpy(imp_dbh->taf_function, fn);
+ if (imp_dbh->taf_function)
+ SvREFCNT_dec(imp_dbh->taf_function);
+ imp_dbh->taf_function = newSVsv(valuesv);
}
else if (kl==13 && strEQ(key, "ora_taf_sleep") ) {
imp_dbh->taf_sleep = SvIV (valuesv);
@@ -1333,7 +1289,9 @@
retsv = newSViv(imp_dbh->using_taf);
}
else if (kl==16 && strEQ(key, "ora_taf_function") ) {
- retsv = newSVpv((char *)imp_dbh->taf_function,0);
+ if (imp_dbh->taf_function) {
+ retsv = newSVsv(imp_dbh->taf_function);
+ }
}
else if (kl==13 && strEQ(key, "ora_taf_sleep") ) {
retsv = newSViv(imp_dbh->taf_sleep);
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Thu Aug 9 09:46:43 2012
@@ -11,8 +11,9 @@
typedef struct taf_callback_st taf_callback_t;
struct taf_callback_st {
- char *function; /*User supplied TAF functiomn*/
+ SV *function; /*User supplied TAF functiomn*/
int sleep;
+ SV *dbh_ref;
};
typedef struct imp_fbh_st imp_fbh_t;
@@ -27,7 +28,6 @@
SV *ora_cache_o; /* for ora_open() cache override */
};
-
/* Define dbh implementor data structure */
struct imp_dbh_st {
dbih_dbc_t com; /* MUST be first element in structure */
@@ -56,12 +56,11 @@
ub4 pool_max;
ub4 pool_incr;
char *driver_name;/*driver name user defined*/
- ub4 driver_namel;
#endif
- taf_callback_t *taf_callback;
bool using_taf; /*TAF stuff*/
- char *taf_function; /*User supplied TAF functiomn*/
+ SV *taf_function; /*User supplied TAF functiomn*/
int taf_sleep;
+ taf_callback_t taf_ctx;
char *client_info; /*user defined*/
ub4 client_infol;
char *module_name; /*module user defined */
@@ -393,7 +392,7 @@
void rs_array_init(imp_sth_t *imp_sth);
ub4 ora_db_version _((SV *dbh, imp_dbh_t *imp_dbh));
-sb4 reg_taf_callback _((imp_dbh_t *imp_dbh));
+sb4 reg_taf_callback _((SV *dbh, imp_dbh_t *imp_dbh));
/* These defines avoid name clashes for multiple statically linked DBD's */
Modified: dbd-oracle/trunk/oci8.c
==============================================================================
--- dbd-oracle/trunk/oci8.c (original)
+++ dbd-oracle/trunk/oci8.c Thu Aug 9 09:46:43 2012
@@ -1316,8 +1316,10 @@
PUSHMARK(SP);
XPUSHs(sv_2mortal(newSViv(fo_event)));
XPUSHs(sv_2mortal(newSViv(fo_type)));
+ XPUSHs(SvRV(cb->dbh_ref));
+
PUTBACK;
- return_count = call_pv(cb->function, G_SCALAR);
+ return_count = call_sv(cb->function, G_SCALAR);
SPAGAIN;
@@ -1356,7 +1358,7 @@
sb4
-reg_taf_callback( imp_dbh_t *imp_dbh)
+reg_taf_callback(SV *dbh, imp_dbh_t *imp_dbh)
{
dTHX;
OCIFocbkStruct tafailover;
@@ -1364,6 +1366,7 @@
imp_dbh->taf_ctx.function = imp_dbh->taf_function;
imp_dbh->taf_ctx.sleep = imp_dbh->taf_sleep;
+ imp_dbh->taf_ctx.dbh_ref = newRV_inc(dbh);
if (dbd_verbose >= 5 ) {
PerlIO_printf(DBIc_LOGPIO(imp_dbh), " In reg_taf_callback\n");
Modified: dbd-oracle/trunk/t/38taf.t
==============================================================================
--- dbd-oracle/trunk/t/38taf.t (original)
+++ dbd-oracle/trunk/t/38taf.t Thu Aug 9 09:46:43 2012
@@ -1,9 +1,10 @@
#!perl -w
+# $Id$
use DBI;
use DBD::Oracle(qw(:ora_fail_over));
use strict;
-use Data::Dumper;
+#use Devel::Peek qw(SvREFCNT Dump);
use Test::More;
unshift @INC ,'t';
@@ -36,9 +37,24 @@
ok $dbh = DBI->connect($dsn, $dbuser, '',
{ora_taf=>1, ora_taf_sleep=>15,
ora_taf_function=>'taf'});
+
is($dbh->{ora_taf}, 1, 'TAF enabled');
is($dbh->{ora_taf_sleep}, 15, 'TAF sleep set');
is($dbh->{ora_taf_function}, 'taf', 'TAF callback');
+
+ $dbh->{ora_taf} = 0;
+ is($dbh->{ora_taf}, 0, 'TAF disabled');
+
+ $dbh->{ora_taf_sleep} = 10;
+ is($dbh->{ora_taf_sleep}, 10, 'TAF sleep set');
+
+ my $x = sub {};
+# diag(SvREFCNT($x));
+# diag(Dump($x));
+ $dbh->{ora_taf_function} = $x;
+ is(ref($dbh->{ora_taf_function}), 'CODE', 'TAF code ref');
+
+# diag(SvREFCNT($x));
}
$dbh->disconnect;
Added: dbd-oracle/trunk/t/39attr.t
==============================================================================
--- (empty file)
+++ dbd-oracle/trunk/t/39attr.t Thu Aug 9 09:46:43 2012
@@ -0,0 +1,57 @@
+#!perl -w
+# $Id$
+#
+# Test you can set and retrieve some attributes after connect
+# MJE wrote this after discovering the code to set these attributes
+# was duplicated in connect/login6 and STORE and it did not need to be
+# because DBI passes attributes to STORE for you.
+#
+use DBI;
+use DBD::Oracle(qw(:ora_fail_over));
+use strict;
+#use Devel::Peek qw(SvREFCNT Dump);
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+
+#use Devel::Leak;
+#use Test::LeakTrace;
+
+#no_leaks_ok {
+ do_it();
+#} -verbose;
+
+sub do_it {
+ #my $handle;
+ #my $count = Devel::Leak::NoteSV($handle);
+
+ my $dbh = eval { DBI->connect($dsn, $dbuser, '',) }
+ or plan skip_all => "Unable to connect to Oracle";
+
+ like($dbh->{ora_driver_name}, qr/DBD/, 'Default driver name');
+ foreach my $attr (qw(ora_module_name
+ ora_driver_name
+ ora_client_info
+ ora_client_identifier
+ ora_action)) {
+ $dbh->{$attr} = 'fred';
+ is($dbh->{$attr}, 'fred', "attribute $attr set and retrieved");
+ }
+
+ foreach my $attr (qw(ora_oci_success_warn
+ ora_objects)) {
+ $dbh->{$attr} = 1;
+ is($dbh->{$attr}, 1, "attribute $attr set and retrieved");
+ }
+
+ $dbh->disconnect;
+ #Devel::Leak::CheckSV($handle);
+}
+
+done_testing();