here's another pass that incorporates the suggestions thus far. comments on
the global foo appreciated. the tests I posted before are still valid at
this point.
--Geoff
Index: lib/ModPerl/Code.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.117
diff -u -r1.117 Code.pm
--- lib/ModPerl/Code.pm 20 Feb 2004 14:11:31 -0000 1.117
+++ lib/ModPerl/Code.pm 29 Feb 2004 04:51:14 -0000
@@ -626,7 +626,7 @@
my @c_src_names = qw(interp tipool log config cmd options callback handler
gtop util io io_apache filter bucket mgv pcw global env
cgi perl perl_global perl_pp sys module svptr_table
- const constants apache_compat);
+ const constants apache_compat apache);
my @h_src_names = qw(perl_unembed);
my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names));
Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.208
diff -u -r1.208 mod_perl.c
--- src/modules/perl/mod_perl.c 13 Feb 2004 14:58:05 -0000 1.208
+++ src/modules/perl/mod_perl.c 29 Feb 2004 04:51:15 -0000
@@ -538,6 +538,13 @@
return MP_IS_RUNNING;
}
+/* PerlHook*Handler support */
+apr_table_t *hook_order;
+
+apr_table_t *modperl_get_hook_order() {
+ return hook_order;
+}
+
int modperl_hook_pre_config(apr_pool_t *p, apr_pool_t *plog,
apr_pool_t *ptemp)
{
@@ -546,6 +553,9 @@
/* perl 5.8.1+ */
modperl_hash_seed_init(p);
+ /* initialize global variable */
+ hook_order = apr_table_make(p, 0);
+
return OK;
}
@@ -573,6 +583,9 @@
modperl_trace_logfile_set(s->error_log);
#endif
+ /* fixup the placement of user-defined Perl*Handlers in the hook order */
+ modperl_apache_resort_hooks();
+
ap_add_version_component(pconf, MP_VERSION_STRING);
ap_add_version_component(pconf,
Perl_form(aTHX_ "Perl/v%vd", PL_patchlevel));
@@ -713,11 +726,15 @@
ap_hook_create_request(modperl_hook_create_request,
NULL, NULL, APR_HOOK_MIDDLE);
+ /* both of these hooks need to run really, really first.
+ * otherwise, the global request_rec will be set up _after_ some
+ * Perl handlers run.
+ */
ap_hook_post_read_request(modperl_hook_post_read_request,
- NULL, NULL, APR_HOOK_FIRST);
+ NULL, NULL, MODPERL_HOOK_REALLY_REALLY_FIRST);
ap_hook_header_parser(modperl_hook_header_parser,
- NULL, NULL, APR_HOOK_FIRST);
+ NULL, NULL, MODPERL_HOOK_REALLY_REALLY_FIRST);
ap_hook_child_init(modperl_hook_child_init,
NULL, NULL, APR_HOOK_FIRST);
@@ -778,6 +795,26 @@
MP_CMD_SRV_FLAG("PerlWarn", warn,
"Turn on -w switch"),
#endif
+ MP_CMD_SRV_TAKE1("PerlHookPostReadRequestHandler", hook_order,
+ "hook order for PerlPostReadRequestHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookTransHandler", hook_order,
+ "hook order for PerlTransHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookMapToStorageHandler", hook_order,
+ "hook order for PerlMapToStorageHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookHeaderParserHandler", hook_order,
+ "hook order for PerlHeaderParserHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAccessHandler", hook_order,
+ "hook order for PerlAccessHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAuthenHandler", hook_order,
+ "hook order for PerlAuthenHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookAuthzHandler", hook_order,
+ "hook order for PerlAuthzHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookTypeHandler", hook_order,
+ "hook order for PerlTypeHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookFixupHandler", hook_order,
+ "hook order for PerlFixupHandler"),
+ MP_CMD_SRV_TAKE1("PerlHookLogHandler", hook_order,
+ "hook order for PerlLogHandler"),
MP_CMD_ENTRIES,
{ NULL },
};
Index: src/modules/perl/mod_perl.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/mod_perl.h,v
retrieving revision 1.61
diff -u -r1.61 mod_perl.h
--- src/modules/perl/mod_perl.h 22 Sep 2003 17:43:41 -0000 1.61
+++ src/modules/perl/mod_perl.h 29 Feb 2004 04:51:15 -0000
@@ -75,6 +75,7 @@
#include "modperl_perl.h"
#include "modperl_svptr_table.h"
#include "modperl_module.h"
+#include "modperl_apache.h"
int modperl_init_vhost(server_rec *s, apr_pool_t *p,
server_rec *base_server);
@@ -107,5 +108,11 @@
typedef void MP_FUNC_T(modperl_table_modify_t) (apr_table_t *,
const char *,
const char *);
+
+/* we need to hook a few internal things before APR_HOOK_REALLY_FIRST */
+#define MODPERL_HOOK_REALLY_REALLY_FIRST (-20)
+
+/* PerlHook*Handler support */
+apr_table_t *modperl_get_hook_order(void);
#endif /* MOD_PERL_H */
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.57
diff -u -r1.57 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c 14 Feb 2004 04:25:01 -0000 1.57
+++ src/modules/perl/modperl_cmd.c 29 Feb 2004 04:51:16 -0000
@@ -142,6 +142,62 @@
return NULL;
}
+MP_CMD_SRV_DECLARE(hook_order)
+{
+ const char *name = parms->cmd->name;
+
+ int order;
+ apr_table_t *hook_order = modperl_get_hook_order();
+
+ /* main server only */
+ MP_CMD_SRV_CHECK;
+
+ /* I tried to put these in the order of utility, thus making
+ * a tedious task as efficient as possible
+ */
+ switch (*arg) {
+ case 'R':
+ case 'r':
+ /* useful */
+ if (! strcasecmp(arg, "ReallyLast")) {
+ order = APR_HOOK_REALLY_LAST;
+ break;
+ }
+ /* useful, but the default */
+ if (! strcasecmp(arg, "ReallyFirst")) {
+ order = APR_HOOK_REALLY_FIRST;
+ break;
+ }
+ case 'L':
+ case 'l':
+ /* also useful */
+ if (! strcasecmp(arg, "Last")) {
+ order = APR_HOOK_LAST;
+ break;
+ }
+ case 'F':
+ case 'f':
+ /* probably won't do what the user expects */
+ if (! strcasecmp(arg, "First")) {
+ order = APR_HOOK_FIRST;
+ break;
+ }
+ case 'M':
+ case 'm':
+ /* probably too vague to be useful */
+ if (! strcasecmp(arg, "Middle")) {
+ order = APR_HOOK_MIDDLE;
+ break;
+ }
+ default:
+ return apr_pstrcat(parms->pool, "invalid value for ",
+ name, ": ", arg, NULL);
+ }
+
+ apr_table_setn(hook_order, name, apr_itoa(parms->pool, order));
+ return NULL;
+}
+
static int modperl_vhost_is_running(server_rec *s)
{
#ifdef USE_ITHREADS
Index: src/modules/perl/modperl_cmd.h
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_cmd.h,v
retrieving revision 1.22
diff -u -r1.22 modperl_cmd.h
--- src/modules/perl/modperl_cmd.h 9 Feb 2004 18:18:16 -0000 1.22
+++ src/modules/perl/modperl_cmd.h 29 Feb 2004 04:51:16 -0000
@@ -42,6 +42,7 @@
MP_CMD_SRV_DECLARE(load_module);
MP_CMD_SRV_DECLARE(set_input_filter);
MP_CMD_SRV_DECLARE(set_output_filter);
+MP_CMD_SRV_DECLARE(hook_order);
#ifdef MP_COMPAT_1X
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.146
diff -u -r1.146 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 14 Feb 2004 17:00:26 -0000 1.146
+++ xs/tables/current/ModPerl/FunctionTable.pm 29 Feb 2004 04:51:23 -0000
@@ -7085,6 +7085,16 @@
}
]
},
+ {
+ 'return_type' => 'void',
+ 'name' => 'modperl_get_hook_order',
+ 'args' => []
+ },
+ {
+ 'return_type' => 'void',
+ 'name' => 'modperl_apache_resort_hooks',
+ 'args' => []
+ },
];
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ src/modules/perl/modperl_apache.c 2004-02-28 23:16:40.000000000 -0500
@@ -0,0 +1,106 @@
+#include "mod_perl.h"
+
+/* these typedefs (and descriptions) taken from mod_info.c as of 2.0.49 */
+
+typedef struct { /*XXX: should get something from apr_hooks.h instead */
+ void (*pFunc)(void); /* just to get the right size */
+ const char *szName;
+ const char * const *aszPredecessors;
+ const char * const *aszSuccessors;
+ int nOrder;
+} hook_struct_t;
+
+/*
+ * hook_get_t is a pointer to a function that takes void as an argument and
+ * returns a pointer to an apr_array_header_t. The nasty WIN32 ifdef
+ * is required to account for the fact that the ap_hook* calls all use
+ * STDCALL calling convention.
+ */
+typedef apr_array_header_t * (
+#ifdef WIN32
+__stdcall
+#endif
+* hook_get_t)(void);
+
+typedef struct {
+ const char *name;
+ hook_get_t get;
+} hook_lookup_t;
+
+static hook_lookup_t request_hooks[] = {
+ {"PerlHookPostReadRequestHandler", ap_hook_get_post_read_request},
+ {"PerlHookTransHandler", ap_hook_get_translate_name},
+ {"PerlHookMapToStorageHandler", ap_hook_get_map_to_storage},
+ {"PerlHookHeaderParserHandler", ap_hook_get_header_parser},
+ {"PerlHookAccessHandler", ap_hook_get_access_checker},
+ {"PerlHookAuthenHandler", ap_hook_get_check_user_id},
+ {"PerlHookAuthzHandler", ap_hook_get_auth_checker},
+ {"PerlHookTypeHandler", ap_hook_get_type_checker},
+ {"PerlHookFixupHandler", ap_hook_get_fixups},
+ {"PerlHookLogHandler", ap_hook_get_log_transaction},
+ {NULL},
+};
+
+/* PerlHook*Handler support */
+void modperl_apache_resort_hooks() {
+
+ /* change the ordering of a specific phase, placing mod_perl someplace
+ * than the default APR_HOOK_REALLY_FIRST order
+ */
+
+ int i;
+ apr_table_t *hook_order = modperl_get_hook_order();
+
+ /* if there were no PerlHook*Handler directives we can quit early */
+ if (apr_is_empty_table(hook_order)) {
+ MP_TRACE_a(MP_FUNC, "hook order table is empty - using defaults");
+ return;
+ }
+
+ /* we have _something_ to process. it would make more sense to have
+ * the hook_order table drive the process, but that would require a bunch
+ * of string comparisons to fetch the proper ap_hook_get* function...
+ */
+ for (i = 0; request_hooks[i].name; i++) {
+ int int_order;
+ const char *char_order;
+ apr_array_header_t *hooks;
+ hook_struct_t *elts;
+
+ MP_TRACE_a(MP_FUNC, "finding configured hook order for %s",
+ request_hooks[i].name);
+
+ char_order = apr_table_get(hook_order, request_hooks[i].name);
+
+ if (char_order == NULL) {
+ MP_TRACE_a(MP_FUNC, "no %s specified - using defaults",
+ request_hooks[i].name);
+ continue;
+ }
+
+ hooks = request_hooks[i].get();
+ elts = (hook_struct_t *)hooks->elts;
+ int_order = atoi(char_order);
+
+ /* isolate mod_perl from the phase hooks and insert new ordering */
+
+ int j;
+ for (j = 0; j < hooks->nelts; j++) {
+ if (strcmp(elts[j].szName,"mod_perl.c") == 0) {
+ if (elts[j].nOrder == MODPERL_HOOK_REALLY_REALLY_FIRST) {
+ /* XXX hack. don't override any of mod_perl's internal
+ * callbacks, just the ones users can set - szName is set
+ * to mod_perl.c for _every_ registered mod_perl hook.
+ */
+ continue;
+ }
+ MP_TRACE_a(MP_FUNC, "using %s to set hook order to %d",
+ request_hooks[i].name, int_order);
+ elts[j].nOrder = int_order;
+ }
+ }
+ }
+
+ /* resort the hooks */
+ apr_hook_sort_all();
+}
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ src/modules/perl/modperl_apache.h 2004-02-28 23:11:52.000000000 -0500
@@ -0,0 +1,6 @@
+#ifndef MODPERL_APACHE_H
+#define MODPERL_APACHE_H
+
+void modperl_apache_resort_hooks(void);
+
+#endif /* MODPERL_UTIL_H */
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
