You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by go...@apache.org on 2007/11/13 20:32:59 UTC

svn commit: r594612 - in /perl/modperl/branches/threading: ./ src/modules/perl/ xs/Apache2/ConnectionUtil/ xs/Apache2/RequestUtil/ xs/maps/ xs/tables/current/ModPerl/

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 <to...@gmx.net>
Message-Id: <20...@gmx.net>


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'
       }
     ]
   },