gozer 2003/03/04 01:42:42
Modified: . Changes STATUS
src/modules/perl modperl_cmd.c modperl_util.c modperl_util.h
t/conf extra.last.conf.in
t/response/TestDirective perldo.pm
xs/tables/current/ModPerl FunctionTable.pm
Log:
$Apache::Server::SaveConfig added. When set to a true value,
will not clear the content of Apache::ReadConfig:: once <Perl >
sections are processed.
Revision Changes Path
1.143 +4 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.142
retrieving revision 1.143
diff -u -r1.142 -r1.143
--- Changes 4 Mar 2003 00:56:26 -0000 1.142
+++ Changes 4 Mar 2003 09:42:41 -0000 1.143
@@ -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::compat: support 1.0's Apache->push_handlers,
Apache->set_handlers and Apache->get_handlers [Stas]
1.38 +1 -2 modperl-2.0/STATUS
Index: STATUS
===================================================================
RCS file: /home/cvs/modperl-2.0/STATUS,v
retrieving revision 1.37
retrieving revision 1.38
diff -u -r1.37 -r1.38
--- STATUS 3 Mar 2003 03:50:55 -0000 1.37
+++ STATUS 4 Mar 2003 09:42:41 -0000 1.38
@@ -177,7 +177,6 @@
----
* Apache::PerlSections missing features for backwards compatibility:
- - $Apache::Server::SaveConfig
- $Apache::ReadConfig::DocumentRoot
- Apache::PerlSections->store(filename)
1.40 +10 -0 modperl-2.0/src/modules/perl/modperl_cmd.c
Index: modperl_cmd.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_cmd.c,v
retrieving revision 1.39
retrieving revision 1.40
diff -u -r1.39 -r1.40
--- modperl_cmd.c 3 Mar 2003 05:16:07 -0000 1.39
+++ modperl_cmd.c 4 Mar 2003 09:42:42 -0000 1.40
@@ -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",
1.51 +53 -0 modperl-2.0/src/modules/perl/modperl_util.c
Index: modperl_util.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_util.c,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -r1.50 -r1.51
--- modperl_util.c 11 Jan 2003 00:02:16 -0000 1.50
+++ modperl_util.c 4 Mar 2003 09:42:42 -0000 1.51
@@ -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 */
+ }
+ }
+}
1.39 +2 -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.38
retrieving revision 1.39
diff -u -r1.38 -r1.39
--- modperl_util.h 23 Jan 2003 00:31:28 -0000 1.38
+++ modperl_util.h 4 Mar 2003 09:42:42 -0000 1.39
@@ -126,4 +126,6 @@
SV *modperl_perl_gensym(pTHX_ char *pack);
+void modperl_clear_symtab(pTHX_ HV *symtab);
+
#endif /* MODPERL_UTIL_H */
1.6 +7 -0 modperl-2.0/t/conf/extra.last.conf.in
Index: extra.last.conf.in
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- extra.last.conf.in 4 Mar 2003 03:35:05 -0000 1.5
+++ extra.last.conf.in 4 Mar 2003 09:42:42 -0000 1.6
@@ -12,6 +12,13 @@
};
</Perl>
+<Perl >
+$Apache::Server::SaveConfig = 1;
+$Location{'/perl_sections_saved'} = {
+ 'AuthName' => 'PerlSection',
+ };
+</Perl>
+
### --------------------------------- ###
Perl $TestDirective::perl::worked="yes";
1.2 +7 -1 modperl-2.0/t/response/TestDirective/perldo.pm
Index: perldo.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestDirective/perldo.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- perldo.pm 7 Oct 2002 02:35:18 -0000 1.1
+++ perldo.pm 4 Mar 2003 09:42:42 -0000 1.2
@@ -10,9 +10,15 @@
sub handler {
my $r = shift;
- plan $r, tests => 1;
+ plan $r, tests => 4;
ok t_cmp('yes', $TestDirective::perl::worked);
+
+ ok not exists $Apache::ReadConfig::Location{'/perl_sections'};
+
+ ok exists $Apache::ReadConfig::Location{'/perl_sections_saved'};
+
+ ok t_cmp('PerlSection',
$Apache::ReadConfig::Location{'/perl_sections_saved'}{'AuthName'});
Apache::OK;
}
1.108 +14 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm
Index: FunctionTable.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.107
retrieving revision 1.108
diff -u -r1.107 -r1.108
--- FunctionTable.pm 3 Mar 2003 03:39:06 -0000 1.107
+++ FunctionTable.pm 4 Mar 2003 09:42:42 -0000 1.108
@@ -3635,6 +3635,20 @@
}
]
},
+ {
+ 'return_type' => 'void',
+ 'name' => 'modperl_clear_symtab',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'HV *',
+ 'name' => 'symtab'
+ },
+ ],
+ },
{
'return_type' => 'HE *',
'name' => 'modperl_perl_hv_fetch_he',
