perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From s...@apache.org
Subject cvs commit: modperl-2.0/src/modules/perl mod_perl.c mod_perl.h
Date Sat, 10 Jul 2004 00:36:19 GMT
stas        2004/07/09 17:36:19

  Modified:    lib/ModPerl MapUtil.pm StructureMap.pm TypeMap.pm WrapXS.pm
               src/modules/perl mod_perl.c mod_perl.h
  Log:
  supports a new type of struct accessor, which is just like read/write
  one, but doesn't allow write access starting at the ChildInit phase
  under threaded mpm (to avoid thread-safely issues)
  
  Revision  Changes    Path
  1.8       +2 -0      modperl-2.0/lib/ModPerl/MapUtil.pm
  
  Index: MapUtil.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/MapUtil.pm,v
  retrieving revision 1.7
  retrieving revision 1.8
  diff -u -u -r1.7 -r1.8
  --- MapUtil.pm	23 Jun 2004 03:30:15 -0000	1.7
  +++ MapUtil.pm	10 Jul 2004 00:36:19 -0000	1.8
  @@ -25,8 +25,10 @@
   
   our @ISA = qw(Exporter);
   
  +# the mapping happens in lib/ModPerl/StructureMap.pm
   #    '<' => 'auto-generated but gives only a read-only access'
   #    '&' => 'RDWR accessor to a char* field, supporting undef arg'
  +#    '$'  => 'RONLY accessor, with WRITE accessor before child_init'
   my %disabled_map = (
       '!' => 'disabled or not yet implemented',
       '~' => 'implemented but not auto-generated',
  
  
  
  1.7       +3 -0      modperl-2.0/lib/ModPerl/StructureMap.pm
  
  Index: StructureMap.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/StructureMap.pm,v
  retrieving revision 1.6
  retrieving revision 1.7
  diff -u -u -r1.6 -r1.7
  --- StructureMap.pm	28 May 2004 01:35:15 -0000	1.6
  +++ StructureMap.pm	10 Jul 2004 00:36:19 -0000	1.7
  @@ -125,6 +125,9 @@
                   elsif ($1 eq '&') {
                       $map->{$class}->{$_} = 'rw_char_undef';
                   }
  +                elsif ($1 eq '$') {
  +                    $map->{$class}->{$_} = 'r+w_startup';
  +                }
               }
               else {
                   $map->{$class}->{$_} = undef;
  
  
  
  1.22      +1 -1      modperl-2.0/lib/ModPerl/TypeMap.pm
  
  Index: TypeMap.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/TypeMap.pm,v
  retrieving revision 1.21
  retrieving revision 1.22
  diff -u -u -r1.21 -r1.22
  --- TypeMap.pm	17 May 2004 22:57:21 -0000	1.21
  +++ TypeMap.pm	10 Jul 2004 00:36:19 -0000	1.22
  @@ -293,7 +293,7 @@
           my($name, $type) = ($e->{name}, $e->{type});
           my $rtype;
   
  -        # ro/rw/undef(disabled)
  +        # ro/rw/r+w_startup/undef(disabled)
           my $access_mode = $self->structure_map->{$stype}->{$name};
           next unless $access_mode;
           next unless $rtype = $self->map_type($type);
  
  
  
  1.78      +7 -1      modperl-2.0/lib/ModPerl/WrapXS.pm
  
  Index: WrapXS.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/lib/ModPerl/WrapXS.pm,v
  retrieving revision 1.77
  retrieving revision 1.78
  diff -u -u -r1.77 -r1.78
  --- WrapXS.pm	25 Jun 2004 15:29:25 -0000	1.77
  +++ WrapXS.pm	10 Jul 2004 00:36:19 -0000	1.78
  @@ -227,7 +227,12 @@
   
   EOF
               }
  -            elsif ($access_mode eq 'rw') {
  +            elsif ($access_mode eq 'rw' or $access_mode eq 'r+w_startup') {
  +
  +                my $check_runtime = $access_mode eq 'rw'
  +                    ? ''
  +                    : qq[MP_CROAK_IF_THREADS_STARTED("setting $name");];
  +
                   $code = <<EOF;
   $type
   $name(obj, val=$default)
  @@ -242,6 +247,7 @@
       RETVAL = ($cast) obj->$name;
   
       if (items > 1) {
  +         $check_runtime
            obj->$name = ($cast) $val;
       }
   
  
  
  
  1.218     +34 -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.217
  retrieving revision 1.218
  diff -u -u -r1.217 -r1.218
  --- mod_perl.c	7 Jul 2004 19:04:52 -0000	1.217
  +++ mod_perl.c	10 Jul 2004 00:36:19 -0000	1.218
  @@ -24,6 +24,18 @@
   #define MP_IS_STARTING    (MP_init_status == 1 ? 1 : 0)
   #define MP_IS_RUNNING     (MP_init_status == 2 ? 1 : 0)
   
  +/* false while there is only the parent process and may be child
  + * processes, but no threads around, useful for allowing things that
  + * don't require locking and won't affect other threads. It should
  + * become true just before the child_init phase  */
  +static int MP_threads_started = 0;
  +
  +int modperl_threads_started(void)
  +{
  +    return MP_threads_started;
  +}
  +
  +
   #ifndef USE_ITHREADS
   static apr_status_t modperl_shutdown(void *data)
   {
  @@ -31,6 +43,11 @@
       PerlInterpreter *perl = (PerlInterpreter *)cdata->data;
       void **handles;
   
  +    /* reset for restarts */
  +    if (scfg->threaded_mpm) {
  +        MP_threads_started = 0;
  +    }
  +    
       handles = modperl_xs_dl_handles_get(aTHX);
   
       MP_TRACE_i(MP_FUNC, "destroying interpreter=0x%lx\n",
  @@ -613,6 +630,20 @@
       return OK;
   }
   
  +static int modperl_hook_post_config_last(apr_pool_t *pconf, apr_pool_t *plog,
  +                                         apr_pool_t *ptemp, server_rec *s)
  +{
  +    MP_dSCFG(s);
  +
  +    /* in the threaded environment, no server_rec/process_rec
  +     * modifications should be done beyond this point */
  +    if (scfg->threaded_mpm) {
  +        MP_threads_started = 1;
  +    }
  +    
  +    return OK;
  +}
  +
   static int modperl_hook_create_request(request_rec *r)
   {
       MP_dRCFG;
  @@ -729,6 +760,9 @@
   
       ap_hook_post_config(modperl_hook_post_config,
                           NULL, NULL, APR_HOOK_FIRST);
  +
  +    ap_hook_post_config(modperl_hook_post_config_last,
  +                        NULL, NULL, APR_HOOK_REALLY_LAST);
   
       ap_hook_handler(modperl_response_handler,
                       NULL, NULL, APR_HOOK_MIDDLE);
  
  
  
  1.68      +8 -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.67
  retrieving revision 1.68
  diff -u -u -r1.67 -r1.68
  --- mod_perl.h	25 Jun 2004 15:29:25 -0000	1.67
  +++ mod_perl.h	10 Jul 2004 00:36:19 -0000	1.68
  @@ -93,6 +93,14 @@
   #include "modperl_module.h"
   #include "modperl_debug.h"
   
  +int modperl_threads_started(void);
  +
  +#define MP_CROAK_IF_THREADS_STARTED(what)                       \
  +    if (modperl_threads_started()) {                            \
  +        Perl_croak(aTHX_ "Can't run '%s' in the threaded "      \
  +                   "environment after server startup", what);   \
  +    }
  +    
   int modperl_init_vhost(server_rec *s, apr_pool_t *p,
                          server_rec *base_server);
   void modperl_init(server_rec *s, apr_pool_t *p);
  
  
  

Mime
View raw message