perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@locus.apache.org
Subject cvs commit: modperl-2.0/src/modules/perl .cvsignore mod_perl.c mod_perl.h modperl_interp.c
Date Sat, 15 Apr 2000 01:38:46 GMT
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);
   
  
  
  

Mime
View raw message