dougm 00/08/20 20:01:31
Modified: lib/Apache Build.pm
lib/ModPerl Code.pm
pod modperl_dev.pod
src/modules/perl mod_perl.c mod_perl.h modperl_callback.c
modperl_callback.h modperl_config.c
Log:
pass arguments to callbacks
add PerlResponseHandler
Revision Changes Path
1.22 +1 -1 modperl-2.0/lib/Apache/Build.pm
Index: Build.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/Build.pm,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -r1.21 -r1.22
--- Build.pm 2000/06/20 16:04:21 1.21
+++ Build.pm 2000/08/21 03:01:27 1.22
@@ -104,7 +104,7 @@
if ($self->{MP_DEBUG}) {
$self->{MP_TRACE} = 1;
- $ccopts .= " -g";
+ $ccopts .= " -g -DMP_DEBUG";
}
if ($self->{MP_CCOPTS}) {
1.34 +7 -3 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.33
retrieving revision 1.34
diff -u -r1.33 -r1.34
--- Code.pm 2000/08/14 03:10:44 1.33
+++ Code.pm 2000/08/21 03:01:28 1.34
@@ -13,13 +13,15 @@
PerSrv => [qw(PostReadRequest Trans)], #Init
PerDir => [qw(HeaderParser
Access Authen Authz
- Type Fixup Log)], #Init Response Cleanup
+ Type Fixup Response Log)], #Init Cleanup
Connection => [qw(PreConnection ProcessConnection)],
);
my %hooks = map { $_, canon_lc($_) }
map { @{ $handlers{$_} } } keys %handlers;
+my %not_ap_hook = map { $_, 1 } qw(response);
+
my %hook_proto = (
Process => {
ret => 'void',
@@ -165,7 +167,8 @@
if (my $hook = $hooks{$handler}) {
push @register_hooks,
- " ap_hook_$hook($name, NULL, NULL, AP_HOOK_LAST);";
+ " ap_hook_$hook($name, NULL, NULL, AP_HOOK_LAST);"
+ unless $not_ap_hook{$hook};
}
my($protostr, $pass) = canon_proto($prototype, $name);
@@ -439,7 +442,8 @@
generate_trace => {h => 'modperl_trace.h'},
);
-my @c_src_names = qw(interp tipool log config options callback gtop);
+my @c_src_names = qw(interp tipool log config options callback gtop
+ util apache_xs);
my @g_c_names = map { "modperl_$_" } qw(hooks directives flags xsinit);
my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names));
sub c_files { [map { "$_.c" } @c_names, @g_c_names] }
1.5 +2 -0 modperl-2.0/pod/modperl_dev.pod
Index: modperl_dev.pod
===================================================================
RCS file: /home/cvs/modperl-2.0/pod/modperl_dev.pod,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -r1.4 -r1.5
--- modperl_dev.pod 2000/06/20 16:04:33 1.4
+++ modperl_dev.pod 2000/08/21 03:01:29 1.5
@@ -114,6 +114,8 @@
=item PerlFixupHandler
+=item PerlResponseHandler
+
=item PerlLogHandler
=item PerlPostReadRequestHandler
1.21 +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.20
retrieving revision 1.21
diff -u -r1.20 -r1.21
--- mod_perl.c 2000/08/14 03:10:45 1.20
+++ mod_perl.c 2000/08/21 03:01:30 1.21
@@ -153,6 +153,11 @@
};
static handler_rec modperl_handlers[] = {
+#if 0
+ { "perl-script", modperl_1xx_response_handler },
+#endif
+ /* this response handler does not do any extra crap */
+ { "modperl", modperl_response_handler },
{ NULL },
};
1.19 +4 -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.18
retrieving revision 1.19
diff -u -r1.18 -r1.19
--- mod_perl.h 2000/08/14 03:10:45 1.18
+++ mod_perl.h 2000/08/21 03:01:30 1.19
@@ -24,6 +24,9 @@
#include "apr_lock.h"
#include "apr_strings.h"
+#include "ap_buckets.h"
+#include "util_filter.h"
+
extern module MODULE_VAR_EXPORT perl_module;
#include "modperl_flags.h"
@@ -33,6 +36,7 @@
#include "modperl_gtop.h"
#endif
#include "modperl_types.h"
+#include "modperl_util.h"
#include "modperl_config.h"
#include "modperl_callback.h"
#include "modperl_tipool.h"
1.14 +89 -11 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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- modperl_callback.c 2000/08/14 03:10:45 1.13
+++ modperl_callback.c 2000/08/21 03:01:30 1.14
@@ -31,11 +31,35 @@
};
apr_register_cleanup(p, (void*)handler,
- modperl_handler_cleanup, apr_null_cleanup);
+ modperl_handler_cleanup, apr_null_cleanup);
return handler;
}
+void modperl_handler_make_args(pTHX_ AV *av, ...)
+{
+ va_list args;
+
+ va_start(args, av);
+
+ for (;;) {
+ char *classname = va_arg(args, char *);
+ void *ptr;
+ SV *sv;
+
+ if (classname == NULL) {
+ break;
+ }
+
+ ptr = va_arg(args, void *);
+
+ sv = modperl_ptr2obj(aTHX_ classname, ptr);
+ av_push(av, sv);
+ }
+
+ va_end(args);
+}
+
apr_status_t modperl_handler_cleanup(void *data)
{
modperl_handler_t *handler = (modperl_handler_t *)data;
@@ -130,11 +154,13 @@
MpHandlerFLAGS(handler) = 0;
handler->cvgen = 0;
+#if 0
if (handler->args) {
av_clear(handler->args);
SvREFCNT_dec((SV*)handler->args);
handler->args = Nullav;
}
+#endif
if (handler->cv) {
SvREFCNT_dec(handler->cv);
handler->cv = Nullsv;
@@ -238,6 +264,9 @@
modperl_handler_t *new_handler =
modperl_handler_new(p, (void*)handler->name,
MP_HANDLER_TYPE_CHAR);
+
+ new_handler->args = handler->args;
+ handler->args = Nullav;
handler = new_handler;
}
#endif
@@ -262,7 +291,7 @@
EXTEND(SP, len);
for (i=0; i<=len; i++) {
- PUSHs(sv_2mortal(*av_fetch(handler->args, i, FALSE)));
+ PUSHs(*av_fetch(handler->args, i, FALSE));
}
}
@@ -295,14 +324,8 @@
return status;
}
-#define MP_HANDLER_TYPE_DIR 1
-#define MP_HANDLER_TYPE_SRV 2
-#define MP_HANDLER_TYPE_CONN 3
-#define MP_HANDLER_TYPE_PROC 4
-#define MP_HANDLER_TYPE_FILE 5
-
int modperl_run_handlers(int idx, request_rec *r, conn_rec *c,
- server_rec *s, int type)
+ server_rec *s, int type, ...)
{
#ifdef USE_ITHREADS
pTHX;
@@ -315,6 +338,8 @@
MpAV *av = NULL;
int i, status = OK;
const char *desc = NULL;
+ va_list args;
+ AV *av_args = Nullav;
if (!MpSrvENABLED(scfg)) {
MP_TRACE_h(MP_FUNC, "PerlOff for server %s\n",
@@ -367,13 +392,65 @@
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,
+ "Apache", r, NULL);
+ break;
+ case MP_HANDLER_TYPE_CONN:
+ modperl_handler_make_args(aTHX_ av_args,
+ "Apache::Connection", c, NULL);
+ break;
+ case MP_HANDLER_TYPE_FILE:
+ {
+ apr_pool_t *pconf, *plog, *ptemp;
+ va_start(args, type);
+ pconf = va_arg(args, apr_pool_t *);
+ plog = va_arg(args, apr_pool_t *);
+ ptemp = va_arg(args, apr_pool_t *);
+ va_end(args);
+
+ modperl_handler_make_args(aTHX_ av_args,
+ "Apache::Pool", pconf,
+ "Apache::Pool", plog,
+ "Apache::Pool", ptemp,
+ "Apache::Server", s, NULL);
+ }
+ break;
+ case MP_HANDLER_TYPE_PROC:
+ {
+ apr_pool_t *p;
+
+ va_start(args, type);
+ p = va_arg(args, apr_pool_t *);
+ va_end(args);
+
+ modperl_handler_make_args(aTHX_ av_args,
+ "Apache::Pool", p,
+ "Apache::Server", s, NULL);
+ }
+ break;
+ };
+
for (i=0; i<av->nelts; i++) {
+ if (!handlers[i]->perl) {
+ handlers[i]->perl = aTHX;
+ }
+
+ handlers[i]->args = av_args;
status = modperl_callback(aTHX_ handlers[i], p);
+ handlers[i]->args = Nullav;
+
MP_TRACE_h(MP_FUNC, "%s returned %d\n",
handlers[i]->name, status);
}
+ SvREFCNT_dec((SV*)av_args);
+
#ifdef USE_ITHREADS
if (interp && MpInterpPUTBACK_On(interp)) {
/* XXX: might want to put interp back into available pool
@@ -404,12 +481,13 @@
void modperl_process_callback(int idx, apr_pool_t *p, server_rec *s)
{
- modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROC);
+ modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_PROC, p);
}
void modperl_files_callback(int idx,
apr_pool_t *pconf, apr_pool_t *plog,
apr_pool_t *ptemp, server_rec *s)
{
- modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILE);
+ modperl_run_handlers(idx, NULL, NULL, s, MP_HANDLER_TYPE_FILE,
+ pconf, plog, ptemp);
}
1.9 +9 -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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_callback.h 2000/08/14 03:10:45 1.8
+++ modperl_callback.h 2000/08/21 03:01:30 1.9
@@ -10,8 +10,16 @@
#define ap_hook_fixup ap_hook_fixups
#define ap_hook_log ap_hook_log_transaction
+#define MP_HANDLER_TYPE_DIR 1
+#define MP_HANDLER_TYPE_SRV 2
+#define MP_HANDLER_TYPE_CONN 3
+#define MP_HANDLER_TYPE_PROC 4
+#define MP_HANDLER_TYPE_FILE 5
+
modperl_handler_t *modperl_handler_new(apr_pool_t *p, void *h, int type);
+void modperl_handler_make_args(pTHX_ AV *avp, ...);
+
apr_status_t modperl_handler_cleanup(void *data);
void modperl_handler_cache_cv(pTHX_ modperl_handler_t *handler, CV *cv);
@@ -26,7 +34,7 @@
int modperl_callback(pTHX_ modperl_handler_t *handler, apr_pool_t *p);
int modperl_run_handlers(int idx, request_rec *r, conn_rec *c,
- server_rec *s, int type);
+ server_rec *s, int type, ...);
void modperl_process_callback(int idx, apr_pool_t *p, server_rec *s);
1.15 +1 -1 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.14
retrieving revision 1.15
diff -u -r1.14 -r1.15
--- modperl_config.c 2000/08/14 03:10:45 1.14
+++ modperl_config.c 2000/08/21 03:01:30 1.15
@@ -6,7 +6,7 @@
modperl_handler_t *h = modperl_handler_new(p, (void*)name,
MP_HANDLER_TYPE_CHAR);
if (!*handlers) {
- *handlers = apr_make_array(p, sizeof(modperl_handler_t), 1);
+ *handlers = apr_make_array(p, 1, sizeof(modperl_handler_t *));
MP_TRACE_d(MP_FUNC, "created handler stack\n");
}
