--- Oracle.pm Fri Aug 31 18:27:17 2001 +++ /mnt/wing1/Perl58r2/msrc/DBD-Oracle-1.12.share/Oracle.pm Mon Jul 8 09:25:20 2002 @@ -42,6 +42,10 @@ $errstr = ""; # holds error string for DBI::errstr (XXX SHARED!) $drh = undef; # holds driver handle once initialised + sub CLONE { + $drh = undef ; + } + sub driver{ return $drh if $drh; my($class, $attr) = @_; @@ -58,6 +62,7 @@ 'Errstr' => \$DBD::Oracle::errstr, 'Attribution' => "DBD::Oracle $VERSION using OCI$oci by Tim Bunce", }); + DBD::Oracle::dr::init_oci($drh) ; $drh; } @@ -844,6 +849,18 @@ DBI->connect($dsn, $user, $passwd, { ora_module_name => $0 }); +=item ora_dbh_share + +Needs at least Perl 5.8.0 compiled with ithreads. Allows to share database +connections between threads. The first connect will make the connection, +all following calls to connect with the same ora_dbh_share attribute +will use the same database connection. The value must be a reference +to a already shared scalar which is initialized to an empty string. + + our $orashr : shared = '' ; + + $dbh = DBI -> connect ($dsn, $user, $passwd, {ora_dbh_share => \$orashr}) ; + =back =head1 Metadata --- Oracle.xs Wed Aug 29 21:39:12 2001 +++ /mnt/wing1/Perl58r2/msrc/DBD-Oracle-1.12.share/Oracle.xs Fri Jul 5 23:30:48 2002 @@ -105,3 +106,16 @@ CODE: D_imp_dbh(dbh); ST(0) = ora_db_reauthenticate(dbh, imp_dbh, uid, pwd) ? &sv_yes : &sv_no; + + +MODULE = DBD::Oracle PACKAGE = DBD::Oracle::dr + +void +init_oci(drh) + SV * drh + CODE: + D_imp_drh(drh); + dbd_init_oci(DBIS) ; + dbd_init_oci_drh(imp_drh) ; + + \ No newline at end of file --- dbdimp.c Wed Aug 29 21:39:15 2001 +++ /mnt/wing1/Perl58r2/msrc/DBD-Oracle-1.12.share/dbdimp.c Mon Jul 8 08:46:40 2002 @@ -22,6 +22,7 @@ DBISTATE_DECLARE; int ora_fetchtest; +int ora_initdone ; static int ora_login_nomsg; /* don't fetch real login errmsg if true */ static int ora_sigchld_restart = 1; @@ -82,14 +83,14 @@ int i; int aidx; /* array index */ { - FILE *fp = DBILOGFP; - fprintf(fp, " fbh %d: '%s'\t%s, ", + PerlIO *fp = DBILOGFP; + PerlIO_printf(fp, " fbh %d: '%s'\t%s, ", i, fbh->name, (fbh->nullok) ? "NULLable" : "NO null "); - fprintf(fp, "otype %3d->%3d, dbsize %ld/%ld, p%d.s%d\n", + PerlIO_printf(fp, "otype %3d->%3d, dbsize %ld/%ld, p%d.s%d\n", fbh->dbtype, fbh->ftype, (long)fbh->dbsize,(long)fbh->disize, fbh->prec, fbh->scale); if (fbh->fb_ary) { - fprintf(fp, " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n", + PerlIO_printf(fp, " out: ftype %d, bufl %d. indp %d, rlen %d, rcode %d\n", fbh->ftype, fbh->fb_ary->bufl, fbh->fb_ary->aindp[aidx], fbh->fb_ary->arlen[aidx], fbh->fb_ary->arcode[aidx]); } @@ -177,6 +178,16 @@ } +/* from shared.xs */ +typedef struct { + SV *sv; /* The actual SV - in shared space */ + /* we don't need the following two */ + /*recursive_lock_t lock; */ + /*perl_cond user_cond;*/ /* For user-level conditions */ +} shared_sv; + + + int dbd_db_login6(dbh, imp_dbh, dbname, uid, pwd, attr) SV *dbh; @@ -188,9 +199,57 @@ { dTHR; sword status; + SV ** shared_dbh_priv_svp ; + SV * shared_dbh_priv_sv ; + shared_sv * shared_dbh_ssv = NULL ; + imp_dbh_t * shared_dbh = NULL ; + STRLEN shared_dbh_len = 0 ; + D_imp_drh_from_dbh; + +#ifdef USE_ITHREADS + shared_dbh_priv_svp = (DBD_ATTRIB_OK(attr)?hv_fetch((HV*)SvRV(attr), "ora_dbh_share", 13, 0):NULL) ; + shared_dbh_priv_sv = shared_dbh_priv_svp?*shared_dbh_priv_svp:NULL ; + + if (shared_dbh_priv_sv && SvROK(shared_dbh_priv_sv)) + shared_dbh_priv_sv = SvRV(shared_dbh_priv_sv) ; + + if (shared_dbh_priv_sv) { + MAGIC * mg ; + + SvLOCK (shared_dbh_priv_sv) ; + + /* some magic from shared.xs (no public api yet :-( */ + mg = mg_find(shared_dbh_priv_sv, PERL_MAGIC_shared_scalar) ; + + shared_dbh_ssv = (shared_sv * )(mg?mg -> mg_ptr:NULL) ; /*sharedsv_find(*shared_dbh_priv_sv) ;*/ + if (!shared_dbh_ssv) + croak ("value of ora_dbh_share must be a scalar that is shared") ; + + shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ; + shared_dbh_len = SvCUR((shared_dbh_ssv -> sv)) ; + if (shared_dbh_len > 0 && shared_dbh_len != sizeof (imp_dbh_t)) + croak ("Invalid value for ora_dbh_dup") ; + + if (shared_dbh_len == sizeof (imp_dbh_t)) { + /* initialize from shared data */ + int o = DBH_DUP_OFF ; + int l = DBH_DUP_LEN ; + memcpy (((char *)imp_dbh) + DBH_DUP_OFF, ((char *)shared_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ; + //Move (((char *)shared_dbh) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN, char *) ; + shared_dbh -> refcnt++ ; +#ifdef OCI_V8_SYNTAX + imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ; + imp_dbh -> shared_dbh = shared_dbh ; + if (DBIS->debug >= 2) + PerlIO_printf(DBILOGFP, " dbd_db_login: use shared Oracle database handles.\n"); +#endif + } else { + shared_dbh = NULL ; + } + } +#endif #ifdef OCI_V8_SYNTAX - D_imp_drh_from_dbh; imp_dbh->get_oci_handle = oci_db_handle; @@ -203,12 +262,18 @@ ub4 init_mode = OCI_OBJECT; SV **init_mode_sv; DBD_ATTRIB_GET_IV(attr, "ora_init_mode",13, init_mode_sv, init_mode); +#ifdef USE_ITHREADS + init_mode |= OCI_OBJECT | OCI_THREADED ; +#endif + + if (!ora_initdone++) { OCIInitialize_log_stat(init_mode, 0, 0,0,0, status); if (status != OCI_SUCCESS) { oci_error(dbh, NULL, status, "OCIInitialize. Check ORACLE_HOME and NLS settings etc."); return 0; } + } OCIEnvInit_log_stat( &imp_drh->envhp, OCI_DEFAULT, 0, 0, status); if (status != OCI_SUCCESS) { oci_error(dbh, (OCIError*)imp_dbh->envhp, status, "OCIEnvInit"); @@ -218,6 +283,7 @@ imp_dbh->envhp = imp_drh->envhp; OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->errhp, OCI_HTYPE_ERROR, status); + if (!shared_dbh) { OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->srvhp, OCI_HTYPE_SERVER, status); OCIHandleAlloc_ok(imp_dbh->envhp, &imp_dbh->svchp, OCI_HTYPE_SVCCTX, status); @@ -256,7 +322,7 @@ OCIAttrSet_log_stat(imp_dbh->svchp, (ub4) OCI_HTYPE_SVCCTX, imp_dbh->authp, (ub4) 0, (ub4) OCI_ATTR_SESSION, imp_dbh->errhp, status); - + } #else if (DBIS->debug >= 6 ) dump_env_to_trace(); @@ -324,7 +390,7 @@ warn("dbd_db_login: sigaction errno %d, handler %lx, flags %lx", errno,act.sa_handler,act.sa_flags); if (DBIS->debug >= 2) - fprintf(DBILOGFP, " dbd_db_login: set SA_RESTART on Oracle SIGCLD handler.\n"); + PerlIO_printf(DBILOGFP, " dbd_db_login: set SA_RESTART on Oracle SIGCLD handler.\n"); } } #endif /* HAS_SIGACTION */ @@ -334,6 +400,21 @@ DBIc_IMPSET_on(imp_dbh); /* imp_dbh set up now */ DBIc_ACTIVE_on(imp_dbh); /* call disconnect before freeing */ imp_dbh->ph_type = 1; + +#ifdef USE_ITHREADS + if (shared_dbh_ssv && !shared_dbh) { + SvUPGRADE(shared_dbh_priv_sv, SVt_PV) ; + SvGROW(shared_dbh_priv_sv, sizeof(imp_dbh_t) + 1) ; + SvCUR (shared_dbh_priv_sv) = sizeof(imp_dbh_t) ; + imp_dbh -> refcnt = 1 ; + imp_dbh -> shared_dbh_priv_sv = shared_dbh_priv_sv ; + memcpy (SvPVX(shared_dbh_priv_sv) + DBH_DUP_OFF, ((char *)imp_dbh) + DBH_DUP_OFF, DBH_DUP_LEN) ; + SvSETMAGIC(shared_dbh_priv_sv) ; + shared_dbh = (imp_dbh_t *)SvPVX(shared_dbh_ssv -> sv) ; + imp_dbh -> shared_dbh = shared_dbh ; + } +#endif + return 1; } @@ -410,6 +491,14 @@ imp_dbh_t *imp_dbh; { dTHR; + int refcnt = 1 ; + +#ifdef USE_ITHREADS + if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) { + SvLOCK (imp_dbh->shared_dbh_priv_sv) ; + refcnt = imp_dbh -> shared_dbh -> refcnt ; + } +#endif /* We assume that disconnect will always work */ /* since most errors imply already disconnected. */ @@ -419,7 +508,7 @@ /* See DBI Driver.xst file for the DBI approach. */ #ifdef OCI_V8_SYNTAX - { + if (refcnt == 1) { sword s_se, s_sd; OCISessionEnd_log_stat(imp_dbh->svchp, imp_dbh->errhp, imp_dbh->authp, OCI_DEFAULT, s_se); @@ -447,6 +536,17 @@ SV *dbh; imp_dbh_t *imp_dbh; { + dTHX ; + int refcnt = 1 ; + +#ifdef USE_ITHREADS + if (DBIc_IMPSET(imp_dbh) && imp_dbh->shared_dbh) { + SvLOCK (imp_dbh->shared_dbh_priv_sv) ; + refcnt = imp_dbh -> shared_dbh -> refcnt-- ; + } +#endif + + if (refcnt == 1) { if (DBIc_ACTIVE(imp_dbh)) dbd_db_disconnect(dbh, imp_dbh); #ifdef OCI_V8_SYNTAX @@ -454,11 +554,16 @@ OCIHandleFree_log_stat(imp_dbh->authp, OCI_HTYPE_SESSION,status); 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); } #else /* Nothing in imp_dbh to be freed */ #endif + } +#ifdef OCI_V8_SYNTAX + { sword status; /* error handle is not shared, so always free it */ + OCIHandleFree_log_stat(imp_dbh->errhp, OCI_HTYPE_ERROR, status); + } +#endif DBIc_IMPSET_off(imp_dbh); } @@ -664,7 +769,7 @@ if (imp_sth->all_params_hv) { DBIc_NUM_PARAMS(imp_sth) = (int)HvKEYS(imp_sth->all_params_hv); if (DBIS->debug >= 2) - fprintf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", + PerlIO_printf(DBILOGFP, " dbd_preparse scanned %d distinct placeholders\n", (int)DBIc_NUM_PARAMS(imp_sth)); } } @@ -780,12 +885,12 @@ if (DBIS->debug >= 2) { char *val = neatsvpv(phs->sv,0); - fprintf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val); + PerlIO_printf(DBILOGFP, " bind %s <== %.1000s (", phs->name, val); if (!SvOK(phs->sv)) - fprintf(DBILOGFP, "NULL, "); - fprintf(DBILOGFP, "size %ld/%ld/%ld, ", + PerlIO_printf(DBILOGFP, "NULL, "); + PerlIO_printf(DBILOGFP, "size %ld/%ld/%ld, ", (long)SvCUR(phs->sv),(long)SvLEN(phs->sv),phs->maxlen); - fprintf(DBILOGFP, "ptype %d, otype %d%s)\n", + PerlIO_printf(DBILOGFP, "ptype %d, otype %d%s)\n", (int)SvTYPE(phs->sv), phs->ftype, (phs->is_inout) ? ", inout" : ""); } @@ -848,7 +953,7 @@ #endif if (DBIS->debug >= 3) { - fprintf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d, at_exec %d)\n", + PerlIO_printf(DBILOGFP, " bind %s <== '%.*s' (size %ld/%ld, otype %d, indp %d, at_exec %d)\n", phs->name, (int)(phs->alen>SvIV(DBIS->neatsvpvlen) ? SvIV(DBIS->neatsvpvlen) : phs->alen), (phs->progv) ? phs->progv : "", @@ -874,7 +979,7 @@ sword status; if (dbis->debug >= 3) - fprintf(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); + 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, (text*)phs->name, strlen(phs->name), @@ -892,7 +997,7 @@ return 0; } if (dbis->debug >= 3) - fprintf(DBILOGFP, " pp_rebind_ph_rset_in: END\n"); + PerlIO_printf(DBILOGFP, " pp_rebind_ph_rset_in: END\n"); return 2; } #endif @@ -908,7 +1013,7 @@ HV *init_attr = newHV(); int count; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name); + PerlIO_printf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name); #ifdef OCI_V8_SYNTAX { sword status; @@ -972,7 +1077,7 @@ FREETMPS; LEAVE; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - allocated %s...\n", + PerlIO_printf(DBILOGFP, " bind %s - allocated %s...\n", phs->name, neatsvpv(phs->sv, 0)); } @@ -982,7 +1087,7 @@ D_impdata(imp_sth_csr, imp_sth_t, sth_csr); if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - initialising new %s for cursor 0x%lx...\n", + PerlIO_printf(DBILOGFP, " bind %s - initialising new %s for cursor 0x%lx...\n", phs->name, neatsvpv(sth_csr,0), (unsigned long)phs->progv); #ifdef OCI_V8_SYNTAX @@ -1031,7 +1136,7 @@ assert(phs->ftype == 102); phs->out_prepost_exec = pp_exec_rset; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s to cursor (at execute)\n", phs->name); + PerlIO_printf(DBILOGFP, " bind %s to cursor (at execute)\n", phs->name); return 2; } #endif @@ -1068,7 +1173,7 @@ if (done != 1) { if (done == 2) { /* the rebind did the OCI bind call itself successfully */ if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s done with ftype %d\n", + PerlIO_printf(DBILOGFP, " bind %s done with ftype %d\n", phs->name, phs->ftype); return 1; } @@ -1129,7 +1234,7 @@ #endif phs->maxlen_bound = phs->maxlen ? phs->maxlen : 1; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s done with ftype %d\n", + PerlIO_printf(DBILOGFP, " bind %s done with ftype %d\n", phs->name, phs->ftype); return 1; } @@ -1176,14 +1281,14 @@ croak("Can't bind ``lvalue'' mode scalar as inout parameter (currently)"); if (DBIS->debug >= 2) { - fprintf(DBILOGFP, " bind %s <== %s (type %ld", + PerlIO_printf(DBILOGFP, " bind %s <== %s (type %ld", name, neatsvpv(newvalue,0), (long)sql_type); if (is_inout) - fprintf(DBILOGFP, ", inout 0x%lx, maxlen %ld", + PerlIO_printf(DBILOGFP, ", inout 0x%lx, maxlen %ld", (long)newvalue, (long)maxlen); if (attribs) - fprintf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0)); - fprintf(DBILOGFP, ")\n"); + PerlIO_printf(DBILOGFP, ", attribs: %s", neatsvpv(attribs,0)); + PerlIO_printf(DBILOGFP, ")\n"); } phs_svp = hv_fetch(imp_sth->all_params_hv, name, name_len, 0); @@ -1280,7 +1385,7 @@ SvCUR_set(sv, phs->alen); *SvEND(sv) = '\0'; if (debug >= 2) - fprintf(DBILOGFP, " out %s = %s (arcode %d, ind %d, len %d)\n", + PerlIO_printf(DBILOGFP, " out %s = %s (arcode %d, ind %d, len %d)\n", phs->name, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen); } else @@ -1289,7 +1394,7 @@ SvCUR(sv) = phs->alen; *SvEND(sv) = '\0'; if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " out %s = %s\t(TRUNCATED from %d to %ld, arcode %d)\n", phs->name, neatsvpv(sv,0), phs->indp, (long)phs->alen, phs->arcode); } @@ -1297,7 +1402,7 @@ if (phs->indp == -1) { /* is NULL */ (void)SvOK_off(phs->sv); if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " out %s = undef (NULL, arcode %d)\n", phs->name, phs->arcode); } @@ -1312,7 +1417,7 @@ SV *sv = *av_fetch(av, index, 1); dbd_phs_sv_complete(phs, sv, 0); if (debug >= 2) - fprintf(DBILOGFP, " out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n", + PerlIO_printf(DBILOGFP, " out '%s'[%ld] = %s (arcode %d, ind %d, len %d)\n", phs->name, (long)index, neatsvpv(sv,0), phs->arcode, phs->indp, phs->alen); } @@ -1336,7 +1441,7 @@ int is_select = (imp_sth->stmt_type == OCI_STMT_SELECT); if (debug >= 2) - fprintf(DBILOGFP, " dbd_st_execute %s (out%d, lob%d)...\n", + 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); #else @@ -1346,7 +1451,7 @@ return -2; /* dbd_describe already called ora_error() */ } if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " dbd_st_execute (for sql f%d after oci f%d, out%d)...\n", imp_sth->cda->ft, imp_sth->cda->fc, outparams); #endif @@ -1372,7 +1477,7 @@ else if (SvTYPE(sv) == SVt_RV && SvTYPE(SvRV(sv)) == SVt_PVAV) { if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " with %s = [] (len %ld/%ld, indp %d, otype %d, ptype %d)\n", phs->name, (long)phs->alen, (long)phs->maxlen, phs->indp, @@ -1396,7 +1501,7 @@ ub2 prev_alen = phs->alen; phs->alen = (SvOK(sv)) ? SvCUR(sv) + phs->alen_incnull : 0+phs->alen_incnull; if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " with %s = '%.*s' (len %ld(%ld)/%ld, indp %d, otype %d, ptype %d)\n", phs->name, (int)phs->alen, (phs->indp == -1) ? "" : SvPVX(sv), @@ -1434,7 +1539,7 @@ if (debug >= 2) { ub2 sqlfncode; OCIAttrGet_stmhp_stat(imp_sth, &sqlfncode, 0, OCI_ATTR_SQLFNCODE, status); - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " dbd_st_execute %s returned (%s, rpc%ld, fn%d, out%d)\n", oci_stmt_type_name(imp_sth->stmt_type), oci_status_name(status), @@ -1490,7 +1595,7 @@ row_count = imp_sth->cda->rpc; if (debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " dbd_st_execute complete (rc%d, w%02x, rpc%ld, eod%d, out%d)\n", imp_sth->cda->rc, imp_sth->cda->wrn, (long)row_count, imp_sth->eod_errno, @@ -1575,7 +1680,7 @@ #endif if (DBIS->debug >= 3) - fprintf(DBILOGFP, + 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); @@ -1710,6 +1815,7 @@ D_imp_dbh_from_sth; int fields; int i; + dTHX ; #ifdef OCI_V8_SYNTAX { @@ -1932,15 +2038,15 @@ static void dump_env_to_trace() { - FILE *fp = DBILOGFP; + PerlIO *fp = DBILOGFP; int i = 0; char *p; #ifndef __BORLANDC__ extern char **environ; #endif - fprintf(fp, "Environment variables:\n"); + PerlIO_printf(fp, "Environment variables:\n"); do { p = (char*)environ[i++]; - fprintf(fp,"\t%s\n",p); + PerlIO_printf(fp,"\t%s\n",p); } while ((char*)environ[i] != '\0'); } --- dbdimp.h Thu Aug 30 17:48:50 2001 +++ /mnt/wing1/Perl58r2/msrc/DBD-Oracle-1.12.share/dbdimp.h Fri Jul 5 19:10:08 2002 @@ -79,6 +79,10 @@ #ifdef OCI_V8_SYNTAX OCIEnv *envhp; #endif + SV *ora_long; + SV *ora_trunc; + SV *ora_cache; + SV *ora_cache_o; /* for ora_open() cache override */ }; @@ -86,6 +90,12 @@ struct imp_dbh_st { dbih_dbc_t com; /* MUST be first element in structure */ +#ifdef USE_ITHREADS + int refcnt ; /* keep track of duped handles. MUST be first after com */ + struct imp_dbh_st * shared_dbh ; /* pointer to shared space from which to dup and keep refcnt */ + SV * shared_dbh_priv_sv ; +#endif + #ifdef OCI_V8_SYNTAX void *(*get_oci_handle) _((imp_dbh_t *imp_dbh, int handle_type, int flags)); OCIEnv *envhp; /* copy of drh pointer */ @@ -102,8 +112,12 @@ int RowCacheSize; int ph_type; /* default oratype for placeholders */ + }; +#define DBH_DUP_OFF sizeof(dbih_dbc_t) +#define DBH_DUP_LEN (sizeof(struct imp_dbh_st) - sizeof(dbih_dbc_t)) + typedef struct lob_refetch_st lob_refetch_t; @@ -310,3 +324,4 @@ #define dbd_bind_ph ora_bind_ph /* end */ + --- oci8.c Fri Aug 31 17:55:05 2001 +++ /mnt/wing1/Perl58r2/msrc/DBD-Oracle-1.12.share/oci8.c Fri Jul 5 23:38:26 2002 @@ -18,10 +18,6 @@ DBISTATE_DECLARE; -static SV *ora_long; -static SV *ora_trunc; -static SV *ora_cache; -static SV *ora_cache_o; /* for ora_open() cache override */ extern int pp_exec_rset _((SV *sth, imp_sth_t *imp_sth, phs_t *phs, int pre_exec)); @@ -29,12 +25,16 @@ dbd_init_oci(dbistate_t *dbistate) { DBIS = dbistate; - ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI); - ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI); - ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI); - ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI); } +void +dbd_init_oci_drh(imp_drh_t * imp_drh) +{ + imp_drh -> ora_long = perl_get_sv("Oraperl::ora_long", GV_ADDMULTI); + imp_drh -> ora_trunc = perl_get_sv("Oraperl::ora_trunc", GV_ADDMULTI); + imp_drh -> ora_cache = perl_get_sv("Oraperl::ora_cache", GV_ADDMULTI); + imp_drh -> ora_cache_o = perl_get_sv("Oraperl::ora_cache_o", GV_ADDMULTI); +} char * oci_status_name(sword status) @@ -138,7 +138,7 @@ && recno < 100 ) { if (debug >= 4 || recno>1/*XXX temp*/) - fprintf(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", + PerlIO_printf(DBILOGFP, " OCIErrorGet after %s (er%ld:%s): %d, %ld: %s\n", what, (long)recno, (eg_status==OCI_SUCCESS) ? "ok" : oci_status_name(eg_status), status, (long)eg_errcode, errbuf); @@ -313,7 +313,7 @@ OCIAttrGet_stmhp_stat(imp_sth, &imp_sth->stmt_type, 0, OCI_ATTR_STMT_TYPE, status); if (DBIS->debug >= 3) - fprintf(DBILOGFP, " dbd_st_prepare'd sql %s\n", + PerlIO_printf(DBILOGFP, " dbd_st_prepare'd sql %s\n", oci_stmt_type_name(imp_sth->stmt_type)); DBIc_IMPSET_on(imp_sth); @@ -325,8 +325,11 @@ else { /* set initial cache size by memory */ ub4 cache_mem; - if (SvOK(ora_cache_o)) cache_mem = -SvIV(ora_cache_o); - else if (SvOK(ora_cache)) cache_mem = -SvIV(ora_cache); + D_imp_dbh_from_sth ; + D_imp_drh_from_dbh ; + + if (SvOK(imp_drh -> ora_cache_o)) cache_mem = -SvIV(imp_drh -> ora_cache_o); + else if (SvOK(imp_drh -> ora_cache)) cache_mem = -SvIV(imp_drh -> ora_cache); else cache_mem = -imp_dbh->RowCacheSize; if (cache_mem <= 0) cache_mem = 10 * 1460; @@ -370,7 +373,7 @@ *indpp = &phs->indp; *piecep = OCI_ONE_PIECE; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " in '%s' [%ld,%ld]: len %2ld, ind %d%s\n", + PerlIO_printf(DBILOGFP, " in '%s' [%ld,%ld]: len %2ld, ind %d%s\n", phs->name, ul_t(iter), ul_t(index), ul_t(phs->alen), phs->indp, (phs->desc_h) ? " via descriptor" : ""); if (index > 0 || iter > 0) @@ -452,7 +455,7 @@ *indpp = &phs->indp; *rcodepp= &phs->arcode; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " out '%s' [%ld,%ld]: alen %2ld, piece %d%s\n", + 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" : ""); if (iter > 0) @@ -500,7 +503,7 @@ HV *init_attr = newHV(); int count; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name); + PerlIO_printf(DBILOGFP, " bind %s - allocating new sth...\n", phs->name); ENTER; PUSHMARK(SP); XPUSHs(sv_2mortal(newRV(DBIc_MY_H(imp_dbh)))); @@ -515,7 +518,7 @@ PUTBACK; LEAVE; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - allocated %s...\n", + PerlIO_printf(DBILOGFP, " bind %s - allocated %s...\n", phs->name, neatsvpv(phs->sv, 0)); } @@ -525,7 +528,7 @@ D_impdata(imp_sth_csr, imp_sth_t, sth_csr); if (DBIS->debug >= 3) - fprintf(DBILOGFP, " bind %s - initialising new %s...\n", + PerlIO_printf(DBILOGFP, " bind %s - initialising new %s...\n", phs->name, neatsvpv(sth_csr,0)); #ifdef OCI_V8_SYNTAX @@ -652,7 +655,7 @@ &amtp, 1 + offset, bufp, buflen, 0, 0, 0, SQLCS_IMPLICIT, status); if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n", fbh->field_num+1, oci_status_name(status), ul_t(loblen), imp_sth->long_readlen, ul_t(buflen), ul_t(amtp)); @@ -665,7 +668,7 @@ else { assert(amtp == 0); if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n", fbh->field_num+1, "SKIPPED", ul_t(loblen), imp_sth->long_readlen, ul_t(buflen), ul_t(amtp)); @@ -708,7 +711,10 @@ if (loblen > imp_sth->long_readlen) { /* LOB will be truncated */ int oraperl = DBIc_COMPAT(imp_sth); - if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(ora_trunc))) { + D_imp_dbh_from_sth ; + D_imp_drh_from_dbh ; + + if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) { /* user says truncation is ok */ /* Oraperl recorded the truncation in ora_errno so we */ /* so also but only for Oraperl mode handles. */ @@ -739,7 +745,7 @@ OCILobRead_log_stat(imp_sth->svchp, imp_sth->errhp, lobloc, &amtp, 1, SvPVX(dest_sv), buflen, 0, 0, 0, SQLCS_IMPLICIT, status); if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ldc, LongReadLen %ldc, BufLen %ldb, Got %ldc\n", fbh->field_num+1, oci_status_name(status), ul_t(loblen), imp_sth->long_readlen, ul_t(buflen), ul_t(amtp)); @@ -752,7 +758,7 @@ else { assert(amtp == 0); if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " OCILobRead field %d %s: LOBlen %ld, LongReadLen %ld, BufLen %ld, Got %ld\n", fbh->field_num+1, "SKIPPED", ul_t(loblen), imp_sth->long_readlen, ul_t(buflen), ul_t(amtp)); @@ -779,7 +785,7 @@ fbh_setup_getrefpv(imp_fbh_t *fbh, int desc_t, char *bless) { if (DBIS->debug >= 2) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " col %d: otype %d, desctype %d, %s", fbh->field_num, fbh->dbtype, desc_t, bless); fbh->ftype = fbh->dbtype; fbh->disize = fbh->dbsize; @@ -794,6 +800,7 @@ dbd_describe(SV *h, imp_sth_t *imp_sth) { D_imp_dbh_from_sth; + D_imp_drh_from_dbh ; I32 long_readlen; ub4 num_fields; int has_longs = 0; @@ -808,21 +815,21 @@ /* ora_trunc is checked at fetch time */ /* long_readlen: length for long/longraw (if >0), else 80 (ora app dflt) */ /* Ought to be for COMPAT mode only but was relaxed before LongReadLen existed */ - long_readlen = (SvOK(ora_long) && SvIV(ora_long)>0) - ? SvIV(ora_long) : DBIc_LongReadLen(imp_sth); + long_readlen = (SvOK(imp_drh -> ora_long) && SvIV(imp_drh -> ora_long)>0) + ? SvIV(imp_drh -> ora_long) : DBIc_LongReadLen(imp_sth); if (long_readlen < 0) /* trap any sillyness */ long_readlen = 80; /* typical oracle app default */ if (imp_sth->stmt_type != OCI_STMT_SELECT) { if (DBIS->debug >= 3) - fprintf(DBILOGFP, " dbd_describe skipped for %s\n", + 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) - fprintf(DBILOGFP, " dbd_describe %s (%s, lb %ld)...\n", + PerlIO_printf(DBILOGFP, " dbd_describe %s (%s, lb %ld)...\n", oci_stmt_type_name(imp_sth->stmt_type), DBIc_ACTIVE(imp_sth) ? "implicit" : "EXPLICIT", (long)long_readlen); @@ -947,7 +954,7 @@ fbh->disize = fbh->dbsize; p = "Field %d has an Oracle type (%d) which is not explicitly supported%s"; if (DBIS->debug >= 1) - fprintf(DBILOGFP, p, i, fbh->dbtype, "\n"); + PerlIO_printf(DBILOGFP, p, i, fbh->dbtype, "\n"); if (dowarn) warn(p, i, fbh->dbtype, ""); break; @@ -969,8 +976,8 @@ /* --- Setup the row cache for this query --- */ /* number of rows to cache */ - if (SvOK(ora_cache_o)) imp_sth->cache_rows = SvIV(ora_cache_o); - else if (SvOK(ora_cache)) imp_sth->cache_rows = SvIV(ora_cache); + if (SvOK(imp_drh->ora_cache_o)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache_o); + else if (SvOK(imp_drh->ora_cache)) imp_sth->cache_rows = SvIV(imp_drh->ora_cache); else imp_sth->cache_rows = imp_dbh->RowCacheSize; if (imp_sth->cache_rows >= 0) { /* set cache size by row count */ ub4 cache_rows = calc_cache_rows(num_fields, @@ -1037,7 +1044,7 @@ } if (DBIS->debug >= 3) - fprintf(DBILOGFP, + 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); @@ -1070,7 +1077,7 @@ } else { if (DBIS->debug >= 3) - fprintf(DBILOGFP, " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth)); + PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields...\n", DBIc_NUM_FIELDS(imp_sth)); OCIStmtFetch_log_stat(imp_sth->stmhp, imp_sth->errhp, 1, OCI_FETCH_NEXT, OCI_DEFAULT, status); } @@ -1081,7 +1088,7 @@ dTHR; /* for DBIc_ACTIVE_off */ DBIc_ACTIVE_off(imp_sth); /* eg finish */ if (DBIS->debug >= 3) - fprintf(DBILOGFP, " dbd_st_fetch no-more-data\n"); + PerlIO_printf(DBILOGFP, " dbd_st_fetch no-more-data\n"); return Nullav; } if (status != OCI_SUCCESS_WITH_INFO) { @@ -1097,7 +1104,7 @@ av = DBIS->get_fbav(imp_sth); if (DBIS->debug >= 3) - fprintf(DBILOGFP, " dbd_st_fetch %d fields %s\n", + PerlIO_printf(DBILOGFP, " dbd_st_fetch %d fields %s\n", num_fields, oci_status_name(status)); ChopBlanks = DBIc_has(imp_sth, DBIcf_ChopBlanks); @@ -1113,7 +1120,10 @@ && ora_dbtype_is_long(fbh->dbtype)/* field is a LONG */ ) { int oraperl = DBIc_COMPAT(imp_sth); - if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(ora_trunc))) { + D_imp_dbh_from_sth ; + D_imp_drh_from_dbh ; + + if (DBIc_has(imp_sth,DBIcf_LongTruncOk) || (oraperl && SvIV(imp_drh -> ora_trunc))) { /* user says truncation is ok */ /* Oraperl recorded the truncation in ora_errno so we */ /* so also but only for Oraperl mode handles. */ @@ -1169,7 +1179,7 @@ } if (DBIS->debug >= 5) - fprintf(DBILOGFP, " %d (rc=%d): %s\n", + PerlIO_printf(DBILOGFP, " %d (rc=%d): %s\n", i, rc, neatsvpv(sv,0)); } @@ -1385,7 +1395,7 @@ return oci_error(sth, errhp, status, "OCIDescribeAny/OCIAttrGet/LOB refetch"); } if (DBIS->debug >= 3) - fprintf(DBILOGFP, " lob refetch from table %s, %d columns:\n", + PerlIO_printf(DBILOGFP, " lob refetch from table %s, %d columns:\n", tablename, numcols); for (i = 1; i <= (long)numcols; i++) { @@ -1406,7 +1416,7 @@ if (status) break; if (DBIS->debug >= 3) - fprintf(DBILOGFP, " lob refetch table col %d: '%.*s' otype %d\n", + 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) continue; @@ -1467,7 +1477,7 @@ if (phs->ftype != SvIV(sv_other)) continue; if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " both %s and %s have type %d - ambiguous\n", SvPV(sv,na), SvPV(sv_other,na), (int)SvIV(sv_other)); Safefree(lr); @@ -1480,7 +1490,7 @@ (SvCUR(sql_select)>7)?", ":"", p, &phs->name[1]); sv_catpv(sql_select, sql_field); if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " lob refetch %s param: otype %d, matched field '%s' %s(%s)\n", phs->name, phs->ftype, p, (phs->ora_field) ? "by name " : "by type ", sql_field); @@ -1497,7 +1507,7 @@ if (!matched) { ++unmatched_params; if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " lob refetch %s param: otype %d, UNMATCHED\n", phs->name, phs->ftype); } @@ -1512,7 +1522,7 @@ sv_catpv(sql_select, tablename); sv_catpv(sql_select, " where rowid = :rid for update"); /* get row with lock */ if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " lob refetch sql: %s\n", SvPVX(sql_select)); lr->sql_select = sql_select; @@ -1549,7 +1559,7 @@ phs = (phs_t*)(void*)SvPVX(*phs_svp); fbh->special = phs; if (DBIS->debug >= 3) - fprintf(DBILOGFP, + PerlIO_printf(DBILOGFP, " lob refetch %d for '%s' param: ftype %d setup\n", (int)i+1,fbh->name, fbh->dbtype); OCIDefineByPos_log_stat(lr->stmthp, &defnp, errhp, i+1, @@ -1613,7 +1623,7 @@ OCILobTrim_log_stat(imp_sth->svchp, errhp, fbh->desc_h, 0, status); } if (DBIS->debug >= 3) - fprintf(DBILOGFP, + 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), (amtp > 0) ? "LobWrite" : "LobTrim", oci_status_name(status));