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);
