perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From go...@apache.org
Subject cvs commit: modperl-2.0/xs/tables/current/ModPerl FunctionTable.pm
Date Tue, 04 Mar 2003 09:42:42 GMT
gozer       2003/03/04 01:42:42

  Modified:    .        Changes STATUS
               src/modules/perl modperl_cmd.c modperl_util.c modperl_util.h
               t/conf   extra.last.conf.in
               t/response/TestDirective perldo.pm
               xs/tables/current/ModPerl FunctionTable.pm
  Log:
  $Apache::Server::SaveConfig added. When set to a true value,
  will not clear the content of Apache::ReadConfig:: once <Perl >
  sections are processed.
  
  Revision  Changes    Path
  1.143     +4 -0      modperl-2.0/Changes
  
  Index: Changes
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/Changes,v
  retrieving revision 1.142
  retrieving revision 1.143
  diff -u -r1.142 -r1.143
  --- Changes	4 Mar 2003 00:56:26 -0000	1.142
  +++ Changes	4 Mar 2003 09:42:41 -0000	1.143
  @@ -10,6 +10,10 @@
   
   =item 1.99_09-dev
   
  +$Apache::Server::SaveConfig added. When set to a true value,
  +will not clear the content of Apache::ReadConfig:: once <Perl >
  +sections are processed. [Philippe M. Chiasson <gozer@cpan.org]
  +
   Apache::compat: support 1.0's Apache->push_handlers,
   Apache->set_handlers and Apache->get_handlers [Stas]
   
  
  
  
  1.38      +1 -2      modperl-2.0/STATUS
  
  Index: STATUS
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/STATUS,v
  retrieving revision 1.37
  retrieving revision 1.38
  diff -u -r1.37 -r1.38
  --- STATUS	3 Mar 2003 03:50:55 -0000	1.37
  +++ STATUS	4 Mar 2003 09:42:41 -0000	1.38
  @@ -177,7 +177,6 @@
   ----
   
   * Apache::PerlSections missing features for backwards compatibility:
  - - $Apache::Server::SaveConfig
    - $Apache::ReadConfig::DocumentRoot
    - Apache::PerlSections->store(filename)
   
  
  
  
  1.40      +10 -0     modperl-2.0/src/modules/perl/modperl_cmd.c
  
  Index: modperl_cmd.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
  retrieving revision 1.39
  retrieving revision 1.40
  diff -u -r1.39 -r1.40
  --- modperl_cmd.c	3 Mar 2003 05:16:07 -0000	1.39
  +++ modperl_cmd.c	4 Mar 2003 09:42:42 -0000	1.40
  @@ -318,6 +318,8 @@
   #define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
   #define MP_STRICT_PERLSECTIONS_SV \
       get_sv("Apache::Server::StrictPerlSections", FALSE)
  +#define MP_PERLSECTIONS_SAVECONFIG_SV \
  +    get_sv("Apache::Server::SaveConfig", FALSE)
   
   MP_CMD_SRV_DECLARE(perldo)
   {
  @@ -385,6 +387,7 @@
       }
       
       if (handler) {
  +        SV *saveconfig;
           modperl_handler_make_args(aTHX_ &args,
                                     "Apache::CmdParms", parms,
                                     "APR::Table", options,
  @@ -394,6 +397,13 @@
   
           SvREFCNT_dec((SV*)args);
   
  +        if (!(saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV) || !SvTRUE(saveconfig)) {
  +            HV *symtab = (HV*)gv_stashpv(package_name, FALSE);
  +            if (symtab) {
  +                modperl_clear_symtab(aTHX_ symtab);
  +            }
  +        }
  +        
           if (status != OK) {
               return SvTRUE(ERRSV) ? SvPVX(ERRSV) :
                   apr_psprintf(p, "<Perl> handler %s failed with status=%d",
  
  
  
  1.51      +53 -0     modperl-2.0/src/modules/perl/modperl_util.c
  
  Index: modperl_util.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
  retrieving revision 1.50
  retrieving revision 1.51
  diff -u -r1.50 -r1.51
  --- modperl_util.c	11 Jan 2003 00:02:16 -0000	1.50
  +++ modperl_util.c	4 Mar 2003 09:42:42 -0000	1.51
  @@ -615,3 +615,56 @@
       return rv;
   }
   
  +static int modperl_gvhv_is_stash(GV *gv)
  +{
  +    int len = GvNAMELEN(gv);
  +    char *name = GvNAME(gv);
  +
  +    if ((len > 2) && (name[len - 1] == ':') && (name[len - 2] == ':'))
{
  +        return 1;
  +    }
  +
  +    return 0;
  +}
  +
  +/*
  + * we do not clear symbols within packages, the desired behavior
  + * for directive handler classes.  and there should never be a package
  + * within the %Apache::ReadConfig.  nothing else that i'm aware of calls
  + * this function, so we should be ok.
  + */
  +
  +void modperl_clear_symtab(pTHX_ HV *symtab) 
  +{
  +    SV *val;
  +    char *key;
  +    I32 klen;
  +
  +    hv_iterinit(symtab);
  +    
  +    while ((val = hv_iternextsv(symtab, &key, &klen))) {
  +        SV *sv;
  +        HV *hv;
  +        AV *av;
  +        CV *cv;
  +
  +        if ((SvTYPE(val) != SVt_PVGV) || GvIMPORTED((GV*)val)) {
  +            continue;
  +        }
  +        if ((sv = GvSV((GV*)val))) {
  +            sv_setsv(GvSV((GV*)val), &PL_sv_undef);
  +        }
  +        if ((hv = GvHV((GV*)val)) && !modperl_gvhv_is_stash((GV*)val)) {
  +            hv_clear(hv);
  +        }
  +        if ((av = GvAV((GV*)val))) {
  +            av_clear(av);
  +        }
  +        if ((cv = GvCV((GV*)val)) && (GvSTASH((GV*)val) == GvSTASH(CvGV(cv))))
{
  +            GV *gv = CvGV(cv);
  +            cv_undef(cv);
  +            CvGV(cv) = gv;
  +            GvCVGEN(gv) = 1; /* invalidate method cache */
  +        }
  +    }
  +}
  
  
  
  1.39      +2 -0      modperl-2.0/src/modules/perl/modperl_util.h
  
  Index: modperl_util.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
  retrieving revision 1.38
  retrieving revision 1.39
  diff -u -r1.38 -r1.39
  --- modperl_util.h	23 Jan 2003 00:31:28 -0000	1.38
  +++ modperl_util.h	4 Mar 2003 09:42:42 -0000	1.39
  @@ -126,4 +126,6 @@
   
   SV *modperl_perl_gensym(pTHX_ char *pack);
   
  +void modperl_clear_symtab(pTHX_ HV *symtab);
  +
   #endif /* MODPERL_UTIL_H */
  
  
  
  1.6       +7 -0      modperl-2.0/t/conf/extra.last.conf.in
  
  Index: extra.last.conf.in
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v
  retrieving revision 1.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- extra.last.conf.in	4 Mar 2003 03:35:05 -0000	1.5
  +++ extra.last.conf.in	4 Mar 2003 09:42:42 -0000	1.6
  @@ -12,6 +12,13 @@
   	};
   </Perl>
   
  +<Perl >
  +$Apache::Server::SaveConfig = 1;
  +$Location{'/perl_sections_saved'} = {
  +	'AuthName' => 'PerlSection',
  +	};
  +</Perl>
  +
   ### --------------------------------- ###
   Perl $TestDirective::perl::worked="yes";
   
  
  
  
  1.2       +7 -1      modperl-2.0/t/response/TestDirective/perldo.pm
  
  Index: perldo.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- perldo.pm	7 Oct 2002 02:35:18 -0000	1.1
  +++ perldo.pm	4 Mar 2003 09:42:42 -0000	1.2
  @@ -10,9 +10,15 @@
   sub handler {
       my $r = shift;
   
  -    plan $r, tests => 1;
  +    plan $r, tests => 4;
   
       ok t_cmp('yes', $TestDirective::perl::worked);
  +    
  +    ok not exists $Apache::ReadConfig::Location{'/perl_sections'};
  +    
  +    ok exists $Apache::ReadConfig::Location{'/perl_sections_saved'};
  +  
  +    ok t_cmp('PerlSection', $Apache::ReadConfig::Location{'/perl_sections_saved'}{'AuthName'});
   
       Apache::OK;
   }
  
  
  
  1.108     +14 -0     modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
  
  Index: FunctionTable.pm
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
  retrieving revision 1.107
  retrieving revision 1.108
  diff -u -r1.107 -r1.108
  --- FunctionTable.pm	3 Mar 2003 03:39:06 -0000	1.107
  +++ FunctionTable.pm	4 Mar 2003 09:42:42 -0000	1.108
  @@ -3635,6 +3635,20 @@
         }
       ]
     },
  +    {
  +    'return_type' => 'void',
  +    'name' => 'modperl_clear_symtab',
  +    'args' => [
  +      {
  +        'type' => 'PerlInterpreter *',
  +        'name' => 'my_perl'
  +      },
  +      {
  +        'type' => 'HV *',
  +        'name' => 'symtab'
  +      },
  +    ],
  +  },
     {
       'return_type' => 'HE *',
       'name' => 'modperl_perl_hv_fetch_he',
  
  
  

Mime
View raw message