cvs commit: modperl-2.0/src/modules/perl modperl_interp.c
dougm 01/03/13 22:57:44
Modified:src/modules/perl modperl_interp.c
Log:
share selected Perl interpreter across sub-requests by default
Revision ChangesPath
1.21 +10 -5 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.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- modperl_interp.c 2001/03/14 05:22:49 1.20
+++ modperl_interp.c 2001/03/14 06:57:43 1.21
@@ -202,12 +202,14 @@
*/
#define MP_INTERP_KEY "MODPERL_INTERP"
-modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c,
+modperl_interp_t *modperl_interp_select(request_rec *rr, conn_rec *c,
server_rec *s)
{
MP_dSCFG(s);
modperl_interp_t *interp;
apr_pool_t *p = NULL;
+int is_subrequest = (rr && rr->main) ? 1 : 0;
+request_rec *r = is_subrequest ? rr->main : rr;
const char *desc = NULL;
int lifetime_connection =
(modperl_interp_lifetime_connection(scfg) || !r);
@@ -231,8 +233,9 @@
if (interp) {
MP_TRACE_i(MP_FUNC,
- "found interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc, (unsigned long)r->pool);
+ "found interp 0x%lx in %s 0x%lx (%s request for %s)\n",
+ (unsigned long)interp, desc, (unsigned long)r->pool,
+ (is_subrequest ? "sub" : "main"), rr->uri);
return interp;
}
@@ -267,8 +270,10 @@
/* set context (THX) for this thread */
PERL_SET_CONTEXT(interp->perl);
-MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx\n",
- (unsigned long)interp, desc, (unsigned long)p);
+MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx (%s request for %s)\n",
+ (unsigned long)interp, desc, (unsigned long)p,
+ (r ? (is_subrequest ? "sub" : "main") : "conn"),
+ (r ? rr->uri : c->remote_ip));
return interp;
}
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_callback.c modperl_config.c modperl_config.h modperl_interp.c modperl_types.h modperl_util.h
dougm 01/03/13 21:22:51
Modified:src/modules/perl mod_perl.c modperl_callback.c
modperl_config.c modperl_config.h modperl_interp.c
modperl_types.h modperl_util.h
Log:
add PerlInterpLifetime directive
default is request, when set to connection selected interpreter
is held for lifetime of the connection
Revision ChangesPath
1.31 +5 -0 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.30
retrieving revision 1.31
diff -u -r1.30 -r1.31
--- mod_perl.c2001/03/14 04:22:51 1.30
+++ mod_perl.c2001/03/14 05:22:49 1.31
@@ -127,6 +127,9 @@
MP_dSCFG(s);
#ifdef MP_TRACE
char *name = modperl_server_desc(s, p);
+
+MP_TRACE_i(MP_FUNC, "PerlInterpLifetime set to %s for %s\n",
+ modperl_interp_lifetime_desc(scfg), name);
#endif /* MP_TRACE */
if (scfg->mip->tipool->idle) {
@@ -217,6 +220,8 @@
"Min number of spare Perl interpreters"),
MP_SRV_CMD_TAKE1("PerlInterpMaxRequests", interp_max_requests,
"Max number of requests per Perl interpreters"),
+MP_SRV_CMD_TAKE1("PerlInterpLifetime", interp_lifetime,
+ "Lifetime of a Perl interpreter (connection or request)"),
#endif
MP_CMD_ENTRIES,
{ NULL },
1.25 +3 -0 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.24
retrieving revision 1.25
diff -u -r1.24 -r1.25
--- modperl_callback.c2001/03/14 00:37:52 1.24
+++ modperl_callback.c2001/03/14 05:22:49 1.25
@@ -202,6 +202,9 @@
}
#ifdef USE_ITHREADS
+if (r && !c && modperl_interp_lifetime_connection(scfg)) {
+c = r->connection;
+}
if (r || c) {
p = c ? c->pool : r->pool;
interp = modperl_interp_select(r, c, s);
1.19 +34 -0 modperl-2.0/src/modules/perl/modperl_config.c
Index: modperl_config.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.c,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- modperl_config.c 2001/03/09 23:46:35 1.18
+++ modperl_config.c 2001/03/14 05:22:49 1.19
@@ -127,6 +127,8 @@
(modperl_tipool_config_t *)
apr_pcalloc(p, sizeof(*scfg->interp_pool_cfg));
+scfg->interp_lifetime = MP_INTERP_LIFETIME_REQUEST;
+
/* XXX: determine reasonable defaults */
scfg->interp_pool_cfg->start = 3;
scfg->interp_pool_cfg->max_spare = 3;
@@ -155,6 +157,7 @@
#ifdef USE_ITHREADS
merge_item(mip);
merge_item(interp_pool_cfg);
+merge_item(interp_lifetime);
#else
merge_item(perl);
#endif
@@ -221,6 +224,37 @@
}
#ifdef USE_ITHREADS
+
+static const char *MP_interp_lifetime_desc[] = {
+"none", "request", "connection",
+};
+
+const char *modperl_interp_lifetime_desc(modperl_srv_config_t *scfg)
+{
+return MP_interp_lifetime_desc[scfg->interp_lifetime];
+}
+
+MP_DECLARE_SRV_CMD(interp_lifetime)
+{
+MP_dSCFG(parms->server);
+
+switch (toLOWER(*arg)) {
+ case 'r':
+if (strcaseEQ(arg, "request")) {
+scfg->interp_lifetime = MP_INTERP_LIFETIME_REQUEST;
+break;
+}
+ case 'c':
+if (strcaseEQ(arg, "connection")) {
+scfg->interp_lifetime = MP_INTERP_LIFETIME_CONNECTION;
+break;
+}
+ default:
+return "PerlInterpLifetime must be one of connection or request";
+};
+
+return NULL;
+}
#define MP_IMP_INTERP_POOL_CFG(xitem) \
const char *modperl_cmd_interp_##xitem(cmd_parms *parms, \
1.18 +10 -0 modperl-2.0/src/modules/perl/modperl_config.h
Index: modperl_config.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_config.h,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -r1.17 -r1.18
--- modperl_config.h 2001/03/09 23:46:35 1.17
+++ modperl_config.h 2001/03/14 05:22:49 1.18
@@ -33,6 +33,16 @@
MP_DECLARE_SRV_CMD(interp_max_spare);
MP_DECLARE_SRV_CMD(interp_min_spare);
MP_DECLARE_SRV_CMD(interp_max_requests);
+MP_DECLARE_SRV_CMD(interp_lifetime);
+
+const char *modperl_interp_lifetime_desc(modperl_srv_config_t *scfg);
+
+#define modperl_interp_lifetime_connection(scfg) \
+(scfg->interp_l
cvs commit: modperl-2.0/src/modules/perl mod_perl.c modperl_util.c modperl_util.h
dougm 01/03/13 20:22:51
Modified:src/modules/perl mod_perl.c modperl_util.c modperl_util.h
Log:
add modperl_server_desc() function
add more trace details when initializing the interpreter pool
Revision ChangesPath
1.30 +25 -6 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.29
retrieving revision 1.30
diff -u -r1.29 -r1.30
--- mod_perl.c2001/03/09 23:46:34 1.29
+++ mod_perl.c2001/03/14 04:22:51 1.30
@@ -93,7 +93,7 @@
*/
if (MpSrvPARENT(scfg) || MpSrvCLONE(scfg)) {
MP_TRACE_i(MP_FUNC, "modperl_interp_init() server=%s\n",
- s->server_hostname);
+ modperl_server_desc(s, p));
modperl_interp_init(s, p, perl);
}
@@ -118,20 +118,39 @@
#ifdef USE_ITHREADS
static void modperl_init_clones(server_rec *s, apr_pool_t *p)
{
+#ifdef MP_TRACE
+modperl_srv_config_t *base_scfg = modperl_srv_config_get(s);
+char *base_name = modperl_server_desc(s, p);
+#endif /* MP_TRACE */
+
for (; s; s=s->next) {
MP_dSCFG(s);
+#ifdef MP_TRACE
+char *name = modperl_server_desc(s, p);
+#endif /* MP_TRACE */
+
if (scfg->mip->tipool->idle) {
-MP_TRACE_i(MP_FUNC, "%s interp already cloned\n",
- s->server_hostname);
+#ifdef MP_TRACE
+if (scfg->mip == base_scfg->mip) {
+MP_TRACE_i(MP_FUNC,
+ "%s interp pool inherited from %s\n",
+ name, base_name);
+}
+else {
+MP_TRACE_i(MP_FUNC,
+ "%s interp pool already initialized\n",
+ name);
+}
+#endif /* MP_TRACE */
}
else {
-MP_TRACE_i(MP_FUNC, "cloning interp for %s\n",
- s->server_hostname);
+MP_TRACE_i(MP_FUNC, "initializing interp pool for %s\n",
+ name);
modperl_tipool_init(scfg->mip->tipool);
}
}
}
-#endif
+#endif /* USE_ITHREADS */
void modperl_hook_init(apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
1.5 +5 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_util.c2001/03/13 05:09:02 1.4
+++ modperl_util.c2001/03/14 04:22:51 1.5
@@ -81,3 +81,8 @@
return status;
}
+
+char *modperl_server_desc(server_rec *s, apr_pool_t *p)
+{
+return apr_psprintf(p, "%s:%u", s->server_hostname, s->port);
+}
1.5 +2 -0 modperl-2.0/src/modules/perl/modperl_util.h
Index: modperl_util.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_util.h2001/03/09 23:46:36 1.4
+++ modperl_util.h2001/03/14 04:22:51 1.5
@@ -20,4 +20,6 @@
int modperl_require_module(pTHX_ const char *pv);
+char *modperl_server_desc(server_rec *s, apr_pool_t *p);
+
#endif /* MODPERL_UTIL_H */
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_callback.h modperl_filter.c
dougm 01/03/13 16:37:53
Modified:src/modules/perl modperl_callback.c modperl_callback.h
modperl_filter.c
Log:
pass an AV** rather than AV* to modperl_handler_make_args(), which will create the
newAV() if needed
Revision ChangesPath
1.24 +11 -8 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.23
retrieving revision 1.24
diff -u -r1.23 -r1.24
--- modperl_callback.c2001/03/14 00:20:52 1.23
+++ modperl_callback.c2001/03/14 00:37:52 1.24
@@ -18,11 +18,15 @@
return modperl_handler_new(p, h->name);
}
-void modperl_handler_make_args(pTHX_ AV *av, ...)
+void modperl_handler_make_args(pTHX_ AV **avp, ...)
{
va_list args;
-va_start(args, av);
+if (!*avp) {
+*avp = newAV(); /* XXX: cache an intialized AV* per-request */
+}
+
+va_start(args, avp);
for (;;) {
char *classname = va_arg(args, char *);
@@ -51,7 +55,7 @@
break;
}
-av_push(av, sv);
+av_push(*avp, sv);
}
va_end(args);
@@ -213,16 +217,15 @@
MP_TRACE_h(MP_FUNC, "running %d %s handlers\n",
av->nelts, desc);
handlers = (modperl_handler_t **)av->elts;
-av_args = newAV();
switch (type) {
case MP_HANDLER_TYPE_DIR:
case MP_HANDLER_TYPE_SRV:
-modperl_handler_make_args(aTHX_ av_args,
+modperl_handler_make_args(aTHX_ &av_args,
"Apache::RequestRec", r, NULL);
break;
case MP_HANDLER_TYPE_CONN:
-modperl_handler_make_args(aTHX_ av_args,
+modperl_handler_make_args(aTHX_ &av_args,
"Apache::Connection", c, NULL);
break;
case MP_HANDLER_TYPE_FILE:
@@ -235,7 +238,7 @@
ptemp = va_arg(args, apr_pool_t *);
va_end(args);
- modperl_handler_make_args(aTHX_ av_args,
+ modperl_handler_make_args(aTHX_ &av_args,
"Apache::Pool", pconf,
"Apache::Pool", plog,
"Apache::Pool", ptemp,
@@ -254,7 +257,7 @@
p = pconf;
}
- modperl_handler_make_args(aTHX_ av_args,
+ modperl_handler_make_args(aTHX_ &av_args,
"Apache::Pool", pconf,
"Apache::Server", s, NULL);
}
1.12 +1 -1 modperl-2.0/src/modules/perl/modperl_callback.h
Index: modperl_callback.h
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.h,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- modperl_callback.h2001/03/09 23:46:35 1.11
+++ modperl_callback.h2001/03/14 00:37:52 1.12
@@ -21,7 +21,7 @@
modperl_handler_t *modperl_handler_dup(apr_pool_t *p,
modperl_handler_t *h);
-void modperl_handler_make_args(pTHX_ AV *avp, ...);
+void modperl_handler_make_args(pTHX_ AV **avp, ...);
int modperl_callback(pTHX_ modperl_handler_t *handler, apr_pool_t *p,
AV *args);
1.8 +2 -4 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_filter.c 2001/03/14 00:03:29 1.7
+++ modperl_filter.c 2001/03/14 00:37:52 1.8
@@ -81,7 +81,7 @@
int modperl_run_filter(modperl_filter_t *filter)
{
-AV *args;
+AV *args = Nullav;
int status;
modperl_handler_t *handler =
((modperl_filter_ctx_t *)filter->f->ctx)->handler;
@@ -93,9 +93,7 @@
MP_dINTERP_SELECT(r, c, s);
-args = newAV();
-
-modperl_handler_make_args(aTHX_ args,
+modperl_handler_make_args(aTHX_ &args,
filter_classes[filter->mode], filter,
NULL);
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c
dougm 01/03/13 16:20:53
Modified:src/modules/perl modperl_callback.c
Log:
add support for IV and PV in modperl_handler_make_args()
Revision ChangesPath
1.23 +16 -1 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -r1.22 -r1.23
--- modperl_callback.c2001/03/13 23:55:18 1.22
+++ modperl_callback.c2001/03/14 00:20:52 1.23
@@ -35,7 +35,22 @@
ptr = va_arg(args, void *);
-sv = modperl_ptr2obj(aTHX_ classname, ptr);
+switch (*classname) {
+ case 'I':
+if (strEQ(classname, "IV")) {
+sv = ptr ? newSViv((IV)ptr) : &PL_sv_undef;
+break;
+}
+ case 'P':
+if (strEQ(classname, "PV")) {
+sv = ptr ? newSVpv((char *)ptr, 0) : &PL_sv_undef;
+break;
+}
+ default:
+sv = modperl_ptr2obj(aTHX_ classname, ptr);
+break;
+}
+
av_push(av, sv);
}
cvs commit: modperl-2.0/src/modules/perl modperl_filter.c modperl_interp.h
dougm 01/03/13 16:03:31 Modified:src/modules/perl modperl_filter.c modperl_interp.h Log: add MP_dINTERP_SELECT macro so caller doesnt need to deal with THX Revision ChangesPath 1.7 +1 -6 modperl-2.0/src/modules/perl/modperl_filter.c Index: modperl_filter.c === RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v retrieving revision 1.6 retrieving revision 1.7 diff -u -r1.6 -r1.7 --- modperl_filter.c 2001/03/13 23:55:19 1.6 +++ modperl_filter.c 2001/03/14 00:03:29 1.7 @@ -91,12 +91,7 @@ server_rec *s = r ? r->server : NULL; apr_pool_t *p = r ? r->pool : c->pool; -#ifdef USE_ITHREADS -pTHX; -modperl_interp_t *interp = NULL; -interp = modperl_interp_select(r, c, s); -aTHX = interp->perl; -#endif +MP_dINTERP_SELECT(r, c, s); args = newAV(); 1.8 +8 -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.7 retrieving revision 1.8 diff -u -r1.7 -r1.8 --- modperl_interp.h 2000/08/14 03:10:45 1.7 +++ modperl_interp.h 2001/03/14 00:03:29 1.8 @@ -21,6 +21,12 @@ modperl_interp_t *modperl_interp_select(request_rec *r, conn_rec *c, server_rec *s); +#define MP_dINTERP_SELECT(r, c, s) \ +pTHX; \ +modperl_interp_t *interp = NULL; \ +interp = modperl_interp_select(r, c, s); \ +aTHX = interp->perl + apr_status_t modperl_interp_pool_destroy(void *data); void modperl_interp_pool_add(modperl_interp_pool_t *mip, @@ -29,6 +35,8 @@ void modperl_interp_pool_remove(modperl_interp_pool_t *mip, modperl_interp_t *interp); +#else +#define MP_dINTERP_SELECT(r, c, s) dNOOP #endif #endif /* MODPERL_INTERP_H */
cvs commit: modperl-2.0/src/modules/perl modperl_callback.c modperl_filter.c modperl_interp.c
dougm 01/03/13 15:55:21
Modified:src/modules/perl modperl_callback.c modperl_filter.c
modperl_interp.c
Log:
modperl_interp_select() will PERL_SET_CONTEXT for the given thread, so the caller
does not need to
Revision ChangesPath
1.22 +1 -1 modperl-2.0/src/modules/perl/modperl_callback.c
Index: modperl_callback.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- modperl_callback.c2001/03/09 23:46:35 1.21
+++ modperl_callback.c2001/03/13 23:55:18 1.22
@@ -191,8 +191,8 @@
else {
/* Child{Init,Exit}, OpenLogs */
aTHX = scfg->mip->parent->perl;
+PERL_SET_CONTEXT(aTHX);
}
-PERL_SET_CONTEXT(aTHX);
#endif
MP_TRACE_h(MP_FUNC, "running %d %s handlers\n",
1.6 +0 -1 modperl-2.0/src/modules/perl/modperl_filter.c
Index: modperl_filter.c
===
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_filter.c,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_filter.c 2001/03/09 23:46:35 1.5
+++ modperl_filter.c 2001/03/13 23:55:19 1.6
@@ -96,7 +96,6 @@
modperl_interp_t *interp = NULL;
interp = modperl_interp_select(r, c, s);
aTHX = interp->perl;
-PERL_SET_CONTEXT(aTHX);
#endif
args = newAV();
1.19 +3 -0 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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- modperl_interp.c 2001/03/09 23:46:35 1.18
+++ modperl_interp.c 2001/03/13 23:55:20 1.19
@@ -261,6 +261,9 @@
modperl_interp_unselect,
p);
+/* set context (THX) for this thread */
+PERL_SET_CONTEXT(interp->perl);
+
MP_TRACE_i(MP_FUNC, "set interp 0x%lx in %s 0x%lx\n",
(unsigned long)interp, desc, (unsigned long)p);
