cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c
dougm 01/11/14 17:25:00
Modified:src/modules/perl modperl_perl_global.c
Log:
propagate SvMAGIC of original HV in modperl_perl_global_gvhv_save()
Revision ChangesPath
1.14 +7 -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.13
retrieving revision 1.14
diff -u -r1.13 -r1.14
--- modperl_perl_global.c 2001/10/14 18:00:23 1.13
+++ modperl_perl_global.c 2001/11/15 01:25:00 1.14
@@ -175,6 +175,7 @@
{
U32 mg_flags;
HV *hv = GvHV(gvhv->gv);
+MAGIC *mg = SvMAGIC(hv);
/*
* there should only be a small number of entries in %ENV
@@ -194,6 +195,12 @@
/* reapply magic flags */
MP_magical_tie(hv, mg_flags);
MP_magical_tie(gvhv->tmphv, mg_flags);
+
+if (mg && mg->mg_type && !SvMAGIC(gvhv->tmphv)) {
+/* propagate SvMAGIC(hv) to SvMAGIC(gvhv->tmphv) */
+/* XXX: maybe newHVhv should do this? */
+hv_magic(gvhv->tmphv, Nullgv, mg->mg_type);
+}
gvhv->orighv = hv;
GvHV(gvhv->gv) = gvhv->tmphv;
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c
dougm 01/10/13 12:05:16
Modified:src/modules/perl modperl_perl_global.c
Log:
use consistent style to iterate over MP_modglobal_keys
Revision ChangesPath
1.12 +5 -4 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.11
retrieving revision 1.12
diff -u -r1.11 -r1.12
--- modperl_perl_global.c 2001/10/13 19:02:03 1.11
+++ modperl_perl_global.c 2001/10/13 19:05:16 1.12
@@ -38,12 +38,13 @@
modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name)
{
-int i;
+modperl_modglobal_key_t *gkey = MP_modglobal_keys;
-for (i=0; MP_modglobal_keys[i].name; i++) {
-if (strEQ(MP_modglobal_keys[i].name, name)) {
-return &MP_modglobal_keys[i];
+while (gkey->name) {
+if (strEQ(gkey->name, name)) {
+return gkey;
}
+gkey++;
}
return NULL;
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/13 11:55:03
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
s/hv_fetch/hv_fetch_he/g
Revision ChangesPath
1.10 +24 -9 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.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- modperl_perl_global.c 2001/10/08 21:09:08 1.9
+++ modperl_perl_global.c 2001/10/13 18:55:03 1.10
@@ -12,8 +12,14 @@
/* XXX: PL_modglobal thingers might be useful elsewhere */
+#define MP_MODGLOBAL_FETCH(gkey) \
+hv_fetch_he(PL_modglobal, (char *)gkey->val, gkey->len, gkey->hash)
+
+#define MP_MODGLOBAL_STORE_HV(gkey) \
+(HV*)*hv_store(PL_modglobal, gkey->val, gkey->len, (SV*)newHV(), gkey->hash)
+
#define MP_MODGLOBAL_ENT(key) \
-{key, "ModPerl::" key, (sizeof("ModPerl::")-1)+(sizeof(key)-1)}
+{key, "ModPerl::" key, (sizeof("ModPerl::")-1)+(sizeof(key)-1), 0}
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT("END"),
@@ -36,18 +42,18 @@
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);
+HE *he = MP_MODGLOBAL_FETCH(gkey);
HV *hv;
-if (!(svp && (hv = (HV*)*svp))) {
+if (!(he && (hv = (HV*)HeVAL(he {
return Nullav;
}
-if (!(svp = hv_fetch(hv, package, packlen, FALSE))) {
+if (!(he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
return Nullav;
}
-return (AV*)*svp;
+return (AV*)HeVAL(he);
}
void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
@@ -76,6 +82,7 @@
static int modperl_perl_global_avcv_set(pTHX_ SV *sv, MAGIC *mg)
{
+HE *he;
HV *hv;
AV *mav, *av = (AV*)sv;
const char *package = HvNAME(PL_curstash);
@@ -83,11 +90,19 @@
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);
+if ((he = MP_MODGLOBAL_FETCH(gkey))) {
+hv = (HV*)HeVAL(he);
+}
+else {
+hv = MP_MODGLOBAL_STORE_HV(gkey);
+}
-mav = (AV*)*hv_fetch(hv, package, packlen, TRUE);
-(void)SvUPGRADE((SV*)mav, SVt_PVAV);
+if ((he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
+mav = (AV*)HeVAL(he);
+}
+else {
+mav = (AV*)*hv_store(hv, package, packlen, (SV*)newAV(), 0);
+}
/* $cv = pop @av */
sv = AvARRAY(av)[AvFILLp(av)];
1.8 +1 -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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_perl_global.h 2001/10/07 22:07:15 1.7
+++ modperl_perl_global.h 2001/10/13 18:55:03 1.8
@@ -5,6 +5,7 @@
const char *name;
const char *val;
I32 len;
+U32 hash;
} modperl_modglobal_key_t;
typedef enum {
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c
dougm 01/10/08 14:09:08
Modified:src/modules/perl modperl_perl_global.c
Log:
remove hardwire references to MP_perl_global_entries[]; making it possible to use a
different table
Revision ChangesPath
1.9 +23 -18modperl-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.8
retrieving revision 1.9
diff -u -r1.8 -r1.9
--- modperl_perl_global.c 2001/10/07 22:07:15 1.8
+++ modperl_perl_global.c 2001/10/08 21:09:08 1.9
@@ -245,7 +245,7 @@
#define MP_GLOBAL_OFFSET(m) \
STRUCT_OFFSET(modperl_perl_globals_t, m)
-static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
+static modperl_perl_global_entry_t MP_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 */
@@ -262,20 +262,19 @@
modperl_perl_global_##type##_restore( \
aTHX_ (modperl_perl_global_##type##_t *)&(*ptr))
-#define MP_dGLOBAL_PTR(globals, i) \
+#define MP_dGLOBAL_PTR(globals, entries) \
apr_uint64_t **ptr = (apr_uint64_t **) \
-((char *)globals + (int)(long)modperl_perl_global_entries[i].offset)
+((char *)globals + (int)(long)entries->offset)
-static void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals)
+static void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals,
+ modperl_perl_global_entry_t *entries)
{
-int i;
-
modperl_perl_global_init(aTHX_ globals);
-for (i=0; modperl_perl_global_entries[i].name; i++) {
-MP_dGLOBAL_PTR(globals, i);
+while (entries->name) {
+MP_dGLOBAL_PTR(globals, entries);
-switch (modperl_perl_global_entries[i].type) {
+switch (entries->type) {
case MP_GLOBAL_AVCV:
MP_PERL_GLOBAL_SAVE(avcv, ptr);
break;
@@ -291,18 +290,19 @@
case MP_GLOBAL_SVPV:
MP_PERL_GLOBAL_SAVE(svpv, ptr);
break;
-};
+}
+
+entries++;
}
}
-static void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals)
+static void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals,
+modperl_perl_global_entry_t *entries)
{
-int i;
+while (entries->name) {
+MP_dGLOBAL_PTR(globals, entries);
-for (i=0; modperl_perl_global_entries[i].name; i++) {
-MP_dGLOBAL_PTR(globals, i);
-
-switch (modperl_perl_global_entries[i].type) {
+switch (entries->type) {
case MP_GLOBAL_AVCV:
MP_PERL_GLOBAL_RESTORE(avcv, ptr);
break;
@@ -319,17 +319,22 @@
MP_PERL_GLOBAL_RESTORE(svpv, ptr);
break;
}
+
+entries++;
}
}
void modperl_perl_global_request_save(pTHX_ request_rec *r)
{
MP_dRCFG;
-modperl_perl_global_save(aTHX_ &rcfg->perl_globals);
+modperl_perl_global_save(aTHX_ &rcfg->perl_globals,
+ MP_perl_global_entries);
}
void modperl_perl_global_request_restore(pTHX_ request_rec *r)
{
MP_dRCFG;
-modperl_perl_global_restore(aTHX_ &rcfg->perl_globals);
+modperl_perl_global_restore(aTHX_ &rcfg->perl_globals,
+MP_perl_global_entries);
+
}
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:07:15
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
wont be able to use a precomputed hash for modperl_modglobal_key_t's
Revision ChangesPath
1.8 +1 -1 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.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- modperl_perl_global.c 2001/10/07 22:04:07 1.7
+++ modperl_perl_global.c 2001/10/07 22:07:15 1.8
@@ -13,7 +13,7 @@
/* XXX: PL_modglobal thingers might be useful elsewhere */
#define MP_MODGLOBAL_ENT(key) \
-{key, "ModPerl::" key, (sizeof("ModPerl::")-1)+(sizeof(key)-1), 0}
+{key, "ModPerl::" key, (sizeof("ModPerl::")-1)+(sizeof(key)-1)}
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT("END"),
1.7 +0 -1 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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.h 2001/10/07 22:04:07 1.6
+++ modperl_perl_global.h 2001/10/07 22:07:15 1.7
@@ -5,7 +5,6 @@
const char *name;
const char *val;
I32 len;
-U32 hash;
} modperl_modglobal_key_t;
typedef enum {
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/10/07 15:04:07
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
add modperl_modglobal_lookup() function to lookup a modperl_modglobal_key_t based on
string name
Revision ChangesPath
1.7 +14 -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.6
retrieving revision 1.7
diff -u -r1.6 -r1.7
--- modperl_perl_global.c 2001/10/07 21:59:16 1.6
+++ modperl_perl_global.c 2001/10/07 22:04:07 1.7
@@ -17,7 +17,21 @@
static modperl_modglobal_key_t MP_modglobal_keys[] = {
MP_MODGLOBAL_ENT("END"),
+{ NULL },
};
+
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name)
+{
+int i;
+
+for (i=0; MP_modglobal_keys[i].name; i++) {
+if (strEQ(MP_modglobal_keys[i].name, name)) {
+return &MP_modglobal_keys[i];
+}
+}
+
+return NULL;
+}
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
const char *package, I32 packlen)
1.6 +2 -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.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- modperl_perl_global.h 2001/10/07 21:59:16 1.5
+++ modperl_perl_global.h 2001/10/07 22:04:07 1.6
@@ -49,6 +49,8 @@
modperl_perl_global_svpv_t rs;
} modperl_perl_globals_t;
+modperl_modglobal_key_t *modperl_modglobal_lookup(pTHX_ const char *name);
+
void modperl_perl_global_request_save(pTHX_ request_rec *r);
void modperl_perl_global_request_restore(pTHX_ request_rec *r);
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
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 ChangesPath
1.6 +130 -0modperl-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
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c
dougm 01/10/06 16:27:47
Modified:src/modules/perl modperl_perl_global.c
Log:
use modperl_perl_av_push_elts_ref() function
Revision ChangesPath
1.4 +2 -12 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.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- modperl_perl_global.c 2001/09/28 19:53:22 1.3
+++ modperl_perl_global.c 2001/10/06 23:27:47 1.4
@@ -54,19 +54,9 @@
static void
modperl_perl_global_gvav_save(pTHX_ modperl_perl_global_gvav_t *gvav)
{
-AV *av = GvAV(gvav->gv);
-I32 i, fill = AvFILLp(av);
-
-gvav->tmpav = newAV();
-
-av_extend(gvav->tmpav, fill);
-AvFILLp(gvav->tmpav) = fill;
-
-for (i=0; i<=fill; i++) {
-AvARRAY(gvav->tmpav)[i] = SvREFCNT_inc(AvARRAY(av)[i]);
-}
-
gvav->origav = GvAV(gvav->gv);
+gvav->tmpav = newAV();
+modperl_perl_av_push_elts_ref(aTHX_ gvav->tmpav, gvav->origav);
GvAV(gvav->gv) = gvav->tmpav;
}
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/09/28 12:53:22
Modified:src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
use the address of sv for modperl_perl_global_svpv_t, since it might point to a
different SV when restore happens
Revision ChangesPath
1.3 +4 -4 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.c 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.c 2001/09/28 19:53:22 1.3
@@ -5,7 +5,7 @@
globals->env.gv= PL_envgv;
globals->inc.gv= PL_incgv;
globals->defout.gv = PL_defoutgv;
-globals->rs.sv = PL_rs;
+globals->rs.sv = &PL_rs;
}
static void
@@ -92,14 +92,14 @@
static void
modperl_perl_global_svpv_save(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-svpv->cur = SvCUR(svpv->sv);
-strncpy(svpv->pv, SvPVX(svpv->sv), sizeof(svpv->pv));
+svpv->cur = SvCUR(*svpv->sv);
+strncpy(svpv->pv, SvPVX(*svpv->sv), sizeof(svpv->pv));
}
static void
modperl_perl_global_svpv_restore(pTHX_ modperl_perl_global_svpv_t *svpv)
{
-sv_setpvn(svpv->sv, svpv->pv, svpv->cur);
+sv_setpvn(*svpv->sv, svpv->pv, svpv->cur);
}
typedef enum {
1.3 +1 -1 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.2
retrieving revision 1.3
diff -u -r1.2 -r1.3
--- modperl_perl_global.h 2001/09/28 19:24:44 1.2
+++ modperl_perl_global.h 2001/09/28 19:53:22 1.3
@@ -19,7 +19,7 @@
} modperl_perl_global_gvio_t;
typedef struct {
-SV *sv;
+SV **sv;
char pv[256]; /* XXX: only need enough for $/ at the moment */
I32 cur;
} modperl_perl_global_svpv_t;
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h modperl_util.h
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 ChangesPath
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.h2001/09/25 19:44:02 1.17
+++ modperl_util.h2001/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))
+#de
cvs commit: modperl-2.0/src/modules/perl modperl_perl_global.c modperl_perl_global.h
dougm 01/09/27 12:03:19
Added: src/modules/perl modperl_perl_global.c modperl_perl_global.h
Log:
new module for managing Perl globals
Revision ChangesPath
1.1 modperl-2.0/src/modules/perl/modperl_perl_global.c
Index: modperl_perl_global.c
===
#include "mod_perl.h"
static void modperl_perl_global_init(pTHX_ modperl_perl_globals_t *globals)
{
globals->inc.gv= PL_incgv;
globals->defout.gv = PL_defoutgv;
globals->rs.sv = PL_rs;
}
static void
modperl_perl_global_gvav_save(pTHX_ modperl_perl_global_gvav_t *gvav)
{
AV *av = GvAV(gvav->gv);
I32 i, fill = AvFILLp(av);
gvav->tmpav = newAV();
av_extend(gvav->tmpav, fill);
AvFILLp(gvav->tmpav) = fill;
for (i=0; i<=fill; i++) {
AvARRAY(gvav->tmpav)[i] = SvREFCNT_inc(AvARRAY(av)[i]);
}
gvav->origav = GvAV(gvav->gv);
GvAV(gvav->gv) = gvav->tmpav;
}
static void
modperl_perl_global_gvav_restore(pTHX_ modperl_perl_global_gvav_t *gvav)
{
GvAV(gvav->gv) = gvav->origav;
SvREFCNT_dec(gvav->tmpav);
}
static void
modperl_perl_global_gvio_save(pTHX_ modperl_perl_global_gvio_t *gvio)
{
gvio->flags = IoFLAGS(GvIOp(gvio->gv));
}
static void
modperl_perl_global_gvio_restore(pTHX_ modperl_perl_global_gvio_t *gvio)
{
IoFLAGS(GvIOp(gvio->gv)) = gvio->flags;
}
static void
modperl_perl_global_svpv_save(pTHX_ modperl_perl_global_svpv_t *svpv)
{
svpv->cur = SvCUR(svpv->sv);
strncpy(svpv->pv, SvPVX(svpv->sv), sizeof(svpv->pv));
}
static void
modperl_perl_global_svpv_restore(pTHX_ modperl_perl_global_svpv_t *svpv)
{
sv_setpvn(svpv->sv, svpv->pv, svpv->cur);
}
typedef enum {
MP_GLOBAL_GVAV,
MP_GLOBAL_GVIO,
MP_GLOBAL_SVPV,
} modperl_perl_global_types_e;
typedef struct {
char *name;
int offset;
modperl_perl_global_types_e type;
} modperl_perl_global_entry_t;
#define MP_GLOBAL_OFFSET(m) \
STRUCT_OFFSET(modperl_perl_globals_t, m)
static modperl_perl_global_entry_t modperl_perl_global_entries[] = {
{"INC",MP_GLOBAL_OFFSET(inc),MP_GLOBAL_GVAV}, /* @INC */
{"STDOUT", MP_GLOBAL_OFFSET(defout), MP_GLOBAL_GVIO}, /* $| */
{"/", MP_GLOBAL_OFFSET(rs), MP_GLOBAL_SVPV}, /* $/ */
{NULL}
};
#define MP_PERL_GLOBAL_SAVE(type, ptr) \
modperl_perl_global_##type##_save( \
aTHX_ (modperl_perl_global_##type##_t *)&(*ptr))
#define MP_PERL_GLOBAL_RESTORE(type, ptr) \
modperl_perl_global_##type##_restore( \
aTHX_ (modperl_perl_global_##type##_t *)&(*ptr))
#define MP_dGLOBAL_PTR(globals, i) \
apr_uint64_t **ptr = (apr_uint64_t **) \
((char *)globals + (int)(long)modperl_perl_global_entries[i].offset)
void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals)
{
int i;
modperl_perl_global_init(aTHX_ globals);
for (i=0; modperl_perl_global_entries[i].name; i++) {
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_SAVE(gvav, ptr);
break;
case MP_GLOBAL_GVIO:
MP_PERL_GLOBAL_SAVE(gvio, ptr);
break;
case MP_GLOBAL_SVPV:
MP_PERL_GLOBAL_SAVE(svpv, ptr);
break;
};
}
}
void modperl_perl_global_restore(pTHX_ modperl_perl_globals_t *globals)
{
int i;
for (i=0; modperl_perl_global_entries[i].name; i++) {
MP_dGLOBAL_PTR(globals, i);
switch (modperl_perl_global_entries[i].type) {
case MP_GLOBAL_GVAV:
MP_PERL_GLOBAL_RESTORE(gvav, ptr);
break;
case MP_GLOBAL_GVIO:
MP_PERL_GLOBAL_RESTORE(gvio, ptr);
break;
case MP_GLOBAL_SVPV:
MP_PERL_GLOBAL_RESTORE(svpv, ptr);
break;
}
}
}
1.1 modperl-2.0/src/modules/perl/modperl_perl_global.h
Index: modperl_perl_global.h
===
#ifndef MODPERL_PERL_GLOBAL_H
#define MODPERL_PERL_GLOBAL_H
typedef struct {
GV *gv;
AV *tmpav;
AV *origav;
} modperl_perl_global_gvav_t;
typedef struct {
GV *gv;
char flags;
} modperl_perl_global_gvio_t;
typedef struct {
SV *sv;
char pv[256]; /* XXX: only need enough for $/ at the moment */
I32 cur;
} modperl_perl_global_svpv_t;
typedef struct {
modperl_perl_global_gvav_t inc;
modperl_perl_global_gvio_t defout;
modperl_perl_global_svpv_t rs;
} modperl_perl_globals_t;
void modperl_perl_global_save(pTHX_ modperl_perl_globals_t *globals);
void
