Return-Path: Delivered-To: apmail-modperl-cvs-archive@apache.org Received: (qmail 78223 invoked by uid 500); 7 Oct 2001 22:02:46 -0000 Mailing-List: contact modperl-cvs-help@apache.org; run by ezmlm Precedence: bulk list-help: list-unsubscribe: list-post: Reply-To: dev@perl.apache.org Delivered-To: mailing list modperl-cvs@apache.org Received: (qmail 78212 invoked by uid 500); 7 Oct 2001 22:02:46 -0000 Delivered-To: apmail-modperl-2.0-cvs@apache.org Date: 7 Oct 2001 21:59:16 -0000 Message-ID: <20011007215916.54629.qmail@icarus.apache.org> From: dougm@apache.org To: modperl-2.0-cvs@apache.org Subject: cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h X-Spam-Rating: daedalus.apache.org 1.6.2 0/1000/N 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