dougm 00/04/15 10:51:45
Modified: lib/ModPerl Code.pm
src/modules/perl modperl_interp.c modperl_interp.h
Log:
move interpreter teardown into modperl_interp_destroy
provide modperl_interp_cleanup to assist with throttling
Revision Changes Path
1.6 +4 -2 modperl-2.0/lib/ModPerl/Code.pm
Index: Code.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- Code.pm 2000/04/15 01:43:17 1.5
+++ Code.pm 2000/04/15 17:51:44 1.6
@@ -69,7 +69,8 @@
my %flags = (
Srv => [qw(NONE PERL_TAINT_CHECK PERL_WARN FRESH_RESTART)],
Dir => [qw(NONE INCPUSH SENDHDR SENTHDR ENV CLEANUP RCLEANUP)],
- Interp => [qw(NONE IN_USE PUTBACK)],
+ Interp => [qw(NONE IN_USE PUTBACK CLONED)],
+ Handler => [qw(NONE METHOD)],
);
sub new {
@@ -271,8 +272,9 @@
generate_trace => {h => 'modperl_trace.h'},
);
+my @c_src_names = qw(interp log);
my @g_c_names = map { "modperl_$_" } qw(hooks directives);
-my @c_names = (qw(mod_perl modperl_interp modperl_log), @g_c_names);
+my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names), @g_c_names);
sub c_files { map { "$_.c" } @c_names }
sub o_files { map { "$_.o" } @c_names }
1.3 +26 -14 modperl-2.0/src/modules/perl/modperl_interp.c
Index: modperl_interp.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_interp.c 2000/04/15 01:38:45 1.2
+++ modperl_interp.c 2000/04/15 17:51:44 1.3
@@ -20,6 +20,29 @@
return interp;
}
+void modperl_interp_destroy(modperl_interp_t *interp)
+{
+ dTHXa(interp->perl);
+
+ MP_TRACE_i(MP_FUNC, "interp == 0x%lx\n",
+ (unsigned long)interp);
+
+ if (MpInterpIN_USE(interp)) {
+ MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
+ }
+
+
+ PL_perl_destruct_level = 2;
+ perl_destruct(interp->perl);
+ perl_free(interp->perl);
+}
+
+ap_status_t modperl_interp_cleanup(void *data)
+{
+ modperl_interp_destroy((modperl_interp_t *)data);
+ return APR_SUCCESS;
+}
+
modperl_interp_t *modperl_interp_get(server_rec *s)
{
MP_dSCFG(s);
@@ -82,18 +105,7 @@
modperl_interp_pool_t *mip = (modperl_interp_pool_t *)data;
while (mip->head) {
- dTHXa(mip->head->perl);
-
- MP_TRACE_i(MP_FUNC, "head == 0x%lx\n",
- (unsigned long)mip->head);
- if (MpInterpIN_USE(mip->head)) {
- MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
- }
-
- PL_perl_destruct_level = 2;
- perl_destruct(mip->head->perl);
- perl_free(mip->head->perl);
-
+ modperl_interp_destroy(mip->head);
mip->head->perl = NULL;
mip->head = mip->head->next;
}
@@ -101,8 +113,7 @@
MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
(unsigned long)mip->parent);
- perl_destruct(mip->parent->perl);
- perl_free(mip->parent->perl);
+ modperl_interp_destroy(mip->parent);
mip->parent->perl = NULL;
ap_destroy_lock(mip->mip_lock);
@@ -136,6 +147,7 @@
for (i=0; i<mip->start; i++) {
modperl_interp_t *interp = modperl_interp_new(p, mip->parent);
interp->perl = perl_clone(perl, TRUE);
+ MpInterpCLONED_On(interp);
if (cur_interp) {
cur_interp->next = interp;
1.2 +4 -0 modperl-2.0/src/modules/perl/modperl_interp.h
Index: modperl_interp.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_interp.h,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_interp.h 2000/04/14 23:51:58 1.1
+++ modperl_interp.h 2000/04/15 17:51:44 1.2
@@ -4,6 +4,10 @@
modperl_interp_t *modperl_interp_new(ap_pool_t *p,
modperl_interp_t *parent);
+void modperl_interp_destroy(modperl_interp_t *interp);
+
+ap_status_t modperl_interp_cleanup(void *data);
+
modperl_interp_t *modperl_interp_get(server_rec *s);
void modperl_interp_pool_init(server_rec *s, ap_pool_t *p,
