perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
Date Sun, 07 Oct 2001 21:59:16 GMT
dougm       01/10/07 14:59:16

  Modified:    src/modules/perl modperl_perl_global.c modperl_perl_global.h
  Log:
  implement logic for saving Perl special subroutines (END,BEGIN,CHECK,INIT)
  into the per-interpreter PL_modglobal hash
  
  modperl_perl_global_avcv_call() function to call the subroutines for given
  package
  
  modperl_perl_global_avcv_clear() function to clear the subroutines for given
  package
  
  END blocks are now saved via the new logic
  
  Revision  Changes    Path
  1.6       +130 -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.5
  retrieving revision 1.6
  diff -u -r1.5 -r1.6
  --- modperl_perl_global.c	2001/10/07 19:04:20	1.5
  +++ modperl_perl_global.c	2001/10/07 21:59:16	1.6
  @@ -6,9 +6,131 @@
       globals->inc.gv    = PL_incgv;
       globals->defout.gv = PL_defoutgv;
       globals->rs.sv     = &PL_rs;
  +    globals->end.av    = &PL_endav;
  +    globals->end.key   = MP_MODGLOBAL_END;
   }
   
  +/* XXX: PL_modglobal thingers might be useful elsewhere */
  +
  +#define MP_MODGLOBAL_ENT(key) \
  +{key, "ModPerl::" key, (sizeof("ModPerl::")-1)+(sizeof(key)-1), 0}
  +
  +static modperl_modglobal_key_t MP_modglobal_keys[] = {
  +    MP_MODGLOBAL_ENT("END"),
  +};
  +
  +static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
  +                                          const char *package, I32 packlen)
  +{
  +    SV **svp = hv_fetch(PL_modglobal, gkey->val, gkey->len, FALSE);
  +    HV *hv;
  +
  +    if (!(svp && (hv = (HV*)*svp))) {
  +        return Nullav;
  +    }
  +
  +    if (!(svp = hv_fetch(hv, package, packlen, FALSE))) {
  +        return Nullav;
  +    }
  +
  +    return (AV*)*svp;
  +}
  +
  +void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
  +                                   const char *package, I32 packlen)
  +{
  +    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
  +
  +    if (!av) {
  +        return;
  +    }
  +
  +    modperl_perl_call_list(aTHX_ av, gkey->name);
  +}
  +
  +void modperl_perl_global_avcv_clear(pTHX_ modperl_modglobal_key_t *gkey,
  +                                    const char *package, I32 packlen)
  +{
  +    AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen);
  +
  +    if (!av) {
  +        return;
  +    }
  +
  +    av_clear(av);
  +}
  +
  +static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
  +{
  +    HV *hv;
  +    AV *mav, *av = (AV*)sv;
  +    const char *package = HvNAME(PL_curstash);
  +    I32 packlen = strlen(package);
  +    modperl_modglobal_key_t *gkey =
  +        (modperl_modglobal_key_t *)mg->mg_ptr;
  +
  +    hv = (HV*)*hv_fetch(PL_modglobal, gkey->val, gkey->len, TRUE);
  +    (void)SvUPGRADE((SV*)hv, SVt_PVHV);
  +
  +    mav = (AV*)*hv_fetch(hv, package, packlen, TRUE);
  +    (void)SvUPGRADE((SV*)mav, SVt_PVAV);
  +
  +    /* $cv = pop @av */
  +    sv = AvARRAY(av)[AvFILLp(av)];
  +    AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
  +
  +    /* push @{ $PL_modglobal{$key}{$package} }, $cv */
  +    av_store(mav, AvFILLp(av)+1, sv);
  +
  +    return 1;
  +}
  +
  +static MGVTBL modperl_vtbl_global_avcv_t = {
  +    0,
  +    MEMBER_TO_FPTR(modperl_perl_global_avcv_set),
  +    0, 0, 0,
  +};
  +
  +/* XXX: Apache::RegistryLoader type things need access to this
  + * for compiling scripts at startup
  + */
  +static void modperl_perl_global_avcv_tie(pTHX_ modperl_modglobal_key_e key,
  +                                         AV *av)
  +{
  +    if (!SvMAGIC((SV*)av)) {
  +        MAGIC *mg;
  +        Newz(702, mg, 1, MAGIC);
  +        mg->mg_virtual = &modperl_vtbl_global_avcv_t;
  +        mg->mg_ptr = (char *)&MP_modglobal_keys[key];
  +        mg->mg_len = -1; /* prevent free() of mg->mg_ptr */
  +        SvMAGIC((SV*)av) = mg;
  +    }
  +
  +    SvSMAGICAL_on((SV*)av);
  +}
  +
  +static void modperl_perl_global_avcv_untie(pTHX_ AV *av)
  +{
  +    SvSMAGICAL_off((SV*)av);
  +}
  +
  +static void
  +modperl_perl_global_avcv_save(pTHX_ modperl_perl_global_avcv_t *avcv)
  +{
  +    avcv->origav = *avcv->av;
  +    *avcv->av = newAV(); /* XXX: only need 1 of these AVs per-interpreter */
  +    modperl_perl_global_avcv_tie(aTHX_ avcv->key, *avcv->av);
  +}
  +
   static void
  +modperl_perl_global_avcv_restore(pTHX_ modperl_perl_global_avcv_t *avcv)
  +{
  +    modperl_perl_global_avcv_untie(aTHX_ *avcv->av);
  +    SvREFCNT_dec(*avcv->av); /* XXX: see XXX above */
  +    *avcv->av = avcv->origav;
  +}
  +
  +static void
   modperl_perl_global_gvhv_save(pTHX_ modperl_perl_global_gvhv_t *gvhv)
   {
       U32 mg_flags;
  @@ -93,6 +215,7 @@
   }
   
   typedef enum {
  +    MP_GLOBAL_AVCV,
       MP_GLOBAL_GVHV,
       MP_GLOBAL_GVAV,
       MP_GLOBAL_GVIO,
  @@ -109,6 +232,7 @@
       STRUCT_OFFSET(modperl_perl_globals_t, m)
   
   static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
  +    {"END",    MP_GLOBAL_OFFSET(end),    MP_GLOBAL_AVCV}, /* END */
       {"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}, /* $| */
  @@ -138,6 +262,9 @@
           MP_dGLOBAL_PTR(globals, i);
   
           switch (modperl_perl_global_entries[i].type) {
  +          case MP_GLOBAL_AVCV:
  +            MP_PERL_GLOBAL_SAVE(avcv, ptr);
  +            break;
             case MP_GLOBAL_GVHV:
               MP_PERL_GLOBAL_SAVE(gvhv, ptr);
               break;
  @@ -162,6 +289,9 @@
           MP_dGLOBAL_PTR(globals, i);
   
           switch (modperl_perl_global_entries[i].type) {
  +          case MP_GLOBAL_AVCV:
  +            MP_PERL_GLOBAL_RESTORE(avcv, ptr);
  +            break;
             case MP_GLOBAL_GVHV:
               MP_PERL_GLOBAL_RESTORE(gvhv, ptr);
               break;
  
  
  
  1.5       +24 -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.4
  retrieving revision 1.5
  diff -u -r1.4 -r1.5
  --- modperl_perl_global.h	2001/10/07 19:04:20	1.4
  +++ modperl_perl_global.h	2001/10/07 21:59:16	1.5
  @@ -2,6 +2,23 @@
   #define MODPERL_PERL_GLOBAL_H
   
   typedef struct {
  +    const char *name;
  +    const char *val;
  +    I32 len;
  +    U32 hash;
  +} modperl_modglobal_key_t;
  +
  +typedef enum {
  +    MP_MODGLOBAL_END,
  +} modperl_modglobal_key_e;
  +
  +typedef struct {
  +    AV **av;
  +    AV *origav;
  +    modperl_modglobal_key_e key;
  +} modperl_perl_global_avcv_t;
  +
  +typedef struct {
       GV *gv;
       AV *tmpav;
       AV *origav;
  @@ -25,6 +42,7 @@
   } modperl_perl_global_svpv_t;
   
   typedef struct {
  +    modperl_perl_global_avcv_t end;
       modperl_perl_global_gvhv_t env;
       modperl_perl_global_gvav_t inc;
       modperl_perl_global_gvio_t defout;
  @@ -34,5 +52,11 @@
   void modperl_perl_global_request_save(pTHX_ request_rec *r);
   
   void modperl_perl_global_request_restore(pTHX_ request_rec *r);
  +
  +void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
  +                                   const char *package, I32 packlen);
  +
  +void modperl_perl_global_avcv_clear(pTHX_ modperl_modglobal_key_t *gkey,
  +                                    const char *package, I32 packlen);
   
   #endif
  
  
  

Mime
View raw message