dougm 00/04/14 18:38:46
Modified: lib/ModPerl Code.pm
src/modules/perl .cvsignore mod_perl.c mod_perl.h
modperl_interp.c
Log:
integrate with tracing
Revision Changes Path
1.4 +35 -2 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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- Code.pm 2000/04/14 23:52:53 1.3
+++ Code.pm 2000/04/15 01:38:44 1.4
@@ -184,6 +184,38 @@
}
}
+my @trace = qw(d s h g c i);
+
+sub generate_trace {
+ my($self, $h_fh) = @_;
+
+ my $i = 1;
+
+ print $h_fh <<EOF;
+extern U32 MP_debug_level;
+
+#ifdef MP_TRACE
+#define MP_TRACE_a if (MP_debug_level) modperl_trace
+#else
+#define MP_TRACE_a if (0) modperl_trace
+#endif
+
+EOF
+
+ for my $type (@trace) {
+ my $define = "#define MP_TRACE_$type";
+
+ print $h_fh <<EOF;
+#ifdef MP_TRACE
+$define if (MP_debug_level & $i) modperl_trace
+#else
+$define if (0) modperl_trace
+#endif
+EOF
+ $i += $i;
+ }
+}
+
sub ins_underscore {
$_[0] =~ s/([a-z])([A-Z])/$1_$2/g;
}
@@ -233,14 +265,15 @@
generate_handler_directives => {h => 'modperl_directives.h',
c => 'modperl_directives.c'},
generate_flags => {h => 'modperl_flags.h'},
+ generate_trace => {h => 'modperl_trace.h'},
);
my @g_c_names = map { "modperl_$_" } qw(hooks directives);
-my @c_names = (qw(mod_perl modperl_interp), @g_c_names);
+my @c_names = (qw(mod_perl modperl_interp modperl_log), @g_c_names);
sub c_files { map { "$_.c" } @c_names }
sub o_files { map { "$_.o" } @c_names }
-my @g_h_names = map { "modperl_$_" } qw(hooks directives flags);
+my @g_h_names = map { "modperl_$_" } qw(hooks directives flags trace);
sub clean_files {
(map { "$_.c" } @g_c_names), (map { "$_.h" } @g_h_names);
1.2 +1 -0 modperl-2.0/src/modules/perl/.cvsignore
Index: .cvsignore
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/.cvsignore,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- .cvsignore 2000/04/14 23:29:12 1.1
+++ .cvsignore 2000/04/15 01:38:45 1.2
@@ -3,4 +3,5 @@
modperl_flags.h
modperl_directives.h
modperl_directives.c
+modperl_trace.h
1.3 +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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mod_perl.c 2000/04/14 23:52:54 1.2
+++ mod_perl.c 2000/04/15 01:38:45 1.3
@@ -29,6 +29,7 @@
void modperl_init(ap_pool_t *pconf, ap_pool_t *plog,
ap_pool_t *ptemp, server_rec *s)
{
+ modperl_trace_level_set("all"); /* XXX: all for now */
modperl_startup(s, pconf);
}
1.3 +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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- mod_perl.h 2000/04/14 23:52:54 1.2
+++ mod_perl.h 2000/04/15 01:38:45 1.3
@@ -28,6 +28,7 @@
#include "modperl_config.h"
#include "modperl_callback.h"
#include "modperl_interp.h"
+#include "modperl_log.h"
#include "modperl_directives.h"
1.2 +21 -23 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.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- modperl_interp.c 2000/04/14 23:51:58 1.1
+++ modperl_interp.c 2000/04/15 01:38:45 1.2
@@ -15,8 +15,7 @@
interp->mip_lock = parent->mip_lock;
}
- fprintf(stderr, "modperl_interp_new: 0x%lx\n",
- (unsigned long)interp);
+ MP_TRACE_i(MP_FUNC, "0x%lx\n", (unsigned long)interp);
return interp;
}
@@ -33,7 +32,7 @@
* need to lock the interpreter during callbacks
* unless mpm is prefork
*/
- fprintf(stderr, "modperl_interp_get: no pool, returning parent\n");
+ MP_TRACE_i(MP_FUNC, "no pool, returning parent\n");
return mip->parent;
}
@@ -41,25 +40,25 @@
head = mip->head;
- fprintf(stderr, "modperl_interp_get: head == 0x%lx, parent == 0x%lx\n",
- (unsigned long)head, (unsigned long)mip->parent);
+ MP_TRACE_i(MP_FUNC, "head == 0x%lx, parent == 0x%lx\n",
+ (unsigned long)head, (unsigned long)mip->parent);
while (head) {
if (!MpInterpIN_USE(head)) {
interp = head;
- fprintf(stderr, "modperl_interp_get: selected 0x%lx\n",
- (unsigned long)interp);
+ MP_TRACE_i(MP_FUNC, "selected 0x%lx\n",
+ (unsigned long)interp);
#ifdef _PTHREAD_H
- fprintf(stderr, "pthread_self == 0x%lx\n",
- (unsigned long)pthread_self());
+ MP_TRACE_i(MP_FUNC, "pthread_self == 0x%lx\n",
+ (unsigned long)pthread_self());
#endif
MpInterpIN_USE_On(interp);
MpInterpPUTBACK_On(interp);
break;
}
else {
- fprintf(stderr, "modperl_interp_get: 0x%lx in use\n",
- (unsigned long)head);
+ MP_TRACE_i(MP_FUNC, "0x%lx in use\n",
+ (unsigned long)head);
head = head->next;
}
}
@@ -85,12 +84,11 @@
while (mip->head) {
dTHXa(mip->head->perl);
- fprintf(stderr, "modperl_interp_pool_destroy: head == 0x%lx",
- (unsigned long)mip->head);
+ MP_TRACE_i(MP_FUNC, "head == 0x%lx\n",
+ (unsigned long)mip->head);
if (MpInterpIN_USE(mip->head)) {
- fprintf(stderr, " *error - still in use!*");
+ MP_TRACE_i(MP_FUNC, "*error - still in use!*\n");
}
- fprintf(stderr, "\n");
PL_perl_destruct_level = 2;
perl_destruct(mip->head->perl);
@@ -100,8 +98,8 @@
mip->head = mip->head->next;
}
- fprintf(stderr, "modperl_interp_pool_destroy: parent == 0x%lx\n",
- (unsigned long)mip->parent);
+ MP_TRACE_i(MP_FUNC, "parent == 0x%lx\n",
+ (unsigned long)mip->parent);
perl_destruct(mip->parent->perl);
perl_free(mip->parent->perl);
@@ -149,10 +147,10 @@
}
#endif
- fprintf(stderr, "modperl_interp_pool_init: parent == 0x%lx "
- "start=%d, min_spare=%d, max_spare=%d\n",
- (unsigned long)mip->parent,
- mip->start, mip->min_spare, mip->max_spare);
+ MP_TRACE_i(MP_FUNC, "parent == 0x%lx "
+ "start=%d, min_spare=%d, max_spare=%d\n",
+ (unsigned long)mip->parent,
+ mip->start, mip->min_spare, mip->max_spare);
ap_register_cleanup(p, (void*)mip,
modperl_interp_pool_destroy, ap_null_cleanup);
@@ -169,8 +167,8 @@
MpInterpIN_USE_Off(interp);
- fprintf(stderr, "modperl_interp_unselect: 0x%lx\n",
- (unsigned long)interp);
+ MP_TRACE_i(MP_FUNC, "0x%lx now available\n",
+ (unsigned long)interp);
ap_unlock(interp->mip_lock);
