[svn:dbd-oracle] r14594 - in dbd-oracle/trunk: . t
[email protected] Sat, 18 Dec 2010 16:40:10 -0800 (PST)
| Newsgroups | perl.dbd.oracle.changes |
|---|---|
| Message-ID | <[email protected]> |
Author: byterock
Date: Sat Dec 18 16:40:10 2010
New Revision: 14594
Modified:
dbd-oracle/trunk/Oracle.xs
dbd-oracle/trunk/dbdimp.c
dbd-oracle/trunk/dbdimp.h
dbd-oracle/trunk/oci8.c
dbd-oracle/trunk/ocitrace.h
dbd-oracle/trunk/t/28array_bind.t
Log:
Fix for OCIPing in case where a 10 client tries to ping a <10 DB from Tim Oertel
Fix for DBD-Oracle stored proc with array bug where second call array size is unchanged from Tim Oertel
Modified: dbd-oracle/trunk/Oracle.xs
==============================================================================
--- dbd-oracle/trunk/Oracle.xs (original)
+++ dbd-oracle/trunk/Oracle.xs Sat Dec 18 16:40:10 2010
@@ -263,10 +263,12 @@
PREINIT:
D_imp_dbh(dbh);
sword status;
-#if !defined(ORA_OCI_102)
- text buf[2];
+#if defined(ORA_OCI_102)
+ ub4 vernum;
#endif
+ text buf[2];
CODE:
+ /*when OCIPing not available,*/
/*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, */
@@ -276,7 +278,13 @@
#if !defined(ORA_OCI_102)
OCIServerVersion_log_stat(imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
#else
+ vernum = ora_db_version(dbh,imp_dbh);
+ /* OCIPing causes server failures if called against server ver < 10.2 */
+ if (((int)((vernum>>24) & 0xFF) < 10 ) || (((int)((vernum>>24) & 0xFF) == 10 ) && ((int)((vernum>>20) & 0x0F) < 2 ))){
+ OCIServerVersion_log_stat(imp_dbh->svchp,imp_dbh->errhp,buf,2,OCI_HTYPE_SVCCTX,status);
+ } else {
OCIPing_log_stat(imp_dbh->svchp,imp_dbh->errhp,status);
+ }
#endif
if (status != OCI_SUCCESS){
XSRETURN_IV(0);
Modified: dbd-oracle/trunk/dbdimp.c
==============================================================================
--- dbd-oracle/trunk/dbdimp.c (original)
+++ dbd-oracle/trunk/dbdimp.c Sat Dec 18 16:40:10 2010
@@ -408,7 +408,7 @@
if (DBD_ATTRIB_TRUE(attr,"ora_drcp_incr",13,svp))
DBD_ATTRIB_GET_IV( attr, "ora_drcp_incr", 13, svp, imp_dbh->pool_incr);
#endif /*ORA_OCI_112*/
-
+ 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);
@@ -1625,6 +1625,7 @@
int flag_data_is_utf8=0;
int need_allocate_rows;
int buflen;
+ int numarrayentries;
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
croak("dbd_rebind_ph_varchar2_table(): bad bind variable. ARRAY reference required, but got %s for '%s'.",
neatsvpv(phs->sv,0), phs->name);
@@ -1638,9 +1639,9 @@
/* If no number of entries to bind specified,
* set phs->array_numstruct to the scalar(@array) bound.
*/
- if( phs->array_numstruct <= 0 ){
/* av_len() returns last array index, or -1 is array is empty */
- int numarrayentries=av_len( arr );
+ numarrayentries=av_len( arr );
+
if( numarrayentries >= 0 ){
phs->array_numstruct = numarrayentries+1;
if (trace_level >= 2 || dbd_verbose >= 3 ){
@@ -1648,7 +1649,6 @@
phs->array_numstruct);
}
}
- }
/* Fix charset */
csform = phs->csform;
if (trace_level >= 2 || dbd_verbose >= 3 ){
@@ -2011,6 +2011,7 @@
AV *arr;
int need_allocate_rows;
int buflen;
+ int numarrayentries;
/*int flag_data_is_utf8=0;*/
if( ( ! SvROK(phs->sv) ) || (SvTYPE(SvRV(phs->sv))!=SVt_PVAV) ) { /* Allow only array binds */
@@ -2034,20 +2035,19 @@
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): array_numstruct=%d\n",
phs->array_numstruct);
}
- /* If no number of entries to bind specified,
- * set phs->array_numstruct to the scalar(@array) bound.
- */
- if( phs->array_numstruct <= 0 ){
-/* av_len() returns last array index, or -1 is array is empty */
- int numarrayentries=av_len( arr );
- if( numarrayentries >= 0 ){
- phs->array_numstruct = numarrayentries+1;
- if (trace_level >= 2 || dbd_verbose >= 3 ){
+ /* If no number of entries to bind specified,*/
+ /* set phs->array_numstruct to the scalar(@array) bound.*/
+ /* av_len() returns last array index, or -1 is array is empty */
+ numarrayentries=av_len( arr );
+
+ if( numarrayentries >= 0 ){
+ phs->array_numstruct = numarrayentries+1;
+ if (trace_level >= 2 || dbd_verbose >= 3 ){
PerlIO_printf(DBILOGFP, "dbd_rebind_ph_number_table(): array_numstruct=%d (calculated) \n",
phs->array_numstruct);
- }
}
}
+
/* Calculate each bound structure maxlen.
* maxlen(int) = sizeof(int);
* maxlen(double) = sizeof(double);
@@ -3055,8 +3055,24 @@
if( (phs->ftype == ORA_VARCHAR2_TABLE) ||
(phs->ftype == ORA_NUMBER_TABLE) ||
(phs->ftype == 1)) /*ORA_VARCHAR2*/ {
- /* Supported */
- }else{
+ /* Supported */
+
+ /* Reload array-size-related attributes */
+ if (attribs) {
+ SV **svp;
+
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxdata_size", 16, 0)) != NULL) {
+ phs->maxdata_size = SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_maxarray_numentries", 23, 0)) != NULL) {
+ phs->ora_maxarray_numentries=SvUV(*svp);
+ }
+ if ( (svp=hv_fetch((HV*)SvRV(attribs), "ora_internal_type", 17, 0)) != NULL) {
+ phs->ora_internal_type=SvUV(*svp);
+ }
+ }
+ }
+ else{
/* All the other types are not supported */
croak("Array bind is supported only for ORA_%%_TABLE types. Unable to bind '%s'.",phs->name);
}
@@ -3315,8 +3331,8 @@
SV *sv = phs->sv;
if (debug >= 2 || dbd_verbose >= 3 ) {
PerlIO_printf(DBILOGFP,
- "dbd_st_execute(): Analyzing inout parameter '%s of type=%d'\n",
- phs->name,phs->ftype);
+ "dbd_st_execute(): Analyzing inout a parameter '%s of type=%d name=%s'\n",
+ phs->name,phs->ftype,sql_typecode_name(phs->ftype));
}
if( phs->ftype == ORA_VARCHAR2_TABLE ){
dbd_phs_ora_varchar2_table_fixup_after_execute(phs);
Modified: dbd-oracle/trunk/dbdimp.h
==============================================================================
--- dbd-oracle/trunk/dbdimp.h (original)
+++ dbd-oracle/trunk/dbdimp.h Sat Dec 18 16:40:10 2010
@@ -60,7 +60,7 @@
int parse_error_offset; /* position in statement of last error */
int max_nested_cursors; /* limit on cached nested cursors per stmt */
int array_chunk_size; /* the max size for an array bind */
-
+ ub4 server_version; /* version of Oracle server */
};
#define DBH_DUP_OFF sizeof(dbih_dbc_t)
@@ -370,7 +370,7 @@
void fb_ary_free(fb_ary_t *fb_ary);
void rs_array_init(imp_sth_t *imp_sth);
-
+ub4 ora_db_version _((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 Sat Dec 18 16:40:10 2010
@@ -24,6 +24,7 @@
+
void
dbd_init_oci(dbistate_t *dbistate)
{
@@ -4507,3 +4508,26 @@
imp_sth->lob_refetch = NULL;
}
+ub4
+ora_db_version(SV *dbh, imp_dbh_t *imp_dbh)
+{
+ dTHX;
+ sword status;
+ text buf[2];
+ ub4 vernum;
+
+ if( imp_dbh->server_version > 0 ) {
+ return imp_dbh->server_version;
+ }
+
+
+ /* XXX should possibly create new session before ending the old so */
+ /* that if the new one can't be created, the old will still work. */
+ OCIServerRelease_log_stat(imp_dbh->svchp, imp_dbh->errhp, buf, 2,OCI_HTYPE_SVCCTX, &vernum , status);
+ if (status != OCI_SUCCESS) {
+ oci_error(dbh, imp_dbh->errhp, status, "OCISessionServerRelease");
+ return 0;
+ }
+ imp_dbh->server_version = vernum;
+ return vernum;
+}
\ No newline at end of file
Modified: dbd-oracle/trunk/ocitrace.h
==============================================================================
--- dbd-oracle/trunk/ocitrace.h (original)
+++ dbd-oracle/trunk/ocitrace.h Sat Dec 18 16:40:10 2010
@@ -36,6 +36,13 @@
If done well the log will read like a compilable program.
*/
+#define OCIServerRelease_log_stat(sc,errhp,b,bl,ht,ver,stat)\
+ stat =OCIServerRelease(sc,errhp,b,bl,ht,ver);\
+ (DBD_OCI_TRACEON) \
+ ? PerlIO_printf(DBD_OCI_TRACEFP,\
+ "%sOCIServerRelease(%p)=%s\n",\
+ OciTp, sc,oci_status_name(stat)),stat \
+ : stat
#define OCISessionRelease_log_stat(svchp, errhp,stat)\
stat =OCISessionRelease(svchp, errhp, NULL, (ub4)0, OCI_DEFAULT);\
@@ -44,6 +51,7 @@
"%sOCISessionRelease(svchp=%p)=%s\n",\
OciTp, svchp,oci_status_name(stat)),stat \
: stat
+
#define OCISessionPoolDestroy_log_stat(ph, errhp,stat )\
stat =OCISessionPoolDestroy(ph, errhp,OCI_DEFAULT);\
(DBD_OCI_TRACEON) \
Modified: dbd-oracle/trunk/t/28array_bind.t
==============================================================================
--- dbd-oracle/trunk/t/28array_bind.t (original)
+++ dbd-oracle/trunk/t/28array_bind.t Sat Dec 18 16:40:10 2010
@@ -234,15 +234,57 @@
$dbh->do("drop sequence seq_array_in_out_test") or die $dbh->errstr;
}
+
+sub test_number_SP($){
+ my $dbh=shift;
+ $dbh->do("
+ create or replace procedure tox_test_proc0(
+ result in out varchar2,
+ ids in SYS.dbms_sql.number_table
+ )
+ as
+ begin
+ result := '';
+ for i in 1..ids.count loop
+ result := result || to_char(ids(i));
+ end loop;
+ end;
+
+
+
+ ");
+
+ my $sth = $dbh->prepare("begin tox_test_proc0( ?, ?); end;");
+
+
+ my $result = "";
+ my @array = (1, 2, 3, 4, 7);
+
+ $sth->bind_param_inout(1, \$result, 5);
+ ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 12345');
+ $sth->execute() ;
+ cmp_ok($result, '==','12347' , '... we should have 12347 out string');
+
+ @array = (3, 4, 5);
+
+ $sth->bind_param_inout(1, \$result, 3);
+ ok ($sth->bind_param(2, \@array, { ora_type => ORA_NUMBER_TABLE, ora_internal_type => SQLT_INT }),'... bind_param_inout_array should bind 345');
+ $sth->execute() ;
+ cmp_ok($result, '==','345' , '... we should have 345 out string');
+
+ $dbh->do("drop procedure tox_test_proc0") or warn $dbh->errstr;
+
+}
SKIP: {
$dbh = db_connect(0);
plan skip_all => "Not connected to oracle" if not $dbh;
- plan tests => 15;
+ plan tests => 19;
test_varchar2_table_3_tests($dbh);
test_number_table_3_tests($dbh);
test_inout_array_tests($dbh);
+ test_number_SP($dbh);
};