--- Makefile.PL Thu Jun 13 14:28:25 2002 +++ /mnt/wing1/Perl58r2/msrc/DBI-1.28/Makefile.PL Mon Jul 8 09:58:32 2002 @@ -42,10 +42,12 @@ if ($Config{archname} =~ /-thread\b/i) { print "\n"; print "*** You are using a perl with experimental threading enabled!\a\n"; - print "*** You should be aware that using multiple threads is unstable\n"; - print "*** are should NOT be done in production environments.\n"; - print "DBI 5.005-style thread mutex protection is ", $::opt_thread ? "enabled\n" : "disabled!\n"; - print "DBI hs not been tested with new perl iThreads\n"; + print "*** You should be aware that using multiple threads maybe unstable\n"; + print "*** and should be done in production environments only with great care\n" ; + print "*** and after carefully testing.\n"; + print "DBI 5.005-style thread mutex protection is NOT supported anymore!\n"; + print "DBI supports new perl iThreads, but you have to check that your\n" ; + print "DBD driver supports it too\n"; print "\n"; sleep 5; } --- DBI.xs Fri Jun 14 15:11:32 2002 +++ /mnt/wing1/Perl58r2/msrc/DBI-1.28/DBI.xs Mon Jul 8 08:31:40 2002 @@ -125,8 +125,8 @@ #define MAX_LongReadLen 2147483647L #endif -#ifdef DBI_USE_THREADS -static char *dbi_build_opt = "-thread"; +#ifdef USE_ITHREADS +static char *dbi_build_opt = "-ithread"; #else static char *dbi_build_opt = "-nothread"; #endif @@ -203,17 +203,12 @@ } static void -dbi_bootinit() +dbi_bootinit(dbistate_t * parent_dbis) { INIT_PERINTERP; Newz(dummy, DBIS, 1, dbistate_t); -#ifdef DBI_USE_THREADS - Newz(1, DBIS->mutex, 1, dbi_mutex); - MUTEX_INIT(DBIS->mutex); -#endif - /* store version and size so we can spot DBI/DBD version mismatch */ DBIS->check_version = check_version; DBIS->version = DBISTATE_VERSION; @@ -221,11 +216,15 @@ DBIS->xs_version = DBIXS_VERSION; /* store some other critical values */ - DBIS->debug = 0; + DBIS->debug = parent_dbis?parent_dbis -> debug:0; DBIS->logmsg = dbih_logmsg; - DBIS->logfp = PerlIO_stderr(); + DBIS->logfp = parent_dbis?parent_dbis->logfp:PerlIO_stderr(); DBIS->neatsvpvlen = get_sv("DBI::neat_maxlen", GV_ADDMULTI); + if (!parent_dbis) sv_setiv(DBIS->neatsvpvlen, 400); +#ifdef USE_ITHREADS + DBIS->thr_user = PERL_GET_THX ; +#endif /* publish address of dbistate so dynaloaded DBD's can find it */ sv_setiv(get_sv(DBISTATE_PERLNAME,1), (IV)DBIS); @@ -585,25 +584,6 @@ } -#ifdef DBI_USE_THREADS -static void -dbi_cond_signal(imp_xxh) - imp_xxh_t *imp_xxh; -{ - if (!imp_xxh || !DBIc_THR_COND(imp_xxh)) - return; - DBI_LOCK; - if (DBIS->debug >= 4) - PerlIO_printf(DBILOGFP," .. thread %lu leaving %s\n", - DBIc_THR_USER(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh))); - DBIc_THR_USER(imp_xxh) = DBIc_THR_USER_NONE; /* free for other thread to enter */ - COND_SIGNAL(DBIc_THR_COND(imp_xxh)); - DBI_UNLOCK; -} -#endif - - - /* -------------------------------------------------------------------- */ /* Functions to manage a DBI handle (magic and attributes etc). */ @@ -765,23 +745,25 @@ |DBIcf_ACTIVE /* drivers are 'Active' by default */ |DBIcf_AutoCommit /* advisory, driver must manage this */ ); -#ifdef DBI_USE_THREADS - Newz(1, DBIc_THR_COND(imp), 1, dbi_cond); - COND_INIT(DBIc_THR_COND(imp)); -#endif } else { imp_xxh_t *parent_com = DBIh_COM(parent_h); DBIc_PARENT_H(imp) = (SV*)SvREFCNT_inc(parent_h); /* ensure it lives */ DBIc_PARENT_COM(imp) = parent_com; /* shortcut for speed */ DBIc_TYPE(imp) = DBIc_TYPE(parent_com) + 1; DBIc_FLAGS(imp) = DBIc_FLAGS(parent_com) & ~DBIcf_INHERITMASK; - DBIc_THR_COND(imp) = DBIc_THR_COND(parent_com); ++DBIc_KIDS(parent_com); } +#ifdef USE_ITHREADS + DBIc_THR_USER(imp) = PERL_GET_THX ; + if (DBIS->debug >= 3) + PerlIO_printf(DBILOGFP," dbih_make_com set thread to %x (type=%d)\n", + DBIc_THR_USER(imp), DBIc_TYPE(imp)); +#else /* handles come into life with DBIc_THR_USER set to DBIc_THR_USER_NONE */ /* because DBIc_THR_USER indicates which thread has 'entered the DBI' */ /* on this handle and, at this point, none has. */ DBIc_THR_USER(imp) = DBIc_THR_USER_NONE; +#endif if (DBIc_TYPE(imp) == DBIt_ST) { imp_sth_t *imp_sth = (imp_sth_t*)imp; @@ -939,12 +921,6 @@ neatsvpv(DBIc_IMP_DATA(imp_xxh),0), HvNAME(DBIc_IMP_STASH(imp_xxh))); if (DBIc_LongReadLen(imp_xxh) != DBIc_LongReadLen_init) PerlIO_printf(DBILOGFP,"%s LongReadLen %ld\n", pad, (long)DBIc_LongReadLen(imp_xxh)); -#ifdef DBI_USE_THREADS - if (DBIc_THR_COND(imp_xxh)) { - PerlIO_printf(DBILOGFP,"%s thread cond var 0x%lx", pad, (long)DBIc_THR_COND(imp_xxh)); - PerlIO_printf(DBILOGFP,", tid %lu\n", (unsigned long)DBIc_THR_USER(imp_xxh)); - } -#endif if (DBIc_TYPE(imp_xxh) <= DBIt_DB) { imp_dbh_t *imp_dbh = (imp_dbh_t*)imp_xxh; @@ -975,6 +951,7 @@ { dPERINTERP; dTHR; + dTHX; int dump = FALSE; int auto_dump = (DBIS->debug >= 6); @@ -988,6 +965,19 @@ return; } + +#ifdef USE_ITHREADS + if (DBIc_THR_USER(imp_xxh) != my_perl) { + /* don't clear handle that belongs to another thread */ + if (DBIS->debug >= 3) { + PerlIO_printf(DBILOGFP,"ignore dbi_hclearcom because DBI handle (type=%d, %s) is not owned by current thread (is %x, should %x)\n", + DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), DBIc_THR_USER(imp_xxh), my_perl) ; + PerlIO_flush(DBILOGFP); + } + return ; + } +#endif + if (auto_dump) dbih_dumpcom(imp_xxh,"dbih_clearcom", 0); @@ -1047,12 +1037,6 @@ sv_free(_imp2com(imp_xxh, attr.FetchHashKeyName)); } -#ifdef DBI_USE_THREADS - if (DBIc_TYPE(imp_xxh) == DBIt_DR && DBIc_THR_COND(imp_xxh)) { - COND_DESTROY(DBIc_THR_COND(imp_xxh)); - Safefree(DBIc_THR_COND(imp_xxh)); - } -#endif sv_free((SV*)DBIc_PARENT_H(imp_xxh)); /* do this last */ @@ -2217,24 +2201,32 @@ } } -#ifdef DBI_USE_THREADS /* only pay the cost with threaded perl */ - DBI_LOCK; - while(DBIc_THR_USER(imp_xxh) != DBIc_THR_USER_NONE && DBIc_THR_USER(imp_xxh) != thr->tid) { - if (debug >= 4) { - PerlIO_printf(DBILOGFP," .. %s: thread %lu waiting for thread %lu to leave %s\n", - meth_name, thr->tid, DBIc_THR_USER(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh))); +#ifdef USE_ITHREADS +{ + PerlInterpreter * is_perl = DBIc_THR_USER(imp_xxh) ; + + if (debug >= 6) { + PerlIO_printf(DBILOGFP,"****DISPATCH: DBI handle (type=%d) in call to %s::%s (is %x, should %x)\n", + DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, is_perl, my_perl) ; + } + if (is_perl != my_perl) { + if (is_DESTROY) { + if (debug) { + PerlIO_printf(DBILOGFP,"ignore DESTROY because DBI handle (type=%d) is not owned by current thread in call to %s::%s (is %x, should %x)\n", + DBIc_TYPE(imp_xxh), HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, is_perl, my_perl) ; PerlIO_flush(DBILOGFP); } - COND_WAIT(DBIc_THR_COND(imp_xxh), DBIS->mutex); + XSRETURN(0); /* don't DESTROY handle, if it is not our's !*/ } - DBIc_THR_USER(imp_xxh) = thr->tid; - if (debug >= 4) { - PerlIO_printf(DBILOGFP," .. %s: thread %lu entering %s\n", - meth_name, thr->tid, HvNAME(DBIc_IMP_STASH(imp_xxh))); + if (debug) { + PerlIO_printf(DBILOGFP,"%s %s failed: handle %d is owned by thread %x not current thread %x (handles can't be shared between threads and your driver may need a CLONE method added)\n", + HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, DBIc_TYPE(imp_xxh), is_perl, my_perl) ; PerlIO_flush(DBILOGFP); } - SAVEDESTRUCTOR(dbi_cond_signal, imp_xxh); /* arrange later cond signal */ - DBI_UNLOCK; + croak ("%s %s failed: handle %d is owned by thread %x not current thread %x (handles can't be shared between threads and your driver may need a CLONE method added)", + HvNAME(DBIc_IMP_STASH(imp_xxh)), meth_name, DBIc_TYPE(imp_xxh), is_perl, my_perl) ; + } +} #endif if (!imp_msv) { @@ -2268,8 +2260,8 @@ PerlIO_printf(logfp," %s", (ima && i==ima->hidearg) ? "****" : neatsvpv(ST(i),0)); } -#ifdef DBI_USE_THREADS - PerlIO_printf(logfp, ") thr%lu\n", thr->tid); +#ifdef USE_ITHREADS + PerlIO_printf(logfp, ") thr#%x\n", my_perl); #else PerlIO_printf(logfp, ")\n"); #endif @@ -2897,7 +2889,7 @@ BOOT: items = items; /* avoid 'unused variable' warning */ - dbi_bootinit(); + dbi_bootinit(NULL); I32 @@ -2982,6 +2974,13 @@ void +_clone_dbis() + CODE: + dPERINTERP; + dbi_bootinit(DBIS); + + +void _setup_handle(sv, imp_class, parent, imp_datasv) SV * sv char * imp_class --- DBIXS.h Thu Jun 6 00:39:54 2002 +++ /mnt/wing1/Perl58r2/msrc/DBI-1.28/DBIXS.h Mon Jul 8 08:17:28 2002 @@ -49,18 +49,8 @@ #endif -#if defined(USE_THREADS) && !defined(DBI_NO_THREADS) -#define DBI_USE_THREADS -#define DBI_LOCK MUTEX_LOCK(DBIS->mutex) -#define DBI_UNLOCK MUTEX_UNLOCK(DBIS->mutex) -#define dbi_mutex perl_mutex -#define dbi_cond perl_cond -#else #define DBI_LOCK #define DBI_UNLOCK -#define dbi_mutex void -#define dbi_cond void -#endif /* forward struct declarations */ @@ -92,14 +82,19 @@ HV *my_h; /* copy of outer handle HV (not refcounted) */ SV *parent_h; /* parent inner handle (ref to hv) (r.c.inc) */ imp_xxh_t *parent_com; /* parent com struct shortcut */ - dbi_cond *thr_cond;/* condition for thread access (see dispatch) */ + + void *pad; /* keep binary compatibility */ HV *imp_stash; /* who is the implementor for this handle */ SV *imp_data; /* optional implementors data (for perl imp's) */ I32 kids; /* count of db's for dr's, st's for db's etc */ I32 active_kids; /* kids which are currently DBIc_ACTIVE */ +#ifdef USE_ITHREADS + PerlInterpreter * thr_user; /* thread id currently using the handle */ +#else U32 thr_user; /* thread id currently using the handle */ +#endif dbistate_t *dbistate; } dbih_com_std_t; @@ -383,11 +378,18 @@ SV *neatsvpvlen; /* only show dbgpvlen chars when debugging pv's */ - dbi_mutex *mutex; + void *pad1; /* keep binary compatibility */ int (*logmsg) _((imp_xxh_t *imp_xxh, char *fmt, ...)); int (*set_err) _((imp_xxh_t *imp_xxh, char *fmt, ...)); - void *pad[7]; + +#ifdef USE_ITHREADS + PerlInterpreter * thr_user; /* thread id currently using the handle */ +#else + U32 thr_user; /* thread id currently using the handle */ +#endif + + void *pad2[3]; }; /* macros for backwards compatibility */ --- DBI.pm Fri Jun 14 15:11:36 2002 +++ /mnt/wing1/Perl58r2/msrc/DBI-1.28/DBI.pm Mon Jul 8 08:19:00 2002 @@ -415,6 +415,13 @@ } +sub CLONE { + my $olddbis = $DBI::_dbistate ; + _clone_dbis() ; # clone the DBIS structure + %DBI::installed_drh = () ; # clear loaded drivers so they have a chance to reinitialize + DBI->trace_msg("CONE DBI for new thread (" . sprintf ("dbis %x -> %x",$olddbis, $DBI::_dbistate) . ")\n"); +} + # --- The DBI->connect Front Door methods