Author: gozer Date: Tue Nov 13 11:32:58 2007 New Revision: 594612 URL: http://svn.apache.org/viewvc?rev=594612&view=rev Log: This one makes PerlInterpScope more advisory. Using pnotes increment the refcnt of the interp thus binding it to the lifetime of the pnotes. So, using $c->pnotes binds the interp to the lifetime of the connection, $r->pnotes to the request lifetime.
$[rc]->pnotes_kill() can be used to prematurely drop pnotes and thus remove the binding. Reviewed-By: gozer Submittted-By: Torsten Foertsch <[EMAIL PROTECTED]> Message-Id: <[EMAIL PROTECTED]> Modified: perl/modperl/branches/threading/Changes perl/modperl/branches/threading/src/modules/perl/modperl_types.h perl/modperl/branches/threading/src/modules/perl/modperl_util.c perl/modperl/branches/threading/src/modules/perl/modperl_util.h perl/modperl/branches/threading/xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h perl/modperl/branches/threading/xs/Apache2/RequestUtil/Apache2__RequestUtil.h perl/modperl/branches/threading/xs/maps/modperl_functions.map perl/modperl/branches/threading/xs/tables/current/ModPerl/FunctionTable.pm Modified: perl/modperl/branches/threading/Changes URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/Changes?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/Changes (original) +++ perl/modperl/branches/threading/Changes Tue Nov 13 11:32:58 2007 @@ -12,6 +12,11 @@ =item 2.0.4-dev +PerlInterpScope is now more advisory. Using $(c|r)->pnotes will bind +the current interpreter to that object for it's lifetime. +$(c|r)->pnotes_kill() can be used to prematurely drop pnotes and +remove this binding. [Torsten Foertsch] + Now correctly invokes PerlCleanupHandlers, even if they are the only handler type configured for that request [Torsten Foertsch] Modified: perl/modperl/branches/threading/src/modules/perl/modperl_types.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_types.h?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_types.h (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_types.h Tue Nov 13 11:32:58 2007 @@ -246,6 +246,14 @@ typedef struct { HV *pnotes; + apr_pool_t *pool; +#ifdef USE_ITHREADS + modperl_interp_t *interp; +#endif +} modperl_pnotes_t; + +typedef struct { + modperl_pnotes_t pnotes; SV *global_request_obj; U8 flags; int status; @@ -253,13 +261,10 @@ MpAV *handlers_per_dir[MP_HANDLER_NUM_PER_DIR]; MpAV *handlers_per_srv[MP_HANDLER_NUM_PER_SRV]; modperl_perl_globals_t perl_globals; -#ifdef USE_ITHREADS - modperl_interp_t *interp; -#endif } modperl_config_req_t; struct modperl_config_con_t { - HV *pnotes; + modperl_pnotes_t pnotes; #ifdef USE_ITHREADS modperl_interp_t *interp; #endif Modified: perl/modperl/branches/threading/src/modules/perl/modperl_util.c URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_util.c?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_util.c (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_util.c Tue Nov 13 11:32:58 2007 @@ -828,59 +828,51 @@ modperl_global_get_server_rec()->process->pool); return data ? *(int *)data : 0; } - -#ifdef USE_ITHREADS -typedef struct { - HV **pnotes; - PerlInterpreter *perl; -} modperl_cleanup_pnotes_data_t; -#endif static MP_INLINE apr_status_t modperl_cleanup_pnotes(void *data) { - HV **pnotes = data; + modperl_pnotes_t *pnotes = data; - if (*pnotes) { #ifdef USE_ITHREADS - modperl_cleanup_pnotes_data_t *cleanup_data = data; - dTHXa(cleanup_data->perl); - pnotes = cleanup_data->pnotes; -#else - pnotes = data; + dTHXa(pnotes->interp->perl); +#endif + SvREFCNT_dec(pnotes->pnotes); + pnotes->pnotes = NULL; + pnotes->pool = NULL; +#ifdef USE_ITHREADS + MP_TRACE_i(MP_FUNC, "DO: calling interp_unselect(0x%lx)\n", + pnotes->interp); + modperl_interp_unselect(pnotes->interp); + pnotes->interp = NULL; #endif - SvREFCNT_dec(*pnotes); - *pnotes = Nullhv; - } - return APR_SUCCESS; } -MP_INLINE -static void *modperl_pnotes_cleanup_data(pTHX_ HV **pnotes, apr_pool_t *p) { -#ifdef USE_ITHREADS - modperl_cleanup_pnotes_data_t *cleanup_data = apr_palloc(p, sizeof(*cleanup_data)); - cleanup_data->pnotes = pnotes; - cleanup_data->perl = aTHX; - return cleanup_data; -#else - return pnotes; -#endif +void modperl_pnotes_kill(void *data) { + modperl_pnotes_t *pnotes = data; + + if( !pnotes->pnotes ) return; + + apr_pool_cleanup_kill(pnotes->pool, pnotes, modperl_cleanup_pnotes); + modperl_cleanup_pnotes(pnotes); } -SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val, - request_rec *r, conn_rec *c) { +SV *modperl_pnotes(pTHX_ modperl_pnotes_t *pnotes, SV *key, SV *val, + apr_pool_t *pool) { SV *retval = Nullsv; - if (!*pnotes) { - apr_pool_t *pool = r ? r->pool : c->pool; - void *cleanup_data; - *pnotes = newHV(); - - cleanup_data = modperl_pnotes_cleanup_data(aTHX_ pnotes, pool); - - apr_pool_cleanup_register(pool, cleanup_data, - modperl_cleanup_pnotes, - apr_pool_cleanup_null); + if (!pnotes->pnotes) { + pnotes->pool = pool; +#ifdef USE_ITHREADS + pnotes->interp = MP_THX_INTERP_GET(aTHX); + pnotes->interp->refcnt++; + MP_TRACE_i(MP_FUNC, "TO: (0x%lx)->refcnt incremented to %ld", + pnotes->interp, pnotes->interp->refcnt); +#endif + pnotes->pnotes = newHV(); + apr_pool_cleanup_register(pool, pnotes, + modperl_cleanup_pnotes, + apr_pool_cleanup_null); } if (key) { @@ -888,14 +880,14 @@ char *k = SvPV(key, len); if (val) { - retval = *hv_store(*pnotes, k, len, SvREFCNT_inc(val), 0); + retval = *hv_store(pnotes->pnotes, k, len, SvREFCNT_inc(val), 0); } - else if (hv_exists(*pnotes, k, len)) { - retval = *hv_fetch(*pnotes, k, len, FALSE); + else if (hv_exists(pnotes->pnotes, k, len)) { + retval = *hv_fetch(pnotes->pnotes, k, len, FALSE); } return retval ? SvREFCNT_inc(retval) : &PL_sv_undef; } - return newRV_inc((SV *)*pnotes); + return newRV_inc((SV *)pnotes->pnotes); } Modified: perl/modperl/branches/threading/src/modules/perl/modperl_util.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/src/modules/perl/modperl_util.h?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/src/modules/perl/modperl_util.h (original) +++ perl/modperl/branches/threading/src/modules/perl/modperl_util.h Tue Nov 13 11:32:58 2007 @@ -134,7 +134,9 @@ void modperl_restart_count_inc(server_rec *base_server); int modperl_restart_count(void); -SV *modperl_pnotes(pTHX_ HV **pnotes, SV *key, SV *val, - request_rec *r, conn_rec *c); +void modperl_pnotes_kill(void *data); + +SV *modperl_pnotes(pTHX_ modperl_pnotes_t *pnotes, SV *key, SV *val, + apr_pool_t *pool ); #endif /* MODPERL_UTIL_H */ Modified: perl/modperl/branches/threading/xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h (original) +++ perl/modperl/branches/threading/xs/Apache2/ConnectionUtil/Apache2__ConnectionUtil.h Tue Nov 13 11:32:58 2007 @@ -25,5 +25,19 @@ return &PL_sv_undef; } - return modperl_pnotes(aTHX_ &ccfg->pnotes, key, val, NULL, c); + return modperl_pnotes(aTHX_ &ccfg->pnotes, key, val, c->pool); +} + +static MP_INLINE +void mpxs_Apache2__Connection_pnotes_kill(pTHX_ conn_rec *c) +{ + MP_dCCFG; + + modperl_config_con_init(c, ccfg); + + if (!ccfg) { + return; + } + + modperl_pnotes_kill(&ccfg->pnotes); } Modified: perl/modperl/branches/threading/xs/Apache2/RequestUtil/Apache2__RequestUtil.h URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/Apache2/RequestUtil/Apache2__RequestUtil.h?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/xs/Apache2/RequestUtil/Apache2__RequestUtil.h (original) +++ perl/modperl/branches/threading/xs/Apache2/RequestUtil/Apache2__RequestUtil.h Tue Nov 13 11:32:58 2007 @@ -218,7 +218,19 @@ return &PL_sv_undef; } - return modperl_pnotes(aTHX_ &rcfg->pnotes, key, val, r, NULL); + return modperl_pnotes(aTHX_ &rcfg->pnotes, key, val, r->pool); +} + +static MP_INLINE +void mpxs_Apache2__RequestRec_pnotes_kill(pTHX_ request_rec *r) +{ + MP_dRCFG; + + if (!rcfg) { + return; + } + + modperl_pnotes_kill(&rcfg->pnotes); } #define mpxs_Apache2__RequestRec_dir_config(r, key, sv_val) \ Modified: perl/modperl/branches/threading/xs/maps/modperl_functions.map URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/maps/modperl_functions.map?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/xs/maps/modperl_functions.map (original) +++ perl/modperl/branches/threading/xs/maps/modperl_functions.map Tue Nov 13 11:32:58 2007 @@ -30,6 +30,7 @@ mpxs_Apache2__RequestRec_location mpxs_Apache2__RequestRec_as_string mpxs_Apache2__RequestRec_pnotes | | r, key=Nullsv, val=Nullsv + mpxs_Apache2__RequestRec_pnotes_kill | | r mpxs_Apache2__RequestRec_add_config | | r, lines, override=MP_HTTPD_OVERRIDE_HTACCESS, path=NULL, override_options=MP_HTTPD_OVERRIDE_OPTS_UNSET mpxs_Apache2__RequestRec_document_root | | r, new_root=Nullsv mpxs_Apache2__RequestRec_child_terminate @@ -95,6 +96,7 @@ MODULE=Apache2::ConnectionUtil PACKAGE=guess mpxs_Apache2__Connection_pnotes | | c, key=Nullsv, val=Nullsv + mpxs_Apache2__Connection_pnotes_kill | | c MODULE=Apache2::Filter modperl_filter_attributes | MPXS_ | ... | MODIFY_CODE_ATTRIBUTES Modified: perl/modperl/branches/threading/xs/tables/current/ModPerl/FunctionTable.pm URL: http://svn.apache.org/viewvc/perl/modperl/branches/threading/xs/tables/current/ModPerl/FunctionTable.pm?rev=594612&r1=594611&r2=594612&view=diff ============================================================================== --- perl/modperl/branches/threading/xs/tables/current/ModPerl/FunctionTable.pm (original) +++ perl/modperl/branches/threading/xs/tables/current/ModPerl/FunctionTable.pm Tue Nov 13 11:32:58 2007 @@ -4446,7 +4446,17 @@ 'type' => 'request_rec *', 'name' => 'r' } - ] + ] + }, + { + 'return_type' => 'void', + 'name' => 'modperl_pnotes_kill', + 'args' => [ + { + 'type' => 'void *', + 'name' => 'cl_data' + } + ] }, { 'return_type' => 'int', @@ -6265,6 +6275,20 @@ ] }, { + 'return_type' => 'void', + 'name' => 'mpxs_Apache2__Connection_pnotes_kill', + 'args' => [ + { + 'type' => 'PerlInterpreter *', + 'name' => 'my_perl' + }, + { + 'type' => 'conn_rec *', + 'name' => 'c' + } + ] + }, + { 'return_type' => 'SV *', 'name' => 'mpxs_Apache2__Directive_as_hash', 'attr' => [ @@ -7068,6 +7092,20 @@ { 'type' => 'SV *', 'name' => 'val' + } + ] + }, + { + 'return_type' => 'void', + 'name' => 'mpxs_Apache2__RequestRec_pnotes_kill', + 'args' => [ + { + 'type' => 'PerlInterpreter *', + 'name' => 'my_perl' + }, + { + 'type' => 'request_rec *', + 'name' => 'r' } ] },