dougm 00/04/20 22:25:32
Modified: src/modules/perl mod_perl.c mod_perl.h modperl_callback.c
modperl_config.c modperl_config.h modperl_interp.c
modperl_interp.h modperl_types.h
Log:
integrate with generated register_hooks and command_rec entries
stash selected interpreter in r->per_request_config
Perl*Handlers are now hooked up and run!
some indenting fixups
Revision Changes Path
1.10 +4 -3 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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- mod_perl.c 2000/04/18 22:59:14 1.9
+++ mod_perl.c 2000/04/21 05:25:30 1.10
@@ -15,6 +15,8 @@
);
#endif
+ argv = modperl_srv_config_argv_init(scfg, &argc);
+
if (!(perl = perl_alloc())) {
perror("perl_alloc");
exit(1);
@@ -22,8 +24,6 @@
perl_construct(perl);
- argv = modperl_srv_config_argv_init(scfg, &argc);
-
status = perl_parse(perl, xs_init, argc, argv, NULL);
if (status) {
@@ -62,6 +62,7 @@
{
/* XXX: should be pre_config hook or 1.xx logic */
ap_hook_open_logs(modperl_hook_init, NULL, NULL, HOOK_MIDDLE);
+ modperl_register_handler_hooks();
}
static command_rec modperl_cmds[] = {
@@ -79,7 +80,7 @@
MP_SRV_CMD_TAKE1("PerlInterpMinSpare", interp_min_spare,
"Min number of spare Perl interpreters"),
#endif
- MP_CMD_POST_READ_REQUEST_ENTRY,
+ MP_CMD_ENTRIES,
{ NULL },
};
1.10 +1 -0 modperl-2.0/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.h,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- mod_perl.h 2000/04/17 21:29:41 1.9
+++ mod_perl.h 2000/04/21 05:25:30 1.10
@@ -19,6 +19,7 @@
#include "http_log.h"
#include "http_protocol.h"
#include "http_main.h"
+#include "http_request.h"
#include "apr_lock.h"
1.2 +101 -16 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_callback.c 2000/04/18 22:58:10 1.1
+++ modperl_callback.c 2000/04/21 05:25:31 1.2
@@ -59,8 +59,8 @@
GvNAME(CvGV(cv)));
}
MP_TRACE_h(MP_FUNC, "caching %s::%s\n",
- HvNAME(GvSTASH(CvGV(cv))),
- GvNAME(CvGV(cv)));
+ HvNAME(GvSTASH(CvGV(cv))),
+ GvNAME(CvGV(cv)));
}
int modperl_handler_lookup(pTHX_ modperl_handler_t *handler,
@@ -72,7 +72,7 @@
if (!stash) {
MP_TRACE_h(MP_FUNC, "class %s not defined, attempting to load\n",
- class);
+ class);
require_module(aTHX_ class);
if (SvTRUE(ERRSV)) {
MP_TRACE_h(MP_FUNC, "failed to load %s class\n", class);
@@ -82,7 +82,7 @@
MP_TRACE_h(MP_FUNC, "loaded %s class\n", class);
if (!(stash = gv_stashpv(class, FALSE))) {
MP_TRACE_h(MP_FUNC, "%s package still does not exist\n",
- class);
+ class);
return 0;
}
}
@@ -100,14 +100,14 @@
MpHandlerPARSED_On(handler);
MP_TRACE_h(MP_FUNC, "found `%s' in class `%s' as a %s\n",
- name, HvNAME(stash),
- MpHandlerMETHOD(handler) ? "method" : "function");
+ name, HvNAME(stash),
+ MpHandlerMETHOD(handler) ? "method" : "function");
return 1;
}
MP_TRACE_h(MP_FUNC, "`%s' not found in class `%s'\n",
- name, HvNAME(stash));
+ name, HvNAME(stash));
return 0;
}
@@ -119,7 +119,7 @@
if (!MpHandlerPARSED(handler)) {
if (was_parsed) {
MP_TRACE_h(MP_FUNC, "handler %s was parsed, but not flagged\n",
- handler->name);
+ handler->name);
}
else {
MP_TRACE_h(MP_FUNC, "handler %s was never parsed\n", handler->name);
@@ -170,8 +170,7 @@
if ((tmp = strstr(name, "->"))) {
char class[256]; /*XXX*/
int class_len = strlen(name) - strlen(tmp);
- strncpy(class, name, class_len+1);
- class[class_len] = '\0';
+ ap_cpystrn(class, name, class_len+1);
MpHandlerMETHOD_On(handler);
handler->cv = newSVpv(&tmp[2], 0);
@@ -184,11 +183,11 @@
if (SvROK(obj) && sv_isobject(obj)) {
MpHandlerOBJECT_On(handler);
MP_TRACE_h(MP_FUNC, "handler object %s isa %s\n",
- class, HvNAME(SvSTASH((SV*)SvRV(obj))));
+ class, HvNAME(SvSTASH((SV*)SvRV(obj))));
}
else {
MP_TRACE_h(MP_FUNC, "%s is not an object, pv=%s\n",
- class, SvPV_nolen(obj));
+ class, SvPV_nolen(obj));
}
}
else {
@@ -200,7 +199,7 @@
if (!handler->obj) {
handler->obj = newSVpv(class, class_len);
MP_TRACE_h(MP_FUNC, "handler method %s isa %s\n",
- SvPVX(handler->cv), class);
+ SvPVX(handler->cv), class);
}
MpHandlerPARSED_On(handler);
@@ -228,13 +227,13 @@
if (!MpHandlerPARSED(handler)) {
if (!modperl_handler_parse(aTHX_ handler)) {
MP_TRACE_h(MP_FUNC, "failed to parse handler `%s'\n",
- handler->name);
+ handler->name);
return HTTP_INTERNAL_SERVER_ERROR;
}
}
ENTER;SAVETMPS;
- PUSHMARK(sp);
+ PUSHMARK(SP);
if (MpHandlerMETHOD(handler)) {
XPUSHs(handler->obj);
@@ -242,7 +241,8 @@
if (handler->args) {
I32 i, len = AvFILL(handler->args);
- EXTEND(sp, len);
+
+ EXTEND(SP, len);
for (i=0; i<=len; i++) {
PUSHs(sv_2mortal(*av_fetch(handler->args, i, FALSE)));
}
@@ -275,4 +275,89 @@
}
return status;
+}
+
+#define MP_HANDLER_TYPE_DIR 1
+#define MP_HANDLER_TYPE_SRV 2
+
+int modperl_run_handlers(int idx, request_rec *r, server_rec *s, int type)
+{
+ pTHX;
+ MP_dSCFG(s);
+ modperl_handler_t **handlers;
+ MpAV *av;
+ int i, status;
+#ifdef MP_TRACE
+ const char *desc;
+#endif
+
+ if (type == MP_HANDLER_TYPE_DIR) {
+ MP_dDCFG;
+ av = dcfg->handlers[idx];
+ MP_TRACE_a_do(desc = modperl_per_dir_handler_desc(idx));
+ }
+ else {
+ av = scfg->handlers[idx];
+ MP_TRACE_a_do(desc = modperl_per_srv_handler_desc(idx));
+ }
+
+ if (!av) {
+ MP_TRACE_h(MP_FUNC, "no %s handlers configured (%s)\n",
+ desc, r ? r->uri : "");
+ return DECLINED;
+ }
+
+ if (r) {
+ MP_dRCFG;
+ if (!rcfg) {
+ rcfg = modperl_request_config_new(r);
+ ap_set_module_config(r->request_config, &perl_module, rcfg);
+ }
+#ifdef USE_ITHREADS
+ aTHX = rcfg->interp->perl;
+#endif
+ }
+#ifdef USE_ITHREADS
+ else if (s) {
+ /* Child{Init,Exit} */
+ aTHX = scfg->mip->parent->perl;
+ }
+#endif
+
+ MP_TRACE_h(MP_FUNC, "running %d %s handlers\n",
+ av->nelts, desc);
+ handlers = (modperl_handler_t **)av->elts;
+
+ for (i=0; i<av->nelts; i++) {
+ status = modperl_callback(aTHX_ handlers[i]);
+ MP_TRACE_h(MP_FUNC, "%s returned %d\n",
+ handlers[i]->name, status);
+ }
+
+ return status;
+}
+
+int modperl_per_dir_callback(int idx, request_rec *r)
+{
+ return modperl_run_handlers(idx, r, r->server, MP_HANDLER_TYPE_DIR);
+}
+
+int modperl_per_srv_callback(int idx, request_rec *r)
+{
+ return modperl_run_handlers(idx, r, r->server, MP_HANDLER_TYPE_SRV);
+}
+
+int modperl_connection_callback(int idx, conn_rec *c)
+{
+ return DECLINED;
+}
+
+void modperl_process_callback(int idx, ap_pool_t *p, server_rec *s)
+{
+}
+
+void modperl_files_callback(int idx,
+ ap_pool_t *pconf, ap_pool_t *plog,
+ ap_pool_t *ptemp, server_rec *s)
+{
}
1.8 +46 -7 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_config.c 2000/04/18 22:59:15 1.7
+++ modperl_config.c 2000/04/21 05:25:31 1.8
@@ -19,14 +19,40 @@
void *modperl_create_dir_config(ap_pool_t *p, char *dir)
{
- return NULL;
+ modperl_dir_config_t *dcfg = modperl_dir_config_new(p);
+ return dcfg;
}
-void *modperl_merge_dir_config(ap_pool_t *p, void *base, void *add)
+void *modperl_merge_dir_config(ap_pool_t *p, void *basev, void *addv)
{
- return NULL;
+#if 0
+ modperl_dir_config_t
+ *base = (modperl_dir_config_t *)basev,
+ *add = (modperl_dir_config_t *)addv,
+ *mrg = modperl_dir_config_new(p);
+#endif
+
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv);
+
+ return addv;
}
+modperl_request_config_t *modperl_request_config_new(request_rec *r)
+{
+ modperl_request_config_t *rcfg =
+ (modperl_request_config_t *)ap_pcalloc(r->pool, sizeof(*rcfg));
+
+#ifdef USE_ITHREADS
+ rcfg->interp = modperl_interp_select(r);
+ PERL_SET_INTERP(rcfg->interp->perl);
+#endif
+
+ MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)rcfg);
+
+ return rcfg;
+}
+
#define scfg_push_argv(arg) \
*(char **)ap_push_array(scfg->argv) = arg
@@ -39,9 +65,21 @@
scfg_push_argv((char *)ap_server_argv0);
+ MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)scfg);
+
return scfg;
}
+modperl_dir_config_t *modperl_dir_config_new(ap_pool_t *p)
+{
+ modperl_dir_config_t *dcfg = (modperl_dir_config_t *)
+ ap_pcalloc(p, sizeof(modperl_dir_config_t));
+
+ MP_TRACE_d(MP_FUNC, "0x%lx\n", (unsigned long)dcfg);
+
+ return dcfg;
+}
+
#ifdef MP_TRACE
static void dump_argv(modperl_srv_config_t *scfg)
{
@@ -95,11 +133,12 @@
*base = (modperl_srv_config_t *)basev,
*add = (modperl_srv_config_t *)addv,
*mrg = modperl_srv_config_new(p);
-
- return mrg;
-#else
- return basev;
#endif
+
+ MP_TRACE_d(MP_FUNC, "basev==0x%lx, addv==0x%lx\n",
+ (unsigned long)basev, (unsigned long)addv);
+
+ return addv;
}
#define MP_CONFIG_BOOTSTRAP(parms) \
1.8 +5 -1 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_config.h 2000/04/18 22:59:15 1.7
+++ modperl_config.h 2000/04/21 05:25:31 1.8
@@ -3,9 +3,13 @@
void *modperl_create_dir_config(ap_pool_t *p, char *dir);
-void *modperl_merge_dir_config(ap_pool_t *p, void *base, void *add);
+void *modperl_merge_dir_config(ap_pool_t *p, void *basev, void *addv);
modperl_srv_config_t *modperl_srv_config_new(ap_pool_t *p);
+
+modperl_dir_config_t *modperl_dir_config_new(ap_pool_t *p);
+
+modperl_request_config_t *modperl_request_config_new(request_rec *r);
void *modperl_create_srv_config(ap_pool_t *p, server_rec *s);
1.8 +7 -24 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_interp.c 2000/04/17 07:10:55 1.7
+++ modperl_interp.c 2000/04/21 05:25:31 1.8
@@ -102,8 +102,9 @@
while (head) {
if (!MpInterpIN_USE(head)) {
interp = head;
- MP_TRACE_i(MP_FUNC, "selected 0x%lx\n",
- (unsigned long)interp);
+ MP_TRACE_i(MP_FUNC, "selected 0x%lx (perl==0x%lx)\n",
+ (unsigned long)interp,
+ (unsigned long)interp->perl);
#ifdef _PTHREAD_H
MP_TRACE_i(MP_FUNC, "pthread_self == 0x%lx\n",
(unsigned long)pthread_self());
@@ -247,12 +248,6 @@
ap_register_cleanup(p, (void*)mip,
modperl_interp_pool_destroy, ap_null_cleanup);
-
- /* XXX: should only bother selecting an interpreter
- * if one is needed for the request
- */
- ap_hook_post_read_request(modperl_interp_select, NULL, NULL, HOOK_FIRST);
-
scfg->mip = mip;
}
@@ -288,26 +283,14 @@
return APR_SUCCESS;
}
-int modperl_interp_select(request_rec *r)
+modperl_interp_t *modperl_interp_select(request_rec *r)
{
modperl_interp_t *interp = modperl_interp_get(r->server);
-
- /* XXX: stash interp pointer in r->per_request */
- if (MpInterpPUTBACK(interp)) {
- ap_register_cleanup(r->pool, (void*)interp,
- modperl_interp_unselect, ap_null_cleanup);
- }
-
- if (1) { /* testing concurrent callbacks into the Perl runtime(s) */
- dTHXa(interp->perl);
- SV *sv = get_sv("Apache::Server::Perl", TRUE);
- sv_setref_pv(sv, Nullch, (void*)interp->perl);
- eval_pv("printf STDERR qq(Perl == 0x%lx\n), "
- "$$Apache::Server::Perl", TRUE);
- }
+ ap_register_cleanup(r->pool, (void*)interp,
+ modperl_interp_unselect, ap_null_cleanup);
- return OK;
+ return interp;
}
#else
1.5 +1 -1 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.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_interp.h 2000/04/16 01:33:56 1.4
+++ modperl_interp.h 2000/04/21 05:25:31 1.5
@@ -18,7 +18,7 @@
ap_status_t modperl_interp_unselect(void *data);
-int modperl_interp_select(request_rec *r);
+modperl_interp_t *modperl_interp_select(request_rec *r);
ap_status_t modperl_interp_pool_destroy(void *data);
1.9 +4 -1 modperl-2.0/src/modules/perl/modperl_types.h
Index: modperl_types.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_types.h,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_types.h 2000/04/18 22:59:15 1.8
+++ modperl_types.h 2000/04/21 05:25:31 1.9
@@ -98,8 +98,11 @@
} modperl_dir_config_t;
typedef struct {
+#ifdef USE_ITHREADS
+ modperl_interp_t *interp;
+#endif
HV *pnotes;
-} modperl_per_request_config_t;
+} modperl_request_config_t;
typedef struct {
SV *obj; /* object or classname if cv is a method */
