perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject svn commit: r111330 - in perl/modperl/trunk: . src/modules/perl t/conf t/response/TestAPI xs/Apache/ServerUtil xs/maps xs/tables/current/ModPerl
Date Thu, 09 Dec 2004 01:04:40 GMT
Author: stas
Date: Wed Dec  8 17:04:38 2004
New Revision: 111330

URL: http://svn.apache.org/viewcvs?view=rev&rev=111330
Log:
a new function Apache::ServerUtil::server_shutdown_register_cleanup to
register cleanups to be run at server shutdown. 

Modified:
   perl/modperl/trunk/Changes
   perl/modperl/trunk/src/modules/perl/mod_perl.c
   perl/modperl/trunk/src/modules/perl/mod_perl.h
   perl/modperl/trunk/t/conf/modperl_extra.pl
   perl/modperl/trunk/t/response/TestAPI/server_util.pm
   perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h
   perl/modperl/trunk/xs/maps/modperl_functions.map
   perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm

Modified: perl/modperl/trunk/Changes
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/Changes?view=diff&rev=111330&p1=perl/modperl/trunk/Changes&r1=111329&p2=perl/modperl/trunk/Changes&r2=111330
==============================================================================
--- perl/modperl/trunk/Changes	(original)
+++ perl/modperl/trunk/Changes	Wed Dec  8 17:04:38 2004
@@ -12,6 +12,9 @@
 
 =item 1.99_18-dev
 
+a new function Apache::ServerUtil::server_shutdown_register_cleanup to
+register cleanups to be run at server shutdown. [Stas]
+
 $bb->cleanup is no more segfaulting (was segfaulting due to a broken
 prototype in APR, and consequently invalid XS glue code) [Randy Kobes,
 Stas]
@@ -39,8 +42,8 @@
 Apache::SizeLimit ported [Perrin Harkins <perrin elem.com>]
 
 create a new subpool modperl_server_user_pool (from
-modperl_server_pool), which is handed to users via
-Apache::ServerUtil::base_server_pool(). This ensures that
+modperl_server_pool), which is used internally by
+Apache::ServerUtil::server_restart_register. This ensures that
 user-registered cleanups are run *before* perl's internals cleanups
 are run. (previously there was a problem with non-threaded perls which
 were segfaulting on user cleanups, since perl was already gone by that
@@ -58,9 +61,6 @@
 restarting/etc. Based on this feature implement
 $Apache::Server::Starting and $Apache::Server::ReStarting in
 Apache::compat [Stas]
-
-provide perl glue for the mod_perl's base_server_pool
-via Apache::ServerUtil::base_server_pool() [Geoff, Stas]
 
 Apache::Resource ported to mp2 [Stas]
 

Modified: perl/modperl/trunk/src/modules/perl/mod_perl.c
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/mod_perl.c?view=diff&rev=111330&p1=perl/modperl/trunk/src/modules/perl/mod_perl.c&r1=111329&p2=perl/modperl/trunk/src/modules/perl/mod_perl.c&r2=111330
==============================================================================
--- perl/modperl/trunk/src/modules/perl/mod_perl.c	(original)
+++ perl/modperl/trunk/src/modules/perl/mod_perl.c	Wed Dec  8 17:04:38 2004
@@ -42,6 +42,15 @@
     return MP_threaded_mpm;
 }
 
+/* sometimes non-threaded mpm also needs to know whether it's still
+ * starting up or after post_config) */
+static int MP_post_post_config_phase = 0;
+
+int modperl_post_post_config_phase(void)
+{
+    return MP_post_post_config_phase;
+}
+
 #ifndef USE_ITHREADS
 static apr_status_t modperl_shutdown(void *data)
 {
@@ -551,6 +560,7 @@
 {
     MP_init_status = 0;
     MP_threads_started = 0;
+    MP_post_post_config_phase = 0;
 
     MP_TRACE_i(MP_FUNC, "mod_perl sys term\n");
 
@@ -680,6 +690,8 @@
     if (modperl_threaded_mpm()) {
         MP_threads_started = 1;
     }
+
+    MP_post_post_config_phase = 1;
     
     return OK;
 }

Modified: perl/modperl/trunk/src/modules/perl/mod_perl.h
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/src/modules/perl/mod_perl.h?view=diff&rev=111330&p1=perl/modperl/trunk/src/modules/perl/mod_perl.h&r1=111329&p2=perl/modperl/trunk/src/modules/perl/mod_perl.h&r2=111330
==============================================================================
--- perl/modperl/trunk/src/modules/perl/mod_perl.h	(original)
+++ perl/modperl/trunk/src/modules/perl/mod_perl.h	Wed Dec  8 17:04:38 2004
@@ -108,6 +108,12 @@
                    what);                                       \
     }
 
+#define MP_CROAK_IF_POST_POST_CONFIG_PHASE(what)                \
+    if (modperl_post_post_config_phase()) {                     \
+        Perl_croak(aTHX_ "Can't run '%s' after server startup", \
+                   what);                                       \
+    }
+
 int modperl_init_vhost(server_rec *s, apr_pool_t *p,
                        server_rec *base_server);
 void modperl_init(server_rec *s, apr_pool_t *p);

Modified: perl/modperl/trunk/t/conf/modperl_extra.pl
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/conf/modperl_extra.pl?view=diff&rev=111330&p1=perl/modperl/trunk/t/conf/modperl_extra.pl&r1=111329&p2=perl/modperl/trunk/t/conf/modperl_extra.pl&r2=111330
==============================================================================
--- perl/modperl/trunk/t/conf/modperl_extra.pl	(original)
+++ perl/modperl/trunk/t/conf/modperl_extra.pl	Wed Dec  8 17:04:38 2004
@@ -52,7 +52,7 @@
 
 test_perl_ithreads();
 
-test_base_server_pool();
+test_server_shutdown_register_cleanup();
 
 
 
@@ -200,24 +200,21 @@
     }
 }
 
-sub test_base_server_pool {
+sub test_server_shutdown_register_cleanup {
     # we can't really test the functionality since it happens at
     # server shutdown, when the test suite has finished its run
     # so just check that we can register the cleanup and that it
     # doesn't segfault
-    my $base_server_pool = Apache::ServerUtil::base_server_pool();
-    $base_server_pool->cleanup_register(sub { Apache::OK });
+    Apache::ServerUtil::server_shutdown_register_cleanup(sub { Apache::OK });
+
     # replace the sub with the following to get some visual debug
     # should log cnt:1 on -start, oncand cnt: 2 -stop followed by cnt: 1)
-    #$base_server_pool->cleanup_register( sub {
+    #Apache::ServerUtil::server_shutdown_register( sub {
     #    my $cnt = Apache::ServerUtil::restart_count();
     #    open my $fh, ">>/tmp/out" or die "$!";
     #    print $fh "cnt: $cnt\n";
     #    close $fh;
     #});
-    #
-    # also remember that cleanup_register() called on this pool will
-    # work only when registered at the server startup
 }
 
 

Modified: perl/modperl/trunk/t/response/TestAPI/server_util.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/t/response/TestAPI/server_util.pm?view=diff&rev=111330&p1=perl/modperl/trunk/t/response/TestAPI/server_util.pm&r1=111329&p2=perl/modperl/trunk/t/response/TestAPI/server_util.pm&r2=111330
==============================================================================
--- perl/modperl/trunk/t/response/TestAPI/server_util.pm	(original)
+++ perl/modperl/trunk/t/response/TestAPI/server_util.pm	Wed Dec  8 17:04:38 2004
@@ -29,7 +29,7 @@
 sub handler {
     my $r = shift;
 
-    plan $r, tests => 18;
+    plan $r, tests => 17;
 
     {
         my $s = $r->server;
@@ -48,13 +48,12 @@
 
     server_root_relative_tests($r);
 
-    my $base_server_pool = Apache::ServerUtil::base_server_pool();
-    ok $base_server_pool->isa('APR::Pool');
-
-    # this will never run since it's not registered in the parent
-    # process
-    $base_server_pool->cleanup_register(sub { Apache::OK });
-    ok 1;
+    eval { Apache::ServerUtil::server_shutdown_register_cleanup(
+        sub { Apache::OK });
+       };
+    my $sub = "server_shutdown_register_cleanup";
+    ok t_cmp $@, qr/Can't run '$sub' after server startup/,
+        "can't register server_shutdown cleanup after server startup";
 
     # on start we get 1, and immediate restart gives 2
     ok t_cmp Apache::ServerUtil::restart_count, 2, "restart count";

Modified: perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h?view=diff&rev=111330&p1=perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h&r1=111329&p2=perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h&r2=111330
==============================================================================
--- perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h	(original)
+++ perl/modperl/trunk/xs/Apache/ServerUtil/Apache__ServerUtil.h	Wed Dec  8 17:04:38 2004
@@ -15,13 +15,94 @@
 
 #define mpxs_Apache__ServerUtil_restart_count modperl_restart_count
 
-#define mpxs_Apache__ServerUtil_base_server_pool modperl_server_user_pool
-
 #define mpxs_Apache__ServerRec_method_register(s, methname)     \
     ap_method_register(s->process->pconf, methname);
 
 #define mpxs_Apache__ServerRec_add_version_component(s, component)    \
     ap_add_version_component(s->process->pconf, component);
+
+/* XXX: the mpxs_cleanup_t and mpxs_cleanup_run are almost dups with
+ * code in APR__Pool.h (minus interpr member which is not used
+ * here. They should be moved to modperl_common_util - the problem is
+ * modperl_interp_t *, which can't live in modperl_common_* since it
+ * creates a dependency on mod_perl. A possible solution is to use
+ * void * for that slot and cast it to modperl_interp_t * when used
+ */
+
+typedef struct {
+    SV *cv;
+    SV *arg;
+    apr_pool_t *p;
+    PerlInterpreter *perl;
+} mpxs_cleanup2_t;
+
+/**
+ * callback wrapper for Perl cleanup subroutines
+ * @param data   internal storage
+ */
+static apr_status_t mpxs_cleanup_run(void *data)
+{
+    int count;
+    mpxs_cleanup2_t *cdata = (mpxs_cleanup2_t *)data;
+    dTHXa(cdata->perl);
+    dSP;
+
+    ENTER;SAVETMPS;
+    PUSHMARK(SP);
+    if (cdata->arg) {
+        XPUSHs(cdata->arg);
+    }
+    PUTBACK;
+
+    count = call_sv(cdata->cv, G_SCALAR|G_EVAL);
+
+    SPAGAIN;
+
+    if (count == 1) {
+        (void)POPs; /* the return value is ignored */
+    }
+
+    PUTBACK;
+    FREETMPS;LEAVE;
+
+    SvREFCNT_dec(cdata->cv);
+    if (cdata->arg) {
+        SvREFCNT_dec(cdata->arg);
+    }
+
+    if (SvTRUE(ERRSV)) {
+        Perl_croak(aTHX_ SvPV_nolen(ERRSV));
+    }
+    
+    /* the return value is ignored by apr_pool_destroy anyway */
+    return APR_SUCCESS;
+}
+
+/* this cleanups registered by this function are run only by the
+ * parent interpreter */
+static MP_INLINE
+void mpxs_Apache__ServerUtil_server_shutdown_register_cleanup(pTHX_ SV *cv,
+                                                              SV *arg)
+{
+    mpxs_cleanup2_t *data;
+    apr_pool_t *p;
+    
+    MP_CROAK_IF_POST_POST_CONFIG_PHASE("server_shutdown_register_cleanup");
+
+    p = modperl_server_user_pool();
+    /* must use modperl_server_user_pool here to make sure that it's run
+     * before parent perl is destroyed */
+    data = (mpxs_cleanup2_t *)apr_pcalloc(p, sizeof(*data));
+    data->cv   = SvREFCNT_inc(cv);
+    data->arg  = arg ? SvREFCNT_inc(arg) : Nullsv;
+    data->p    = p;
+#ifdef USE_ITHREADS
+    data->perl = aTHX;
+#endif /* USE_ITHREADS */
+    
+    apr_pool_cleanup_register(p, data, mpxs_cleanup_run,
+                              apr_pool_cleanup_null);
+}
 
 static MP_INLINE
 int mpxs_Apache__ServerRec_push_handlers(pTHX_ server_rec *s,

Modified: perl/modperl/trunk/xs/maps/modperl_functions.map
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/maps/modperl_functions.map?view=diff&rev=111330&p1=perl/modperl/trunk/xs/maps/modperl_functions.map&r1=111329&p2=perl/modperl/trunk/xs/maps/modperl_functions.map&r2=111330
==============================================================================
--- perl/modperl/trunk/xs/maps/modperl_functions.map	(original)
+++ perl/modperl/trunk/xs/maps/modperl_functions.map	Wed Dec  8 17:04:38 2004
@@ -82,7 +82,7 @@
 
 MODULE=Apache::ServerUtil PACKAGE=Apache::ServerUtil
  mpxs_Apache__ServerUtil_server_root_relative | | p, fname=""
- apr_pool_t:DEFINE_base_server_pool
+ mpxs_Apache__ServerUtil_server_shutdown_register_cleanup | | cv, arg=Nullsv
  int:DEFINE_restart_count
 
 PACKAGE=Apache

Modified: perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm
Url: http://svn.apache.org/viewcvs/perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm?view=diff&rev=111330&p1=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r1=111329&p2=perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm&r2=111330
==============================================================================
--- perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm	(original)
+++ perl/modperl/trunk/xs/tables/current/ModPerl/FunctionTable.pm	Wed Dec  8 17:04:38 2004
@@ -2,7 +2,7 @@
 
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 # ! WARNING: generated by ModPerl::ParseSource/0.01
-# !          Tue Dec  7 13:02:32 2004
+# !          Wed Dec  8 19:43:35 2004
 # !          do NOT edit, any changes will be lost !
 # !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
@@ -7127,6 +7127,24 @@
       {
         'type' => 'const char *',
         'name' => 'fname'
+      }
+    ]
+  },
+  {
+    'return_type' => 'void',
+    'name' => 'mpxs_Apache__ServerUtil_server_shutdown_register_cleanup',
+    'args' => [
+      {
+        'type' => 'PerlInterpreter *',
+        'name' => 'my_perl'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'cv'
+      },
+      {
+        'type' => 'SV *',
+        'name' => 'arg'
       }
     ]
   },

Mime
View raw message