[svn:dbd-oracle] r14817 - in dbd-oracle/trunk: . t
[email protected] Mon, 4 Apr 2011 12:34:19 -0700 (PDT)
| Newsgroups | perl.dbd.oracle.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: byterock
Date: Mon Apr 4 12:34:19 2011
New Revision: 14817
Added:
dbd-oracle/trunk/t/38taf.t
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/MANIFEST
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/Oracle.xs
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/t/58object.t
Log:
Fully working TAF call back
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Mon Apr 4 12:34:19 2011
@@ -1,5 +1,6 @@
=head1 Changes in DBD-Oracle 1.29_1 (svn rev NNNNN)
+ Added support for TAF callback by John Scoles
Fixed some compiler warnings in dbdimp.c and oci8.c by Martin J. Evans
Added Test::Simple 0.90 to build_requires as we use note etc by Martin J. Evans
Added missing OCIServerRelease to oci.def
Modified: dbd-oracle/trunk/MANIFEST
==============================================================================
--- dbd-oracle/trunk/MANIFEST (original)
+++ dbd-oracle/trunk/MANIFEST Mon Apr 4 12:34:19 2011
@@ -87,6 +87,8 @@
t/31lob_extended.t
t/32xmltype.t
t/34pres_lobs.t
+t/36lob_leak.t
+t/38taf.t
t/40ph_type.t
t/50cursor.t
t/51scroll.t
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Mon Apr 4 12:34:19 2011
@@ -31,12 +31,15 @@
ora_fetch_orient => [ qw( OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST
OCI_FETCH_LAST OCI_FETCH_PRIOR OCI_FETCH_ABSOLUTE
OCI_FETCH_RELATIVE)],
- ora_exe_modes => [ qw(OCI_STMT_SCROLLABLE_READONLY)],
+ ora_exe_modes => [ qw( OCI_STMT_SCROLLABLE_READONLY)],
+ ora_fail_over => [ qw( OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN
+ OCI_FO_ERROR OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT
+ OCI_FO_TXNAL)],
);
@EXPORT_OK = qw(OCI_FETCH_NEXT OCI_FETCH_CURRENT OCI_FETCH_FIRST OCI_FETCH_LAST OCI_FETCH_PRIOR
OCI_FETCH_ABSOLUTE OCI_FETCH_RELATIVE ORA_OCI SQLCS_IMPLICIT SQLCS_NCHAR ora_env_var ora_cygwin_set_env );
#unshift @EXPORT_OK, 'ora_cygwin_set_env' if $^O eq 'cygwin';
- Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient ora_exe_modes));
+ Exporter::export_ok_tags(qw(ora_types ora_session_modes ora_fetch_orient ora_exe_modes ora_fail_over));
my $Revision = substr(q$Revision: 1.103 $, 10);
@@ -68,22 +71,23 @@
});
DBD::Oracle::dr::init_oci($drh) ;
$drh->STORE('ShowErrorStatement', 1);
- DBD::Oracle::db->install_method("ora_lob_read");
- DBD::Oracle::db->install_method("ora_lob_write");
- DBD::Oracle::db->install_method("ora_lob_append");
- DBD::Oracle::db->install_method("ora_lob_trim");
- DBD::Oracle::db->install_method("ora_lob_length");
- DBD::Oracle::db->install_method("ora_lob_chunk_size");
- DBD::Oracle::db->install_method("ora_lob_is_init");
- DBD::Oracle::db->install_method("ora_nls_parameters");
- DBD::Oracle::db->install_method("ora_can_unicode");
- DBD::Oracle::st->install_method("ora_fetch_scroll");
- DBD::Oracle::st->install_method("ora_scroll_position");
- DBD::Oracle::st->install_method("ora_ping");
- DBD::Oracle::st->install_method("ora_stmt_type_name");
- DBD::Oracle::st->install_method("ora_stmt_type");
- $drh;
-
+ DBD::Oracle::db->install_method("ora_lob_read");
+ DBD::Oracle::db->install_method("ora_lob_write");
+ DBD::Oracle::db->install_method("ora_lob_append");
+ DBD::Oracle::db->install_method("ora_lob_trim");
+ DBD::Oracle::db->install_method("ora_lob_length");
+ DBD::Oracle::db->install_method("ora_lob_chunk_size");
+ DBD::Oracle::db->install_method("ora_lob_is_init");
+ DBD::Oracle::db->install_method("ora_nls_parameters");
+ DBD::Oracle::db->install_method("ora_can_unicode");
+ DBD::Oracle::db->install_method("ora_can_taf");
+ DBD::Oracle::st->install_method("ora_fetch_scroll");
+ DBD::Oracle::st->install_method("ora_scroll_position");
+ DBD::Oracle::st->install_method("ora_ping");
+ DBD::Oracle::st->install_method("ora_stmt_type_name");
+ DBD::Oracle::st->install_method("ora_stmt_type");
+ $drh;
+
}
@@ -379,6 +383,9 @@
ora_client_info => undef,
ora_client_identifier => undef,
ora_action => undef,
+ ora_taf => undef,
+ ora_taf_function => undef,
+ ora_taf_sleep => undef,
};
}
@@ -1074,6 +1081,7 @@
ora_rowid => undef,
ora_est_row_width => undef,
ora_type => undef,
+ ora_fail_over => undef,
};
}
}
@@ -1135,9 +1143,11 @@
| 1.25+ | N | N | N | N | N | Y |
+---------------------+----+-------------+---------+------+--------+--------+
-As there are dozens and dozens of different versions of Oracle's clients I did not bother to list any of them, just the major release versions of Oracle that are out there.
+As there are dozens and dozens of different versions of Oracle's clients I did not bother to list any of them, just the
+major release versions of Oracle that are out there.
-Note that one can still connect to any Oracle version with the older DBD::Oracle versions the only problem you will have is that some of the newer OCI and Oracle features available in later DBD::Oracle releases will not be available to you.
+Note that one can still connect to any Oracle version with the older DBD::Oracle versions the only problem you will
+have is that some of the newer OCI and Oracle features available in later DBD::Oracle releases will not be available to you.
So to make a short story a little longer;
@@ -1422,6 +1432,89 @@
At this point in time this is just the first crack at DRCP and DBD::Oracle so the mechanics or its implementation are subject to change.
+=head2 TAF (Transparent Application Failover)
+Transparent Application Failover (TAF) is a longstanding default feature in OCI that allows for clients to automatically reconnect to
+an instance in the event of a failure of the instance. The reconnect happens automatically from within the OCI (Oracle Call Interface) library.
+DBD::Oracle now supports a callback function that will fire when a TAF event takes place. The main use of the callback is to give the
+oppertunity for the program to inform the user that a failover is taking place.
+
+You will have to set up TAF on your instance before you can use this callback. You can test your instance to see if you can use TAF callback with
+
+ $dbh->ora_can_taf();
+
+If you try to set up a callback without it being enable DBD::Oracle will croak.
+
+It is outside the scope of this documents to go through all of the possiable TAF situations you might want to set up. Below is the simplest of examples;
+
+The TNS entry for the instace has had the following added to the CONNECT_DATA portion
+
+ (FAILOVER_MODE=
+ (TYPE=select)
+ (METHOD=basic)
+ (RETRIES=10)
+ (DELAY=10))
+
+You will also have to create your on perl function that will be called from the client. You can name it anything you want and it will allways have
+two parameters, the failover event value and the failover type. You can also set a sleep value in case of failover error and the oci client will sleep
+for the entered seconds before it attempts another event.
+
+ use DBD::Oracle(qw(:ora_fail_over));
+ #import the ora_fail_over constancts
+
+ #set up TAF on the conection
+ my $dbh = DBI->connect('dbi:Oracle:XE','hr','hr',{ora_taf=>1,taf_sleep=>5,ora_taf_function=>'handle_taft'});
+
+ #create the perl TAF event function
+
+ sub handle_taf {
+ my ($fo_event,$fo_type) = @_;
+ if ($fo_event == OCI_FO_BEGIN){
+
+ print(" Instance Unavailable Please stand by!! \n");
+ printf(" Your TAF type is %s \n",
+ (($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_ABORT){
+ printf(" Failover aborted. Failover will not take place.\n");
+ }
+ elsif ($fo_event == OCI_FO_END){
+ printf(" Failover ended ...Resuming your %s\n",(($fo_type==OCI_FO_NONE) ? "NONE"
+ :($fo_type==OCI_FO_SESSION) ? "SESSION"
+ :($fo_type==OCI_FO_SELECT) ? "SELECT"
+ : "UNKNOWN!"));
+ }
+ elsif ($fo_event == OCI_FO_REAUTH){
+ printf(" Failed over user. Resuming services\n");
+ }
+ elsif ($fo_event == OCI_FO_ERROR){
+ printf(" Failover error Sleeping...\n");
+ }
+ else {
+ printf(" Bad Failover Event: %d.\n", $fo_event);
+
+ }
+ return 0;
+ }
+
+The TAF types are as follows
+
+ OCI_FO_SESSION which indicates the user has requested only session failover.
+ OCI_FO_SELECT which indicates the user has requested select failover.
+ OCI_FO_NONE which inicates the user has not requested a failover type.
+ OCI_FO_TXNAL which indicates the user has requested a transaction failover.
+
+The TAF events are as follows
+
+ OCI_FO_BEGIN indicates that failover has detected a lost connection and failover is starting.
+ OCI_FO_END indicates successful completion of failover.
+ OCI_FO_ABORT indicates that failover was unsuccessful, and there is no option of retrying.
+ OCI_FO_ERROR also indicates that failover was unsuccessful, but it gives the application the opportunity to handle the error and retry failover.
+ OCI_FO_REAUTH indicates that you have multiple authentication handles and failover has occurred after the original authentication. It indicates that a user handle has been re-authenticated. To find out which, the application checks the OCI_ATTR_SESSION attribute of the service context handle (which is the first parameter).
+
+
=head2 Optimizing Oracle's listener
[By Lane Sharman <[email protected]>] I spent a LOT of time optimizing
@@ -1567,7 +1660,12 @@
=item :ora_exe_modes
OCI_STMT_SCROLLABLE_READONLY
-
+
+=item :ora_fail_over
+
+ OCI_FO_END OCI_FO_ABORT OCI_FO_REAUTH OCI_FO_BEGIN OCI_FO_ERROR
+ OCI_FO_NONE OCI_FO_SESSION OCI_FO_SELECT OCI_FO_TXNAL
+
=back
=head1 Attributes
@@ -1639,6 +1737,31 @@
This value can be set at the environment level with 'ORA_DRCP_INCR'.
+
+=item ora_taf
+
+If your Oracle instace has been configured to use TAF events you can enable the TAF callback by seting this
+value to anything other than 0;
+
+=item ora_taf_function
+
+The name of the Perl that will be called from OCI when a TAF event. You must supply a perl function to use the callback it will
+allways have two parameters, the failover event value and the failover type. Below is an example of a TAF function
+
+ sub taf_event{
+ my ($event,$type)=@_;
+
+ print "My TAF event=$event\n";
+ print "My TAF type=$type\n";
+ return;
+ }
+
+=item taf_sleep
+
+A sleep value in seconds that you can sent to the OCI client and when there is a TAF event of the type OCI_FO_ERROR the client
+will sleep that long before it attempts another failover event.
+
+
=item ora_session_mode
The ora_session_mode attribute can be used to connect with SYSDBA
@@ -3011,9 +3134,7 @@
# retrieve the string
$date_string = $dbh->func( 'dbms_output_get' );
-=over 4
-
-=item dbms_output_enable ( [ buffer_size ] )
+=head2 dbms_output_enable ( [ buffer_size ] )
This function calls DBMS_OUTPUT.ENABLE to enable calls to package
DBMS_OUTPUT procedures GET, GET_LINE, PUT, and PUT_LINE. Calls to
@@ -3024,7 +3145,7 @@
buffer and must be between 2000 and 1,000,000. If buffer_size is not
given, the default is 20,000 bytes.
-=item dbms_output_put ( [ @lines ] )
+=head2 dbms_output_put ( [ @lines ] )
This function calls DBMS_OUTPUT.PUT_LINE to add lines to the buffer.
@@ -3035,7 +3156,7 @@
is raised and the function call fails. Some of the text might be in
the buffer.
-=item dbms_output_get
+=head2 dbms_output_get
This function calls DBMS_OUTPUT.GET_LINE to retrieve lines of text from
the buffer.
@@ -3051,18 +3172,18 @@
DBMS_OUTPUT.GET is discarded by the next call to DBMS_OUTPUT.PUT_LINE,
DBMS_OUTPUT.PUT, or DBMS_OUTPUT.NEW_LINE.
-=item reauthenticate ( $username, $password )
+=head2 reauthenticate ( $username, $password )
Starts a new session against the current database using the credentials
supplied.
-=item ora_nls_parameters ( [ $refresh ] )
+=head2 ora_nls_parameters ( [ $refresh ] )
Returns a hash reference containing the current NLS parameters, as given
by the v$nls_parameters view. The values fetched are cached between calls.
To cause the latest values to be fetched, pass a true value to the function.
-=item ora_can_unicode ( [ $refresh ] )
+=head2 ora_can_unicode ( [ $refresh ] )
Returns a number indicating whether either of the database character sets
is a Unicode encoding. Calls ora_nls_parameters() and passes the optional
@@ -3076,22 +3197,22 @@
3 = Both character sets are Unicode encodings.
-=back
+=head2 ora_can_taf
+
+Returns true if the current connection supports TAF events. False if otherise.
=head1 Private statement handle functions
=over
-=item ora_stmt_type
+=head2 ora_stmt_type
Returns the OCI Statement Type number for the SQL of a statement handle.
-=item ora_stmt_type_name
+=head2 ora_stmt_type_name
Returns the OCI Statement Type name for the SQL of a statement handle.
-=back
-
=head1 Scrollable Cursors
Oracle supports the concept of a 'Scrollable Cursor' which is defined as a 'Result Set' where
Modified: dbd-oracle/trunk/Oracle.xs
==============================================================================
--- dbd-oracle/trunk/Oracle.xs (original)
+++ dbd-oracle/trunk/Oracle.xs Mon Apr 4 12:34:19 2011
@@ -25,31 +25,40 @@
ORA_CLOB = ORA_CLOB
ORA_BLOB = ORA_BLOB
ORA_RSET = ORA_RSET
- ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE
- ORA_NUMBER_TABLE = ORA_NUMBER_TABLE
- ORA_SYSDBA = 0x0002
- ORA_SYSOPER = 0x0004
- SQLCS_IMPLICIT = SQLCS_IMPLICIT
- SQLCS_NCHAR = SQLCS_NCHAR
- SQLT_INT = SQLT_INT
- SQLT_FLT = SQLT_FLT
+ ORA_VARCHAR2_TABLE = ORA_VARCHAR2_TABLE
+ ORA_NUMBER_TABLE = ORA_NUMBER_TABLE
+ ORA_SYSDBA = 0x0002
+ ORA_SYSOPER = 0x0004
+ SQLCS_IMPLICIT = SQLCS_IMPLICIT
+ SQLCS_NCHAR = SQLCS_NCHAR
+ SQLT_INT = SQLT_INT
+ SQLT_FLT = SQLT_FLT
OCI_BATCH_MODE = 0x01
- OCI_EXACT_FETCH = 0x02
- OCI_KEEP_FETCH_STATE = 0x04
- OCI_DESCRIBE_ONLY = 0x10
- OCI_COMMIT_ON_SUCCESS = 0x20
- OCI_NON_BLOCKING = 0x40
- OCI_BATCH_ERRORS = 0x80
- OCI_PARSE_ONLY = 0x100
- OCI_SHOW_DML_WARNINGS = 0x400
+ OCI_EXACT_FETCH = 0x02
+ OCI_KEEP_FETCH_STATE = 0x04
+ OCI_DESCRIBE_ONLY = 0x10
+ OCI_COMMIT_ON_SUCCESS = 0x20
+ OCI_NON_BLOCKING = 0x40
+ OCI_BATCH_ERRORS = 0x80
+ OCI_PARSE_ONLY = 0x100
+ OCI_SHOW_DML_WARNINGS = 0x400
+ OCI_FETCH_CURRENT = OCI_FETCH_CURRENT
+ OCI_FETCH_NEXT = OCI_FETCH_NEXT
+ OCI_FETCH_FIRST = OCI_FETCH_FIRST
+ OCI_FETCH_LAST = OCI_FETCH_LAST
+ OCI_FETCH_PRIOR = OCI_FETCH_PRIOR
+ OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE
+ OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE
+ OCI_FO_END = OCI_FO_END
+ OCI_FO_ABORT = OCI_FO_ABORT
+ OCI_FO_REAUTH = OCI_FO_REAUTH
+ OCI_FO_BEGIN = OCI_FO_BEGIN
+ OCI_FO_ERROR = OCI_FO_ERROR
+ OCI_FO_NONE = OCI_FO_NONE
+ OCI_FO_SESSION = OCI_FO_SESSION
+ OCI_FO_SELECT = OCI_FO_SELECT
+ OCI_FO_TXNAL = OCI_FO_TXNAL
OCI_STMT_SCROLLABLE_READONLY = 0x08
- OCI_FETCH_CURRENT = OCI_FETCH_CURRENT
- OCI_FETCH_NEXT = OCI_FETCH_NEXT
- OCI_FETCH_FIRST = OCI_FETCH_FIRST
- OCI_FETCH_LAST = OCI_FETCH_LAST
- OCI_FETCH_PRIOR = OCI_FETCH_PRIOR
- OCI_FETCH_ABSOLUTE = OCI_FETCH_ABSOLUTE
- OCI_FETCH_RELATIVE = OCI_FETCH_RELATIVE
SQLT_CHR = SQLT_CHR
SQLT_BIN = SQLT_BIN
CODE:
@@ -61,6 +70,7 @@
OUTPUT:
RETVAL
+
void
ORA_OCI()
CODE:
@@ -257,6 +267,23 @@
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
+void
+ora_can_taf(dbh)
+ SV *dbh
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ ub4 can_taf = 0;
+ CODE:
+ OCIAttrGet_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
+ OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCIAttrGet OCI_ATTR_TAF_ENABLED");
+ XSRETURN_IV(0);
+ }
+ else {
+ XSRETURN_IV(can_taf);
+ }
void
ora_ping(dbh)
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Mon Apr 4 12:34:19 2011
@@ -492,7 +492,26 @@
}
+ /* TAF Events */
+ imp_dbh->using_taf = 0;
+
+ if (DBD_ATTRIB_TRUE(attr,"ora_taf",7,svp)){
+ imp_dbh->using_taf = 1;
+ imp_dbh->taf_sleep = 5; /* 5 second default */
+
+ 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;
+ if (!SvPOK(*svp))
+ croak("ora_taf_function is not a string");
+ imp_dbh->taf_function = (char *) SvPV (*svp, svp_len );
+
+ }
+ }
+
imp_dbh->server_version = 0;
+
/* check to see if DBD_verbose or ora_verbose is set*/
if (DBD_ATTRIB_TRUE(attr,"dbd_verbose",11,svp))
DBD_ATTRIB_GET_IV( attr, "dbd_verbose", 11, svp, dbd_verbose);
@@ -1039,6 +1058,29 @@
}
#endif
+ /* set up TAF callback if wanted */
+
+
+ if (imp_dbh->using_taf){
+ bool can_taf;
+ OCIAttrGet_log_stat(imp_dbh->srvhp, OCI_HTYPE_SERVER, &can_taf, NULL,
+ OCI_ATTR_TAF_ENABLED, imp_dbh->errhp, status);
+
+ if (!can_taf){
+ croak("You are attempting to enable TAF on a server that is not TAF Enabled \n");
+ }
+
+ if (DBIS->debug >= 4 || dbd_verbose >= 4 ) {
+ PerlIO_printf(DBILOGFP,"Setting up TAF with wait time of %d seconds\n",imp_dbh->taf_sleep);
+ }
+ status = reg_taf_callback(imp_dbh);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, NULL, status,
+ "Setting TAF Callback Failed! ");
+ return 0;
+ }
+ }
+
return 1;
}
@@ -1204,6 +1246,15 @@
goto dbd_db_destroy_out;
if (!imp_dbh->proc_handles) {
sword status;
+ if (imp_dbh->using_taf){
+ OCIFocbkStruct tafailover;
+ tafailover.fo_ctx = NULL;
+ tafailover.callback_function = NULL;
+ OCIAttrSet_log_stat(imp_dbh->srvhp, (ub4) OCI_HTYPE_SERVER,
+ (dvoid *) &tafailover, (ub4) 0,
+ (ub4) OCI_ATTR_FOCBK, imp_dbh->errhp, status);
+
+ }
#ifdef ORA_OCI_112
if (imp_dbh->using_drcp) {
OCIHandleFree_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,status);
@@ -1265,6 +1316,21 @@
imp_dbh->pool_incr = SvIV (valuesv);
}
#endif
+ else if (kl==7 && strEQ(key, "ora_taf") ) {
+ imp_dbh->using_taf = 1;
+ }
+ else if (kl==16 && strEQ(key, "ora_taf_function") ) {
+ imp_dbh->taf_function = (char *) SvPV (valuesv, vl );
+ }
+ else if (kl==13 && strEQ(key, "ora_taf_sleep") ) {
+ imp_dbh->taf_sleep = SvIV (valuesv);
+ }
+ 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->seshp,OCI_HTYPE_SESSION, imp_dbh->action,imp_dbh->actionl,OCI_ATTR_ACTION,imp_dbh->errhp, status);
+
+ }
else if (kl==10 && strEQ(key, "ora_action") ) {
imp_dbh->action = (char *) SvPV (valuesv, vl );
imp_dbh->actionl= (ub4) vl;
@@ -1369,6 +1435,15 @@
retsv = newSViv(imp_dbh->pool_incr);
}
#endif
+ else if (kl==7 && strEQ(key, "ora_taf") ) {
+ retsv = newSViv(imp_dbh->using_taf);
+ }
+ else if (kl==16 && strEQ(key, "ora_taf_function") ) {
+ retsv = newSVpv((char *)imp_dbh->taf_function,0);
+ }
+ else if (kl==13 && strEQ(key, "ora_taf_sleep") ) {
+ retsv = newSViv(imp_dbh->taf_sleep);
+ }
else if (kl==10 && strEQ(key, "ora_action")) {
retsv = newSVpv((char *)imp_dbh->action,0);
}
@@ -1435,23 +1510,23 @@
SV *
createxmlfromstring(SV *sth, imp_sth_t *imp_sth, SV *source){
-dTHX;
-dTHR;
-OCIXMLType *xml = NULL;
-STRLEN len;
-ub4 buflen;
-sword status;
-ub1 src_type;
-dvoid* src_ptr = NULL;
-D_imp_dbh_from_sth;
-SV* sv_dest;
-dvoid *bufp;
-ub1 csform;
-ub2 csid;
-csid = 0;
-csform = SQLCS_IMPLICIT;
-len = SvLEN(source);
-bufp = SvPV(source, len);
+ dTHX;
+ dTHR;
+ OCIXMLType *xml = NULL;
+ STRLEN len;
+ ub4 buflen;
+ sword status;
+ ub1 src_type;
+ dvoid* src_ptr = NULL;
+ D_imp_dbh_from_sth;
+ SV* sv_dest;
+ dvoid *bufp;
+ ub1 csform;
+ ub2 csid;
+ csid = 0;
+ csform = SQLCS_IMPLICIT;
+ len = SvLEN(source);
+ bufp = SvPV(source, len);
if (DBIS->debug >=3 || dbd_verbose >= 3 )
PerlIO_printf(DBILOGFP, " creating xml from string that is %lu long\n",(unsigned long)len);
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Mon Apr 4 12:34:19 2011
@@ -8,6 +8,13 @@
/* ====== define data types ====== */
+typedef struct taf_callback_st taf_callback_t;
+
+struct taf_callback_st {
+ char *function; /*User supplied TAF functiomn*/
+ int sleep;
+};
+
typedef struct imp_fbh_st imp_fbh_t;
@@ -53,6 +60,10 @@
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*/
+ int taf_sleep;
char *client_info; /*user defined*/
ub4 client_infol;
char *module_name; /*module user defined */
@@ -77,6 +88,7 @@
#define DBH_DUP_LEN (sizeof(struct imp_dbh_st) - sizeof(dbih_dbc_t))
+
typedef struct lob_refetch_st lob_refetch_t; /* Define sth implementor data structure */
@@ -385,6 +397,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));
/* 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 Mon Apr 4 12:34:19 2011
@@ -1271,7 +1271,8 @@
to get it all. I also take set fb_ary->cb_abuf back to empty just
to keep things clean
-------------------------------------------------------------- */
-sb4 presist_lob_fetch_cbk(dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp,
+sb4
+presist_lob_fetch_cbk(dvoid *octxp, OCIDefine *dfnhp, ub4 iter, dvoid **bufpp,
ub4 **alenpp, ub1 *piecep, dvoid **indpp, ub2 **rcpp)
{
dTHX;
@@ -1285,7 +1286,7 @@
if (dbd_verbose >= 5 ) {
- PerlIO_printf(DBILOGFP, " In presist_lob_fetch_cbk\n");
+ PerlIO_printf(DBILOGFP, " In presist_lob_fetch_cbk\n");
}
if ( *piecep ==OCI_NEXT_PIECE ){/*more than one piece*/
@@ -1306,6 +1307,80 @@
}
+/* TAF or Trasarent Application Failoever callback
+ Works like this. The fuction below is registered on the server,
+ when the server is set up to use it, when an exe is called (not sure about other server round trips)
+ and the server fails tt should get into this cbk error below.
+ It will wait X seconds and then try to reconnect (up to n times if that is the users choice)
+ That is how I see it working */
+
+sb4
+taf_cbk(dvoid *svchp, dvoid *envhp, dvoid *fo_ctx,ub4 fo_type, ub4 fo_event )
+{
+ dTHX;
+ taf_callback_t *cb =(taf_callback_t*)fo_ctx;
+
+ dSP;
+ PUSHMARK(SP);
+ XPUSHs(sv_2mortal(newSViv(fo_event)));
+ XPUSHs(sv_2mortal(newSViv(fo_type)));
+ PUTBACK;
+ call_pv(cb->function, G_DISCARD);
+
+ switch (fo_event){
+
+ case OCI_FO_BEGIN:
+ case OCI_FO_ABORT:
+ case OCI_FO_END:
+ case OCI_FO_REAUTH:
+ {
+ break;
+ }
+ case OCI_FO_ERROR:
+ {
+ sleep(cb->sleep);
+ return OCI_FO_RETRY;
+ break;
+ }
+
+ default:
+ {
+ break;
+ }
+ }
+ return 0;
+}
+
+
+sb4
+reg_taf_callback( imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ OCIFocbkStruct tafailover;
+ sword status;
+ taf_callback_t *cb = NULL;
+/*allocate space for the callback */
+ Newz(1, cb, 1, taf_callback_t);
+ cb->function= (char*)safemalloc(strlen(imp_dbh->taf_function));
+ cb->sleep = imp_dbh->taf_sleep;
+ strcpy((char *)cb->function,imp_dbh->taf_function);
+
+ if (dbd_verbose >= 5 ) {
+ PerlIO_printf(DBILOGFP, " In reg_taf_callback\n");
+ }
+
+/* set the context up as a pointer to the taf callback struct*/
+ tafailover.fo_ctx = cb;
+ tafailover.callback_function = &taf_cbk;
+
+/* register the callback */
+ OCIAttrSet_log_stat(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
@@ -3960,6 +4035,7 @@
{
dTHX;
sword status;
+
/* OCI 8 does not seem to allow uid to be "name/pass" :-( */
/* so we have to split it up ourselves */
if (strlen(*pwdp)==0 && strchr(*uidp,'/')) {
@@ -4100,6 +4176,7 @@
+
struct lob_refetch_st {
OCIStmt *stmthp;
OCIBind *bindhp;
@@ -4623,4 +4700,4 @@
}
imp_dbh->server_version = vernum;
return vernum;
-}
+}
\ No newline at end of file
Added: dbd-oracle/trunk/t/38taf.t
==============================================================================
--- (empty file)
+++ dbd-oracle/trunk/t/38taf.t Mon Apr 4 12:34:19 2011
@@ -0,0 +1,48 @@
+#!perl -w
+
+use DBI;
+use DBD::Oracle(qw(:ora_fail_over));
+use strict;
+use Data::Dumper;
+
+use Test::More;
+unshift @INC ,'t';
+require 'nchar_test_lib.pl';
+
+$| = 1;
+
+
+# create a database handle
+my $dsn = oracle_test_dsn();
+my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
+my $dbh;
+eval {$dbh = DBI->connect($dsn, $dbuser, '',)};
+if ($dbh) {
+ if ($dbh->ora_can_taf()){
+ plan tests => 1;
+ }
+ else {
+ plan tests =>1;
+ }
+} else {
+ plan skip_all => "Unable to connect to Oracle";
+}
+
+$dbh->disconnect;
+
+if (!$dbh->ora_can_taf()){
+
+ eval {$dbh = DBI->connect($dsn, $dbuser, '',{ora_taf=>1,taf_sleep=>15,ora_taf_function=>'taf'})};
+ ok($@ =~ /You are attempting to enable TAF/, "'$@' expected! ");
+
+
+}
+else {
+ ok($dbh = DBI->connect($dsn, $dbuser, '',{ora_taf=>1,taf_sleep=>15,ora_taf_function=>'taf'}),"Well this is all I can test!");
+
+}
+
+$dbh->disconnect;
+#not much I can do with taf as I cannot really shut down somones server pephaps later
+
+1;
Modified: dbd-oracle/trunk/t/58object.t
==============================================================================
--- dbd-oracle/trunk/t/58object.t (original)
+++ dbd-oracle/trunk/t/58object.t Mon Apr 4 12:34:19 2011
@@ -82,9 +82,9 @@
or die $dbh->errstr;
$dbh->do(qq{ INSERT INTO $table VALUES (2, $sub_type(NULL, 'obj2',
TO_DATE('2004-11-30 14:27:18', 'YYYY-MM-DD HH24:MI:SS'),
- '12345.6789')) }
+ 12345.6789)) }
) or die $dbh->errstr;
-$dbh->do(qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL, '777.666')) }
+$dbh->do(qq{ INSERT INTO $table VALUES (3, $sub_type(5, 'obj3', NULL, 777.666)) }
) or die $dbh->errstr;
$dbh->do(qq{ CREATE OR REPLACE TYPE $inner_type AS OBJECT (
@@ -159,14 +159,14 @@
cmp_ok(ref $row2[1], 'eq', 'DBD::Oracle::Object', 'new: Row 2 column 2 is an DBD::Oracle::Object');
cmp_ok(uc $row2[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 2 column 2 object type");
is_deeply([$row2[1]->attributes], ['NUM', undef, 'NAME', 'obj2',
- 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', '12345.6789'], "new: Row 1 column 2 object attributes");
+ 'DATETIME', '2004-11-30T14:27:18', 'AMOUNT', 12345.6789], "new: Row 1 column 2 object attributes");
@row3 = $sth->fetchrow();
ok (scalar @row3, 'new: Fetch third row');
cmp_ok(ref $row3[1], 'eq', 'DBD::Oracle::Object', 'new: Row 3 column 2 is an DBD::Oracle::Object');
cmp_ok(uc $row3[1]->type_name, "eq", uc "$schema.$sub_type", "new: Row 3 column 2 object type");
is_deeply([$row3[1]->attributes], ['NUM', 5, 'NAME', 'obj3',
- 'DATETIME', undef, 'AMOUNT', '777.666'], "new: Row 1 column 2 object attributes");
+ 'DATETIME', undef, 'AMOUNT', 777.666], "new: Row 1 column 2 object attributes");
ok (!$sth->fetchrow(), 'new: No more rows expected');