Author: byterock
Date: Mon Jul 14 11:57:47 2008
New Revision: 11533
Modified:
dbd-oracle/trunk/Changes
dbd-oracle/trunk/Oracle.pm
dbd-oracle/trunk/Oracle.xs
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/ocitrace.h
dbd-oracle/trunk/t/10general.t
Log:
Changed the way Ping works rather than using prepare and execute it now makes
a single round trip call to DB also needed to remove two tests from 10general
that were looking for the error # thrown by the execute command. by John Scoles
Modified: dbd-oracle/trunk/Changes
==============================================================================
--- dbd-oracle/trunk/Changes (original)
+++ dbd-oracle/trunk/Changes Mon Jul 14 11:57:47 2008
@@ -1,4 +1,5 @@
=head1 Changes in DBD-Oracle 1.22(svn rev xxxx) 2008
+ Changed the way Ping works rather than using prepare and execute it now
makes a single round trip call to DB by John Scoles
Fix for rt.cpan.org Ticket #=37501 fail HP-UX Itanium 11.31 makefile also
added the OS and version to the output of the Makefile.PL for easier debugging.
from John Scoles and Rich Roemer
Added a number of internal functions for decoding OCI debug values from John
Scoles
Fix for hpux 11.23 linker error unrecognized argument on the Makefile from
someone on CPAN forum
Modified: dbd-oracle/trunk/Oracle.pm
==============================================================================
--- dbd-oracle/trunk/Oracle.pm (original)
+++ dbd-oracle/trunk/Oracle.pm Mon Jul 14 11:57:47 2008
@@ -76,6 +76,7 @@
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");
$drh;
}
@@ -277,18 +278,14 @@
$sth;
}
-
- sub ping {
+#Ah! I see you have the machine that goes PING!!
+ sub ping {
my($dbh) = @_;
my $ok = 0;
eval {
local $SIG{__DIE__};
local $SIG{__WARN__};
- # we know that Oracle 7 prepare does a describe so this will
- # actually talk to the server and is this a valid and cheap test.
- my $sth = $dbh->prepare("select SYSDATE from DUAL /* ping */");
- # But Oracle 8+ doesn't talk to server unless we describe the query
- $ok = $sth && $sth->FETCH('NUM_OF_FIELDS');
+ $ok=ora_ping($dbh);
};
return ($@) ? 0 : $ok;
}
Modified: dbd-oracle/trunk/Oracle.xs
==============================================================================
--- dbd-oracle/trunk/Oracle.xs (original)
+++ dbd-oracle/trunk/Oracle.xs Mon Jul 14 11:57:47 2008
@@ -123,6 +123,10 @@
ST(0) = (av) ? sv_2mortal(newRV((SV *)av)) : &PL_sv_undef;
}
+
+
+
+
void
ora_bind_param_inout_array(sth, param, av_ref, maxlen, attribs)
SV * sth
@@ -142,14 +146,14 @@
croak("Modification of a read-only value attempted");
if (attribs) {
if (SvNIOK(attribs)) {
- sql_type = SvIV(attribs);
- attribs = Nullsv;
- }
- else {
- SV **svp;
- DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
- DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type);
- }
+ sql_type = SvIV(attribs);
+ attribs = Nullsv;
+ }
+ else {
+ SV **svp;
+ DBD_ATTRIBS_CHECK("bind_param", sth, attribs);
+ DBD_ATTRIB_GET_IV(attribs, "ora_type",4, svp, sql_type);
+ }
}
ST(0) = dbd_bind_ph(sth, imp_sth, param,av_value, sql_type, attribs, TRUE,
maxlen)
? &sv_yes : &sv_no;
@@ -234,6 +238,30 @@
MODULE = DBD::Oracle PACKAGE = DBD::Oracle::db
+
+void
+ora_ping(dbh)
+ SV *dbh
+ PREINIT:
+ D_imp_dbh(dbh);
+ sword status;
+ text buf[2];
+ CODE:
+ /*simply does a call to OCIServerVersion which should make 1 round
trip*/
+ /*later I will replace this with the actual OCIPing command*/
+ /*This will work if the DB goes down, /*
+ /*If the listener goes down it is another case as the Listener is needed
to establish the connection not maintain it*/
+ /*so we should stay connected but we cannot get nay new connections*/
+ {
+
OCIServerVersion_log_stat(imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
+ if (status != OCI_SUCCESS){
+ XSRETURN_IV(0);
+ } else {
+ XSRETURN_IV(1);
+ }
+}
+
+
void
reauthenticate(dbh, uid, pwd)
SV * dbh
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Mon Jul 14 11:57:47 2008
@@ -435,7 +435,7 @@
imp_dbh->get_oci_handle = oci_db_handle;
- if (DBIS->debug >= 6 || dbd_verbose >= 6)
+ if (DBIS->debug >= 6 || dbd_verbose >= 7)
dump_env_to_trace();
if ((svp=DBD_ATTRIB_GET_SVP(attr, "ora_envhp", 9)) && SvOK(*svp)) {
@@ -742,6 +742,7 @@
OCIHandleFree_log_stat(imp_dbh->srvhp,
OCI_HTYPE_SERVER, status);
OCIHandleFree_log_stat(imp_dbh->svchp,
OCI_HTYPE_SVCCTX, status);
OCIHandleFree_log_stat(imp_dbh->errhp,
OCI_HTYPE_ERROR, status);
+ OCIHandleFree_log_stat(imp_dbh->envhp,
OCI_HTYPE_ENV, status);
return 0;
}
OCIAttrSet_log_stat( imp_dbh->svchp, OCI_HTYPE_SVCCTX,
imp_dbh->srvhp,
@@ -769,6 +770,8 @@
OCIHandleFree_log_stat(imp_dbh->srvhp,
OCI_HTYPE_SERVER, status);
OCIHandleFree_log_stat(imp_dbh->errhp,
OCI_HTYPE_ERROR, status);
OCIHandleFree_log_stat(imp_dbh->svchp,
OCI_HTYPE_SVCCTX, status);
+ OCIHandleFree_log_stat(imp_dbh->envhp,
OCI_HTYPE_ENV, status);
+
return 0;
}
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Mon Jul 14 11:57:47 2008
@@ -36,6 +36,15 @@
If done well the log will read like a compilable program.
*/
+
+
+#define OCIServerVersion_log_stat(sc,errhp,b,bl,ht,stat)\
+ stat =OCIServerVersion(sc,errhp,b,bl,ht);\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sCIServerVersion_log_stat(%p,%s)=%s\n",\
+ OciTp, sc,b,oci_status_name(stat)),stat \
+ : stat
#define
OCIStmtGetPieceInfo_log_stat(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece,stat)\
stat
=OCIStmtGetPieceInfo(stmhp,errhp,hdlptr,hdltyp,in_out,iter,idx,piece);\
(DBD_OCI_TRACEON) \
Modified: dbd-oracle/trunk/t/10general.t
==============================================================================
--- dbd-oracle/trunk/t/10general.t (original)
+++ dbd-oracle/trunk/t/10general.t Mon Jul 14 11:57:47 2008
@@ -13,7 +13,7 @@
$| = 1;
-plan tests => 33;
+plan tests => 31;
my $dsn = oracle_test_dsn();
my $dbuser = $ENV{ORACLE_USERID} || 'scott/tiger';
@@ -95,8 +95,6 @@
# ---
ok( $dbh->ping);
-ok(!$ora_errno); # ora_errno reset ok
-ok(!$DBI::err); # DBI::err reset ok
$dbh->disconnect;
$dbh->{PrintError} = 0;
