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 mod_perl.c modperl_callback.h modperl_config.c modperl_config.h modperl_log.c modperl_types.h
Date Tue, 18 Apr 2000 22:59:15 GMT
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 */
  
  
  

Mime
View raw message