dougm 00/04/18 15:59:15
Modified: lib/ModPerl Code.pm
src/modules/perl mod_perl.c modperl_callback.h
modperl_config.c modperl_config.h modperl_log.c
modperl_types.h
Log:
integrate with modperl_callback.c
beef up tracing support
Revision Changes Path
1.12 +43 -9 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.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- Code.pm 2000/04/17 21:11:06 1.11
+++ Code.pm 2000/04/18 22:59:13 1.12
@@ -49,12 +49,14 @@
{type => 'char', name => 'arg'}],
cfg => {get => 'MP_dSCFG(parms->server)',
name => 'scfg'},
+ scope => 'RSRC_CONF',
},
PerDir => {
args => [{type => 'cmd_parms', name => 'parms'},
{type => 'modperl_dir_config_t', name => 'dcfg'},
{type => 'char', name => 'arg'}],
cfg => {get => '', name => 'dcfg'},
+ scope => 'OR_ALL',
},
);
@@ -70,7 +72,7 @@
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 CLONED)],
- Handler => [qw(NONE METHOD)],
+ Handler => [qw(NONE PARSED METHOD OBJECT ANON)],
);
sub new {
@@ -141,17 +143,27 @@
for my $h (@$handlers) {
my $name = canon_func('cmd', $h, 'handlers');
+ my $cmd_name = canon_define('cmd', $h, 'entry');
my $protostr = canon_proto($prototype, $name);
my $ix = $self->{handler_index}->{$class}->[$i++];
my $av = "$prototype->{cfg}->{name}->handlers[$ix]";
print $h_fh "$protostr;\n";
+
+ print $h_fh <<EOF;
+
+#define $cmd_name \\
+{"Perl${h}Handler", $name, NULL, \\
+ $prototype->{scope}, ITERATE, "Subroutine name"}
+
+EOF
print $c_fh <<EOF;
$protostr
{
$prototype->{cfg}->{get};
- return modperl_cmd_push_handlers($av, arg, parms->pool);
+ MP_TRACE_d(MP_FUNC, "push \@%s, %s\n", parms->cmd->name, arg);
+ return modperl_cmd_push_handlers(&($av), arg, parms->pool);
}
EOF
}
@@ -185,22 +197,34 @@
}
}
-my @trace = qw(d s h g c i m);
+my %trace = (
+# 'a' => 'all',
+ 'd' => 'directive processing',
+ 's' => 'perl sections',
+ 'h' => 'handlers',
+ 'm' => 'memory allocations',
+ 'i' => 'interpreter pool management',
+ 'g' => 'Perl runtime interaction',
+);
sub generate_trace {
my($self, $h_fh) = @_;
my $i = 1;
+ my @trace = sort keys %trace;
my $opts = join '', @trace;
+ my $tl = "MP_debug_level";
print $h_fh <<EOF;
-extern U32 MP_debug_level;
+extern U32 $tl;
#define MP_TRACE_OPTS "$opts"
#ifdef MP_TRACE
-#define MP_TRACE_a if (MP_debug_level) modperl_trace
-#define MP_TRACE_a_do(exp) if (MP_debug_level) exp
+#define MP_TRACE_a if ($tl) modperl_trace
+#define MP_TRACE_a_do(exp) if ($tl) { \\
+exp; \\
+}
#else
#define MP_TRACE_a if (0) modperl_trace
#define MP_TRACE_a_do(exp)
@@ -208,21 +232,31 @@
EOF
+ my @dumper;
for my $type (@trace) {
my $define = "#define MP_TRACE_$type";
my $define_do = join '_', $define, 'do';
print $h_fh <<EOF;
#ifdef MP_TRACE
-$define if (MP_debug_level & $i) modperl_trace
-$define_do(exp) if (MP_debug_level & $i) exp
+$define if ($tl & $i) modperl_trace
+$define_do(exp) if ($tl & $i) { \\
+exp; \\
+}
#else
$define if (0) modperl_trace
$define_do(exp)
#endif
EOF
+ push @dumper,
+ qq{fprintf(stderr, " $type %s ($trace{$type})\\n", ($tl & $i) ? "On " :
"Off");};
$i += $i;
}
+
+ print $h_fh join ' \\'."\n",
+ '#define MP_TRACE_dump_flags()',
+ qq{fprintf(stderr, "mod_perl trace flags dump:\\n");},
+ @dumper;
}
sub ins_underscore {
@@ -277,7 +311,7 @@
generate_trace => {h => 'modperl_trace.h'},
);
-my @c_src_names = qw(interp log config gtop);
+my @c_src_names = qw(interp log config callback gtop);
my @g_c_names = map { "modperl_$_" } qw(hooks directives xsinit);
my @c_names = ('mod_perl', (map "modperl_$_", @c_src_names), @g_c_names);
sub c_files { [map { "$_.c" } @c_names] }
1.9 +1 -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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- mod_perl.c 2000/04/17 21:11:06 1.8
+++ mod_perl.c 2000/04/18 22:59:14 1.9
@@ -79,6 +79,7 @@
MP_SRV_CMD_TAKE1("PerlInterpMinSpare", interp_min_spare,
"Min number of spare Perl interpreters"),
#endif
+ MP_CMD_POST_READ_REQUEST_ENTRY,
{ NULL },
};
1.3 +15 -0 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_callback.h 2000/04/14 23:52:54 1.2
+++ modperl_callback.h 2000/04/18 22:59:15 1.3
@@ -1,6 +1,21 @@
#ifndef MODPERL_CALLBACK_H
#define MODPERL_CALLBACK_H
+modperl_handler_t *modperl_handler_new(ap_pool_t *p, void *h, int type);
+
+ap_status_t modperl_handler_cleanup(void *data);
+
+void modperl_handler_cache_cv(pTHX_ modperl_handler_t *handler, CV *cv);
+
+int modperl_handler_lookup(pTHX_ modperl_handler_t *handler,
+ char *class, char *name);
+
+void modperl_handler_unparse(pTHX_ modperl_handler_t *handler);
+
+int modperl_handler_parse(pTHX_ modperl_handler_t *handler);
+
+int modperl_callback(pTHX_ modperl_handler_t *handler);
+
void modperl_process_callback(int idx, ap_pool_t *p, server_rec *s);
void modperl_files_callback(int idx,
1.7 +18 -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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_config.c 2000/04/17 21:29:41 1.6
+++ modperl_config.c 2000/04/18 22:59:15 1.7
@@ -1,5 +1,22 @@
#include "mod_perl.h"
+char *modperl_cmd_push_handlers(MpAV **handlers, char *name, ap_pool_t *p)
+{
+ modperl_handler_t *h = modperl_handler_new(p, (void*)name,
+ MP_HANDLER_TYPE_CHAR);
+ if (!*handlers) {
+ *handlers = ap_make_array(p, sizeof(modperl_handler_t), 1);
+ MP_TRACE_d(MP_FUNC, "created handler stack\n");
+ }
+
+ /* XXX parse_handler if Perl is running */
+
+ *(modperl_handler_t **)ap_push_array(*handlers) = h;
+ MP_TRACE_d(MP_FUNC, "pushed handler: %s\n", h->name);
+
+ return NULL;
+}
+
void *modperl_create_dir_config(ap_pool_t *p, char *dir)
{
return NULL;
@@ -20,7 +37,7 @@
scfg->argv = ap_make_array(p, 2, sizeof(char *));
- scfg_push_argv(ap_server_argv0);
+ scfg_push_argv((char *)ap_server_argv0);
return scfg;
}
1.7 +1 -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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_config.h 2000/04/17 21:11:06 1.6
+++ modperl_config.h 2000/04/18 22:59:15 1.7
@@ -11,7 +11,7 @@
void *modperl_merge_srv_config(ap_pool_t *p, void *basev, void *addv);
-char *modperl_cmd_push_handlers(MpAV *handlers, char *name, ap_pool_t *p);
+char *modperl_cmd_push_handlers(MpAV **handlers, char *name, ap_pool_t *p);
char **modperl_srv_config_argv_init(modperl_srv_config_t *scfg, int *argc);
1.3 +4 -1 modperl-2.0/src/modules/perl/modperl_log.c
Index: modperl_log.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_log.c,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_log.c 2000/04/15 01:43:18 1.2
+++ modperl_log.c 2000/04/18 22:59:15 1.3
@@ -22,7 +22,8 @@
return;
}
}
-
+ MP_debug_level = 0x0;
+
if (strEQ(level, "all")) {
MP_debug_level = 0xffffffff;
}
@@ -39,4 +40,6 @@
}
MP_debug_level |= 0x80000000;
+
+ MP_TRACE_a_do(MP_TRACE_dump_flags());
}
1.8 +9 -3 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_types.h 2000/04/17 21:11:06 1.7
+++ modperl_types.h 2000/04/18 22:59:15 1.8
@@ -102,10 +102,16 @@
} modperl_per_request_config_t;
typedef struct {
- SV *obj;
- CV *cv;
- char *name;
+ SV *obj; /* object or classname if cv is a method */
+ SV *cv; /* subroutine reference or name */
+ char *name; /* orignal name from .conf if any */
+ int cvgen; /* XXX: for caching */
+ AV *args; /* XXX: switch to something lighter */
int flags;
+ PerlInterpreter *perl; /* yuk: for cleanups */
} modperl_handler_t;
+
+#define MP_HANDLER_TYPE_CHAR 1
+#define MP_HANDLER_TYPE_SV 2
#endif /* MODPERL_TYPES_H */
