dougm       01/09/28 12:24:44

  Modified:    src/modules/perl modperl_perl_global.c modperl_perl_global.h
                        modperl_util.h
  Log:
  add save/restore of %ENV to Perl global management
  
  Revision  Changes    Path
  1.2       +52 -0     modperl-2.0/src/modules/perl/modperl_perl_global.c
  
  Index: modperl_perl_global.c
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.c,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- modperl_perl_global.c     2001/09/27 19:03:19     1.1
  +++ modperl_perl_global.c     2001/09/28 19:24:44     1.2
  @@ -2,12 +2,56 @@
   
   static void modperl_perl_global_init(pTHX_ modperl_perl_globals_t *globals)
   {
  +    globals->env.gv    = PL_envgv;
       globals->inc.gv    = PL_incgv;
       globals->defout.gv = PL_defoutgv;
       globals->rs.sv     = PL_rs;
   }
   
   static void
  +modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
  +{
  +    U32 mg_flags;
  +    HV *hv = GvHV(gvhv->gv);
  +
  +    /*
  +     * there should only be a small number of entries in %ENV
  +     * at this point: modperl_env.c:modperl_env_const_vars[],
  +     * PerlPassEnv and top-level PerlSetEnv
  +     * XXX: still; could have have something faster than newHVhv()
  +     * especially if we add another GVHV to the globals table that 
  +     * might have more entries
  +     */
  +
  +    /* makes newHVhv() faster in bleedperl */
  +    MP_magical_untie(hv, mg_flags);
  +
  +    gvhv->tmphv = newHVhv(hv);
  +    TAINT_NOT;
  +
  +    /* reapply magic flags */
  +    MP_magical_tie(hv, mg_flags);
  +    MP_magical_tie(gvhv->tmphv, mg_flags);
  +
  +    gvhv->orighv = hv;
  +    GvHV(gvhv->gv) = gvhv->tmphv;
  +}
  +
  +static void
  +modperl_perl_global_gvhv_restore(pTHX_ modperl_perl_global_gvhv_t *gvhv)
  +{
  +    U32 mg_flags;
  +
  +    GvHV(gvhv->gv) = gvhv->orighv;
  +
  +    /* loose magic for hv_clear()
  +     * e.g. for %ENV don't want to clear environ array
  +     */
  +    MP_magical_untie(gvhv->tmphv, mg_flags);
  +    SvREFCNT_dec(gvhv->tmphv);
  +}
  +
  +static void
   modperl_perl_global_gvav_save(pTHX_ modperl_perl_global_gvav_t *gvav)
   {
       AV *av = GvAV(gvav->gv);
  @@ -59,6 +103,7 @@
   }
   
   typedef enum {
  +    MP_GLOBAL_GVHV,
       MP_GLOBAL_GVAV,
       MP_GLOBAL_GVIO,
       MP_GLOBAL_SVPV,
  @@ -74,6 +119,7 @@
       STRUCT_OFFSET(modperl_perl_globals_t, m)
   
   static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
  +    {"ENV",    MP_GLOBAL_OFFSET(env),    MP_GLOBAL_GVHV}, /* %ENV */
       {"INC",    MP_GLOBAL_OFFSET(inc),    MP_GLOBAL_GVAV}, /* @INC */
       {"STDOUT", MP_GLOBAL_OFFSET(defout), MP_GLOBAL_GVIO}, /* $| */
       {"/",      MP_GLOBAL_OFFSET(rs),     MP_GLOBAL_SVPV}, /* $/ */
  @@ -102,6 +148,9 @@
           MP_dGLOBAL_PTR(globals, i);
   
           switch (modperl_perl_global_entries[i].type) {
  +          case MP_GLOBAL_GVHV:
  +            MP_PERL_GLOBAL_SAVE(gvhv, ptr);
  +            break;
             case MP_GLOBAL_GVAV:
               MP_PERL_GLOBAL_SAVE(gvav, ptr);
               break;
  @@ -123,6 +172,9 @@
           MP_dGLOBAL_PTR(globals, i);
   
           switch (modperl_perl_global_entries[i].type) {
  +          case MP_GLOBAL_GVHV:
  +            MP_PERL_GLOBAL_RESTORE(gvhv, ptr);
  +            break;
             case MP_GLOBAL_GVAV:
               MP_PERL_GLOBAL_RESTORE(gvav, ptr);
               break;
  
  
  
  1.2       +7 -0      modperl-2.0/src/modules/perl/modperl_perl_global.h
  
  Index: modperl_perl_global.h
  ===================================================================
  RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl_global.h,v
  retrieving revision 1.1
  retrieving revision 1.2
  diff -u -r1.1 -r1.2
  --- modperl_perl_global.h     2001/09/27 19:03:19     1.1
  +++ modperl_perl_global.h     2001/09/28 19:24:44     1.2
  @@ -9,6 +9,12 @@
   
   typedef struct {
       GV *gv;
  +    HV *tmphv;
  +    HV *orighv;
  +} modperl_perl_global_gvhv_t;
  +
  +typedef struct {
  +    GV *gv;
       char flags;
   } modperl_perl_global_gvio_t;
   
  @@ -19,6 +25,7 @@
   } modperl_perl_global_svpv_t;
   
   typedef struct {
  +    modperl_perl_global_gvhv_t env;
       modperl_perl_global_gvav_t inc;
       modperl_perl_global_gvio_t defout;
       modperl_perl_global_svpv_t rs;
  
  
  
  1.18      +7 -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.17
  retrieving revision 1.18
  diff -u -r1.17 -r1.18
  --- modperl_util.h    2001/09/25 19:44:02     1.17
  +++ modperl_util.h    2001/09/28 19:24:44     1.18
  @@ -21,6 +21,13 @@
   #define SvObjIV(o) SvIV((SV*)SvRV(o))
   #define MgObjIV(m) SvIV((SV*)SvRV(m->mg_obj))
   
  +#define MP_magical_untie(sv, mg_flags) \
  +    mg_flags = SvMAGICAL((SV*)sv); \
  +    SvMAGICAL_off((SV*)sv)
  +
  +#define MP_magical_tie(sv, mg_flags) \
  +    SvFLAGS((SV*)sv) |= mg_flags
  +
   MP_INLINE server_rec *modperl_sv2server_rec(pTHX_ SV *sv);
   MP_INLINE request_rec *modperl_sv2request_rec(pTHX_ SV *sv);
   
  
  
  


Reply via email to