Another <Perl > section backwards-compatibility item on the TODO list.
Perl $Apache::Server::SaveConfig = 1
in httpd.conf will retain all the code of the <Perl > sections, otherwise,
the whole namespace is whiped (modperl_clear_symtab) stolen from mp1
Gozer out.
# $Id: Apache-Server-SaveConfig.patch,v 1.1 2003/02/27 05:01:21 gozer Exp $
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.134
diff -u -I'$Id' -I'$Revision' -r1.134 Changes
--- Changes 26 Feb 2003 09:32:53 -0000 1.134
+++ Changes 27 Feb 2003 04:58:16 -0000
@@ -10,6 +10,10 @@
=item 1.99_09-dev
+$Apache::Server::SaveConfig added. When set to a true value,
+will not clear the content of Apache::ReadConfig:: once <Perl >
+sections are processed. [Philippe M. Chiasson <[EMAIL PROTECTED]
+
$Apache::Server::StrictPerlSections added. When set to a true
value, will abort server startup if there are syntax errors
in <Perl > sections [Philippe M. Chiasson <[EMAIL PROTECTED]
Index: STATUS
===================================================================
RCS file: /home/cvs/modperl-2.0/STATUS,v
retrieving revision 1.35
diff -u -I'$Id' -I'$Revision' -r1.35 STATUS
--- STATUS 26 Feb 2003 09:32:53 -0000 1.35
+++ STATUS 27 Feb 2003 04:58:22 -0000
@@ -152,7 +152,6 @@
----
* Apache::PerlSections missing features for backwards compatibility:
- - $Apache::Server::SaveConfig
- $Apache::ReadConfig::DocumentRoot
- Apache::PerlSections->store(filename)
Index: src/modules/perl/modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.38
diff -u -I'$Id' -I'$Revision' -r1.38 modperl_cmd.c
--- src/modules/perl/modperl_cmd.c 26 Feb 2003 09:32:54 -0000 1.38
+++ src/modules/perl/modperl_cmd.c 27 Feb 2003 04:58:27 -0000
@@ -318,6 +318,8 @@
#define MP_DEFAULT_PERLSECTION_PACKAGE "Apache::ReadConfig"
#define MP_STRICT_PERLSECTIONS_SV \
get_sv("Apache::Server::StrictPerlSections", FALSE)
+#define MP_PERLSECTIONS_SAVECONFIG_SV \
+get_sv("Apache::Server::SaveConfig", FALSE)
MP_CMD_SRV_DECLARE(perldo)
{
@@ -385,6 +387,7 @@
}
if (handler) {
+ SV *saveconfig;
modperl_handler_make_args(aTHX_ &args,
"Apache::CmdParms", parms,
"APR::Table", options,
@@ -394,6 +397,13 @@
SvREFCNT_dec((SV*)args);
+ if ((saveconfig = MP_PERLSECTIONS_SAVECONFIG_SV) && SvTRUE(saveconfig)) {
+ HV *symtab = (HV*)gv_stashpv(package_name, FALSE);
+ if(symtab) {
+ modperl_clear_symtab(aTHX_ symtab);
+ }
+ }
+
if (status != OK) {
return SvTRUE(ERRSV) ? SvPVX(ERRSV) :
apr_psprintf(p, "<Perl> handler %s failed with status=%d",
Index: src/modules/perl/modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.50
diff -u -I'$Id' -I'$Revision' -r1.50 modperl_util.c
--- src/modules/perl/modperl_util.c 11 Jan 2003 00:02:16 -0000 1.50
+++ src/modules/perl/modperl_util.c 27 Feb 2003 04:58:33 -0000
@@ -615,3 +615,56 @@
return rv;
}
+static int modperl_gvhv_is_stash(GV *gv)
+{
+ int len = GvNAMELEN(gv);
+ char *name = GvNAME(gv);
+
+ if ((len > 2) && (name[len - 1] == ':') && (name[len - 2] == ':')) {
+ return 1;
+ }
+
+ return 0;
+}
+
+/*
+ * we do not clear symbols within packages, the desired behavior
+ * for directive handler classes. and there should never be a package
+ * within the %Apache::ReadConfig. nothing else that i'm aware of calls
+ * this function, so we should be ok.
+ */
+
+void modperl_clear_symtab(pTHX_ HV *symtab)
+{
+ SV *val;
+ char *key;
+ I32 klen;
+
+ hv_iterinit(symtab);
+
+ while ((val = hv_iternextsv(symtab, &key, &klen))) {
+ SV *sv;
+ HV *hv;
+ AV *av;
+ CV *cv;
+
+ if ((SvTYPE(val) != SVt_PVGV) || GvIMPORTED((GV*)val)) {
+ continue;
+ }
+ if ((sv = GvSV((GV*)val))) {
+ sv_setsv(GvSV((GV*)val), &PL_sv_undef);
+ }
+ if ((hv = GvHV((GV*)val)) && !modperl_gvhv_is_stash((GV*)val)) {
+ hv_clear(hv);
+ }
+ if ((av = GvAV((GV*)val))) {
+ av_clear(av);
+ }
+ if ((cv = GvCV((GV*)val)) && (GvSTASH((GV*)val) == GvSTASH(CvGV(cv)))) {
+ GV *gv = CvGV(cv);
+ cv_undef(cv);
+ CvGV(cv) = gv;
+ GvCVGEN(gv) = 1; /* invalidate method cache */
+ }
+ }
+}
Index: src/modules/perl/modperl_util.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.h,v
retrieving revision 1.38
diff -u -I'$Id' -I'$Revision' -r1.38 modperl_util.h
--- src/modules/perl/modperl_util.h 23 Jan 2003 00:31:28 -0000 1.38
+++ src/modules/perl/modperl_util.h 27 Feb 2003 04:58:38 -0000
@@ -126,4 +126,6 @@
SV *modperl_perl_gensym(pTHX_ char *pack);
+void modperl_clear_symtab(pTHX_ HV *symtab);
+
#endif /* MODPERL_UTIL_H */
--
--------------------------------------------------------------------------------
Philippe M. Chiasson /[EMAIL PROTECTED](x|X)tropia\.com/ 88C3A5A5
(122FF51B/C634E37B)
http://www.eXtropia.com/ F9BF E0C2 480E 7680 1AE5 3631 CB32 A107
88C3 A5A5
signature.asc
Description: This is a digitally signed message part
