You are viewing a plain text version of this content. The canonical link for it is here.
Posted to modperl-cvs@perl.apache.org by st...@apache.org on 2004/04/02 04:17:47 UTC
cvs commit: modperl-2.0/todo release
stas 2004/04/01 18:17:46
Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
ModPerl-Registry/t perlrun_extload.t special_blocks.t
ModPerl-Registry/t/cgi-bin perlrun_decl.pm
perlrun_extload.pl perlrun_nondecl.pl
special_blocks.pl
ModPerl-Registry/t/conf modperl_extra_startup.pl
src/modules/perl mod_perl.c modperl_handler.c modperl_perl.c
modperl_perl.h modperl_perl_global.c
modperl_perl_global.h modperl_util.c modperl_util.h
t/response/TestModperl endav.pm
xs/ModPerl/Global ModPerl__Global.h
xs/maps modperl_functions.map
xs/tables/current/ModPerl FunctionTable.pm
. Changes
todo release
Log:
'SetHandler perl-script' no longer grabs any newly encountered END
blocks, and removes them from PL_endav, but only if they are
explicitly registered via ModPerl::Global::special_list_register(END
=> $package_name) (this is a new function). It's now possible to have
a complete control of when END blocks are run from the user space, not
only in the registry handlers [Stas]
END blocks encountered by child processes and not hijacked by
ModPerl::Global::special_list_register() are now executed at the
server shutdown (previously they weren't executed at all). [Stas]
and a few other assorted re-shufflings, too intervowen to commit
separately
Revision Changes Path
1.46 +2 -1 modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm
Index: RegistryCooker.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/lib/ModPerl/RegistryCooker.pm,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -u -r1.45 -r1.46
--- RegistryCooker.pm 10 Mar 2004 23:19:44 -0000 1.45
+++ RegistryCooker.pm 2 Apr 2004 02:17:45 -0000 1.46
@@ -690,7 +690,8 @@
$self->debug("compiling $self->{FILENAME}") if DEBUG && D_COMPILE;
- ModPerl::Global::special_list_clear(END => $self->{PACKAGE});
+ ModPerl::Global::special_list_register(END => $self->{PACKAGE});
+ ModPerl::Global::special_list_clear( END => $self->{PACKAGE});
{
# let the code define its own warn and strict level
1.2 +1 -1 modperl-2.0/ModPerl-Registry/t/perlrun_extload.t
Index: perlrun_extload.t
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/perlrun_extload.t,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- perlrun_extload.t 9 Mar 2004 06:35:34 -0000 1.1
+++ perlrun_extload.t 2 Apr 2004 02:17:45 -0000 1.2
@@ -15,7 +15,7 @@
my $res = get_body($same_interp, $url);
skip_not_same_interp(
!defined($res),
- "01234",
+ "d1nd1234",
$res,
"PerlRun requiring an external lib with subs",
);
1.9 +3 -0 modperl-2.0/ModPerl-Registry/t/special_blocks.t
Index: special_blocks.t
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/special_blocks.t,v
retrieving revision 1.8
retrieving revision 1.9
diff -u -u -r1.8 -r1.9
--- special_blocks.t 22 Nov 2003 07:38:48 -0000 1.8
+++ special_blocks.t 2 Apr 2004 02:17:45 -0000 1.9
@@ -20,6 +20,9 @@
{
# PerlRun always run BEGIN/END since it's never cached
+ # see also t/perlrun_extload.t which exercises BEGIN/END blocks
+ # from external modules loaded from PerlRun scripts
+
my $alias = "perlrun";
my $url = "/same_interp/$alias/special_blocks.pl";
my $same_interp = Apache::TestRequest::same_interp_tie($url);
1.2 +13 -1 modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_decl.pm
Index: perlrun_decl.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_decl.pm,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- perlrun_decl.pm 9 Mar 2004 06:35:34 -0000 1.1
+++ perlrun_decl.pm 2 Apr 2004 02:17:45 -0000 1.2
@@ -6,6 +6,18 @@
use base qw(Exporter);
our @EXPORT = qw(decl_proto);
-sub decl_proto ($;$) { my $x = shift; $x*"0"; }
+# this BEGIN block is called only once, since this module doesn't get
+# removed from %INC after it was loaded
+BEGIN {
+ # use an external package which will persist across requests
+ $MyData::blocks{perlrun_decl}++;
+}
+
+sub decl_proto ($;$) { shift }
+
+# this END block won't be executed until the server shutdown
+END {
+ $MyData::blocks{perlrun_decl}--;
+}
1;
1.3 +50 -27 modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_extload.pl
Index: perlrun_extload.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_extload.pl,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -u -r1.2 -r1.3
--- perlrun_extload.pl 9 Mar 2004 06:54:14 -0000 1.2
+++ perlrun_extload.pl 2 Apr 2004 02:17:45 -0000 1.3
@@ -6,33 +6,56 @@
use File::Spec::Functions qw(catfile catdir);
use lib catdir Apache::Test::vars('serverroot'), 'cgi-bin';
-my $require = catfile Apache::Test::vars('serverroot'), 'cgi-bin',
- 'perlrun_nondecl.pl';
-
-# require a module w/ package declaration (it doesn't get reloaded
-# because it declares the package). But we still have a problem with
-# subs declaring prototypes. When perlrun_decl->import is called, the
-# original function's prototype doesn't match the aliases prototype.
-# see decl_proto()
-BEGIN { t_server_log_warn_is_expected() if perlrun_decl->can("decl_proto"); }
-use perlrun_decl;
-
-# require a lib w/o package declaration. Functions in that lib get
-# automatically aliased to the functions in the current package.
-require "$require";
+my $require = catfile Apache::Test::vars('serverroot'),
+ qw(cgi-bin perlrun_nondecl.pl);
print "Content-type: text/plain\n\n";
-### declared package module
-print decl_proto(0);
-
-### non-declared package module
-# they all get redefined warning inside perlrun_nondecl.pl, since that
-# lib loads it into main::, vs. PerlRun undefs the current __PACKAGE__
-print nondecl_no_proto();
-print nondecl_proto(2);
-print nondecl_proto_empty("whatever");
-print nondecl_const();
-
-
-
+### declared package module ###
+{
+ # require a module w/ package declaration (it doesn't get reloaded
+ # because it declares the package). But we still have a problem with
+ # subs declaring prototypes. When perlrun_decl->import is called, the
+ # original function's prototype doesn't match the aliases prototype.
+ # see decl_proto()
+ BEGIN { t_server_log_warn_is_expected()
+ if perlrun_decl->can("decl_proto");
+ }
+ use perlrun_decl;
+
+ die "perlrun_decl BEGIN block was run more than once"
+ if $MyData::blocks{perlrun_decl} > 1;
+
+ print "d";
+ print decl_proto(1);
+}
+
+### non-declared package module ###
+{
+ # how many times were were called from the same interpreter
+ $MyData::blocks{cycle}{perlrun_nondecl}++;
+ $MyData::blocks{BEGIN}{perlrun_nondecl} ||= 0;
+ $MyData::blocks{END} {perlrun_nondecl} ||= 0;
+
+ # require a lib w/o package declaration. Functions in that lib get
+ # automatically aliased to the functions in the current package.
+ require "$require";
+
+ die "perlrun_nondecl's BEGIN block wasn't run"
+ if $MyData::blocks{BEGIN}{perlrun_nondecl} !=
+ $MyData::blocks{cycle}{perlrun_nondecl};
+
+ # the END block for this cycle didn't run yet, but we can test the
+ # previous cycle's one
+ die "perlrun_nondecl's END block wasn't run"
+ if $MyData::blocks{END}{perlrun_nondecl} + 1 !=
+ $MyData::blocks{cycle}{perlrun_nondecl};
+
+ # they all get redefined warning inside perlrun_nondecl.pl, since that
+ # lib loads it into main::, vs. PerlRun undefs the current __PACKAGE__
+ print "nd";
+ print nondecl_no_proto();
+ print nondecl_proto(2);
+ print nondecl_proto_empty("whatever");
+ print nondecl_const();
+}
1.2 +11 -2 modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_nondecl.pl
Index: perlrun_nondecl.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/perlrun_nondecl.pl,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -u -r1.1 -r1.2
--- perlrun_nondecl.pl 9 Mar 2004 06:35:34 -0000 1.1
+++ perlrun_nondecl.pl 2 Apr 2004 02:17:45 -0000 1.2
@@ -5,9 +5,16 @@
my $num;
+# this BEGIN block is called on every request, since this file gets
+# removed from %INC after it was loaded
+BEGIN {
+ # use an external package which will persist across requests
+ $MyData::blocks{BEGIN}{perlrun_nondecl}++;
+}
+
use subs qw(warn_exp);
-# all subs in tis file get 'redefined' warning because they are
+# all subs in this file get 'redefined' warning because they are
# reloaded in the main:: package, which is not under PerlRun's
# control.
@@ -41,6 +48,8 @@
# a constant.
sub nondecl_const () { 4 }
-
+END {
+ $MyData::blocks{END}{perlrun_nondecl}++;
+}
1;
1.6 +1 -1 modperl-2.0/ModPerl-Registry/t/cgi-bin/special_blocks.pl
Index: special_blocks.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/cgi-bin/special_blocks.pl,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -u -r1.5 -r1.6
--- special_blocks.pl 16 Aug 2002 10:11:39 -0000 1.5
+++ special_blocks.pl 2 Apr 2004 02:17:45 -0000 1.6
@@ -1,6 +1,7 @@
#!perl -w
# test BEGIN/END blocks
+
use Apache::RequestRec ();
use vars qw($query);
@@ -31,4 +32,3 @@
print "end ok";
}
}
-
1.15 +1 -1 modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl
Index: modperl_extra_startup.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/ModPerl-Registry/t/conf/modperl_extra_startup.pl,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -u -r1.14 -r1.15
--- modperl_extra_startup.pl 19 Jan 2004 19:59:58 -0000 1.14
+++ modperl_extra_startup.pl 2 Apr 2004 02:17:45 -0000 1.15
@@ -35,7 +35,7 @@
);
my @preload = qw(basic.pl env.pl require.pl special_blocks.pl
- redirect.pl 206.pl content_type.pl);
+ redirect.pl 206.pl content_type.pl);
for my $file (@preload) {
$rl->handler("/registry_bb/$file");
1.212 +27 -3 modperl-2.0/src/modules/perl/mod_perl.c
Index: mod_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/mod_perl.c,v
retrieving revision 1.211
retrieving revision 1.212
diff -u -u -r1.211 -r1.212
--- mod_perl.c 4 Mar 2004 06:01:06 -0000 1.211
+++ mod_perl.c 2 Apr 2004 02:17:45 -0000 1.212
@@ -645,13 +645,26 @@
return modperl_destruct_level;
}
+#ifdef USE_ITHREADS
+
+static apr_status_t
+modperl_perl_call_endav_mip(pTHX_ modperl_interp_pool_t *mip,
+ void *data)
+{
+ modperl_perl_call_endav(aTHX);
+ return APR_SUCCESS;
+}
+
+#endif /* USE_ITHREADS */
+
static apr_status_t modperl_child_exit(void *data)
{
char *level = NULL;
server_rec *s = (server_rec *)data;
-
- modperl_callback_process(MP_CHILD_EXIT_HANDLER, server_pool, s, MP_HOOK_VOID);
-
+
+ modperl_callback_process(MP_CHILD_EXIT_HANDLER, server_pool, s,
+ MP_HOOK_VOID);
+
if ((level = getenv("PERL_DESTRUCT_LEVEL"))) {
modperl_destruct_level = atoi(level);
}
@@ -662,6 +675,17 @@
if (modperl_destruct_level) {
apr_pool_clear(server_pool);
+ }
+ else {
+ /* run the END blocks of this child process if
+ * modperl_perl_destruct is not called for this process */
+#ifdef USE_ITHREADS
+ modperl_interp_mip_walk_servers(NULL, s,
+ modperl_perl_call_endav_mip,
+ (void*)NULL);
+#else
+ modperl_perl_call_endav(aTHX);
+#endif
}
server_pool = NULL;
1.27 +0 -63 modperl-2.0/src/modules/perl/modperl_handler.c
Index: modperl_handler.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_handler.c,v
retrieving revision 1.26
retrieving revision 1.27
diff -u -u -r1.26 -r1.27
--- modperl_handler.c 4 Mar 2004 06:01:07 -0000 1.26
+++ modperl_handler.c 2 Apr 2004 02:17:45 -0000 1.27
@@ -15,69 +15,6 @@
#include "mod_perl.h"
-#ifdef USE_ITHREADS
-static
-char *modperl_coderef2text(pTHX_ apr_pool_t *p, CV *cv)
-{
- dSP;
- int count;
- SV *bdeparse;
- char *text;
-
- /* B::Deparse >= 0.61 needed for blessed code references.
- * 0.6 works fine for non-blessed code refs.
- * notice that B::Deparse is not CPAN-updatable.
- * 0.61 is available starting from 5.8.0
- */
- load_module(PERL_LOADMOD_NOIMPORT,
- newSVpvn("B::Deparse", 10),
- newSVnv(SvOBJECT((SV*)cv) ? 0.61 : 0.60));
-
- ENTER;
- SAVETMPS;
-
- /* create the B::Deparse object */
- PUSHMARK(sp);
- XPUSHs(sv_2mortal(newSVpvn("B::Deparse", 10)));
- PUTBACK;
- count = call_method("new", G_SCALAR);
- SPAGAIN;
- if (count != 1) {
- Perl_croak(aTHX_ "Unexpected return value from B::Deparse::new\n");
- }
- if (SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ "error: %s", SvPVX(ERRSV));
- }
- bdeparse = POPs;
-
- PUSHMARK(sp);
- XPUSHs(bdeparse);
- XPUSHs(sv_2mortal(newRV_inc((SV*)cv)));
- PUTBACK;
- count = call_method("coderef2text", G_SCALAR);
- SPAGAIN;
- if (count != 1) {
- Perl_croak(aTHX_ "Unexpected return value from "
- "B::Deparse::coderef2text\n");
- }
- if (SvTRUE(ERRSV)) {
- Perl_croak(aTHX_ "error: %s", SvPVX(ERRSV));
- }
-
- {
- STRLEN n_a;
- text = apr_pstrcat(p, "sub ", POPpx, NULL);
- }
-
- PUTBACK;
-
- FREETMPS;
- LEAVE;
-
- return text;
-}
-#endif
-
modperl_handler_t *modperl_handler_new(apr_pool_t *p, const char *name)
{
modperl_handler_t *handler =
1.22 +10 -5 modperl-2.0/src/modules/perl/modperl_perl.c
Index: modperl_perl.c
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.c,v
retrieving revision 1.21
retrieving revision 1.22
diff -u -u -r1.21 -r1.22
--- modperl_perl.c 4 Mar 2004 06:01:07 -0000 1.21
+++ modperl_perl.c 2 Apr 2004 02:17:45 -0000 1.22
@@ -57,7 +57,7 @@
ids->gid = getgid();
ids->gid = getegid();
- MP_TRACE_g(MP_FUNC,
+ MP_TRACE_r(MP_FUNC,
"pid=%d, "
#ifdef MP_MAINTAIN_PPID
"ppid=%d, "
@@ -120,6 +120,8 @@
PERL_SET_CONTEXT(perl);
+ modperl_perl_call_endav(aTHX);
+
PL_perl_destruct_level = modperl_perl_destruct_level();
#ifdef USE_ENVIRON_ARRAY
@@ -144,10 +146,6 @@
# endif
#endif
- if (PL_endav) {
- modperl_perl_call_list(aTHX_ PL_endav, "END");
- }
-
{
dTHXa(perl);
@@ -174,6 +172,13 @@
environ = orig_environ;
}
#endif
+}
+
+void modperl_perl_call_endav(pTHX)
+{
+ if (PL_endav) {
+ modperl_perl_call_list(aTHX_ PL_endav, "END");
+ }
}
#if !(PERL_REVISION == 5 && ( PERL_VERSION < 8 || \
1.16 +2 -0 modperl-2.0/src/modules/perl/modperl_perl.h
Index: modperl_perl.h
===================================================================
RCS file: /home/cvs/modperl-2.0/src/modules/perl/modperl_perl.h,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -u -r1.15 -r1.16
--- modperl_perl.h 4 Mar 2004 06:01:07 -0000 1.15
+++ modperl_perl.h 2 Apr 2004 02:17:45 -0000 1.16
@@ -40,6 +40,8 @@
void modperl_perl_destruct(PerlInterpreter *perl);
+void modperl_perl_call_endav(pTHX);
+
void modperl_hash_seed_init(apr_pool_t *p);
void modperl_hash_seed_set(pTHX);
1.21 +102 -45 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.20
retrieving revision 1.21
diff -u -u -r1.20 -r1.21
--- modperl_perl_global.c 18 Mar 2004 22:53:31 -0000 1.20
+++ modperl_perl_global.c 2 Apr 2004 02:17:45 -0000 1.21
@@ -21,7 +21,7 @@
globals->inc.gv = PL_incgv;
globals->defout.gv = PL_defoutgv;
globals->rs.sv = &PL_rs;
- globals->end.av = &PL_endav;
+ globals->end.av = PL_endav;
globals->end.key = MP_MODGLOBAL_END;
}
@@ -65,78 +65,142 @@
return NULL;
}
+/*
+ * if (exists $PL_modglobal{$key}{$package}) {
+ * return $PL_modglobal{$key}{$package};
+ * }
+ * elsif ($autovivify) {
+ * return $PL_modglobal{$key}{$package} = [];
+ * }
+ * else {
+ * return $Nullav; # a null pointer in C of course :)
+ * }
+ */
static AV *modperl_perl_global_avcv_fetch(pTHX_ modperl_modglobal_key_t *gkey,
- const char *package, I32 packlen)
+ const char *package, I32 packlen,
+ I32 autovivify)
{
HE *he = MP_MODGLOBAL_FETCH(gkey);
HV *hv;
if (!(he && (hv = (HV*)HeVAL(he)))) {
- return Nullav;
+ if (autovivify) {
+ hv = MP_MODGLOBAL_STORE_HV(gkey);
+ }
+ else {
+ return Nullav;
+ }
}
- if (!(he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
- return Nullav;
+ if ((he = hv_fetch_he(hv, (char *)package, packlen, 0))) {
+ return (AV*)HeVAL(he);
+ }
+ else {
+ if (autovivify) {
+ return (AV*)*hv_store(hv, package, packlen, (SV*)newAV(), 0);
+ }
+ else {
+ return Nullav;
+ }
}
+}
+
+/* autovivify $PL_modglobal{$key}{$package} if it doesn't exist yet,
+ * so that in modperl_perl_global_avcv_set we will know whether to
+ * store blocks in it or keep them in the original list.
+ *
+ * For example in the case of END blocks, if
+ * $PL_modglobal{END}{$package} exists, modperl_perl_global_avcv_set
+ * will push newly encountered END blocks to it, otherwise it'll keep
+ * them in PL_endav.
+ */
+void modperl_perl_global_avcv_register(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen)
+{
+ AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey,
+ package, packlen, TRUE);
- return (AV*)HeVAL(he);
+ MP_TRACE_g(MP_FUNC, "register PL_modglobal %s::%s (has %d entries)",
+ package, (char*)gkey->name, av ? 1+av_len(av) : 0);
}
+/* if (exists $PL_modglobal{$key}{$package}) {
+ * for my $cv (@{ $PL_modglobal{$key}{$package} }) {
+ * $cv->();
+ * }
+ * }
+ */
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);
+ AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen,
+ FALSE);
- if (!av) {
- return;
- }
+ MP_TRACE_g(MP_FUNC, "run PL_modglobal %s::%s (has %d entries)",
+ package, (char*)gkey->name, av ? 1+av_len(av) : 0);
- modperl_perl_call_list(aTHX_ av, gkey->name);
+ if (av) {
+ modperl_perl_call_list(aTHX_ av, gkey->name);
+ }
}
+
+/* if (exists $PL_modglobal{$key}{$package}) {
+ * @{ $PL_modglobal{$key}{$package} } = ();
+ * }
+ */
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);
+ AV *av = modperl_perl_global_avcv_fetch(aTHX_ gkey,
+ package, packlen, FALSE);
- if (!av) {
- return;
+ MP_TRACE_g(MP_FUNC, "clear PL_modglobal %s::%s (has %d entries)",
+ package, (char*)gkey->name, av ? 1+av_len(av) : 0);
+
+ if (av) {
+ av_clear(av);
}
-
- av_clear(av);
}
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);
I32 packlen = strlen(package);
modperl_modglobal_key_t *gkey =
(modperl_modglobal_key_t *)mg->mg_ptr;
- if ((he = MP_MODGLOBAL_FETCH(gkey))) {
- hv = (HV*)HeVAL(he);
- }
- else {
- hv = MP_MODGLOBAL_STORE_HV(gkey);
- }
-
- 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)];
- AvARRAY(av)[AvFILLp(av)--] = &PL_sv_undef;
-
+ /* the argument sv, is the original list perl was operating on.
+ * (e.g. PL_endav). So now if we find that we have package/cv name
+ * (e.g. Foo/END) registered for set-aside, we remove the cv that
+ * was just unshifted in and push it into
+ * $PL_modglobal{$key}{$package}. Otherwise we do nothing, which
+ * keeps the unshifted cv (e.g. END block) in its original av
+ * (e.g. PL_endav)
+ */
+
+ mav = modperl_perl_global_avcv_fetch(aTHX_ gkey, package, packlen, FALSE);
+
+ if (!mav) {
+ MP_TRACE_g(MP_FUNC, "%s::%s is not going to PL_modglobal",
+ package, (char*)gkey->name);
+ /* keep it in the tied list (e.g. PL_endav) */
+ return 1;
+ }
+
+ MP_TRACE_g(MP_FUNC, "%s::%s is going into PL_modglobal",
+ package, (char*)gkey->name);
+
+ sv = av_shift(av);
+
/* push @{ $PL_modglobal{$key}{$package} }, $cv */
av_store(mav, AvFILLp(mav)+1, sv);
+ /* print scalar @{ $PL_modglobal{$key}{$package} } */
+ MP_TRACE_g(MP_FUNC, "%s::%s av now has %d entries\n",
+ package, (char*)gkey->name, 1+av_len(mav));
+
return 1;
}
@@ -146,9 +210,6 @@
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)
{
@@ -172,17 +233,13 @@
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);
+ 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;
+ modperl_perl_global_avcv_untie(aTHX_ avcv->av);
}
/*
1.13 +4 -2 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.12
retrieving revision 1.13
diff -u -u -r1.12 -r1.13
--- modperl_perl_global.h 4 Mar 2004 06:01:07 -0000 1.12
+++ modperl_perl_global.h 2 Apr 2004 02:17:45 -0000 1.13
@@ -28,8 +28,7 @@
} modperl_modglobal_key_e;
typedef struct {
- AV **av;
- AV *origav;
+ AV *av;
modperl_modglobal_key_e key;
} modperl_perl_global_avcv_t;
@@ -71,6 +70,9 @@
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_register(pTHX_ modperl_modglobal_key_t *gkey,
+ const char *package, I32 packlen);
void modperl_perl_global_avcv_call(pTHX_ modperl_modglobal_key_t *gkey,
const char *package, I32 packlen);
1.65 +116 -25 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.64
retrieving revision 1.65
diff -u -u -r1.64 -r1.65
--- modperl_util.c 5 Mar 2004 18:19:15 -0000 1.64
+++ modperl_util.c 2 Apr 2004 02:17:45 -0000 1.65
@@ -338,7 +338,7 @@
void **handles;
if (!librefs) {
- MP_TRACE_g(MP_FUNC,
+ MP_TRACE_r(MP_FUNC,
"Could not get @%s for unloading.\n",
dl_librefs);
return NULL;
@@ -357,14 +357,14 @@
SV *module_sv = *av_fetch(modules, i, FALSE);
if(!handle_sv) {
- MP_TRACE_g(MP_FUNC,
+ MP_TRACE_r(MP_FUNC,
"Could not fetch $%s[%d]!\n",
dl_librefs, (int)i);
continue;
}
handle = (void *)SvIV(handle_sv);
- MP_TRACE_g(MP_FUNC, "%s dl handle == 0x%lx\n",
+ MP_TRACE_r(MP_FUNC, "%s dl handle == 0x%lx\n",
SvPVX(module_sv), (unsigned long)handle);
if (handle) {
handles[i] = handle;
@@ -388,7 +388,7 @@
}
for (i=0; handles[i]; i++) {
- MP_TRACE_g(MP_FUNC, "close 0x%lx\n", (unsigned long)handles[i]);
+ MP_TRACE_r(MP_FUNC, "close 0x%lx\n", (unsigned long)handles[i]);
modperl_sys_dlclose(handles[i]);
}
@@ -544,6 +544,13 @@
{
I32 i, oldscope = PL_scopestack_ix;
SV **ary = AvARRAY(subs);
+
+ /* XXX: why this trace doesn't get printed to error_log when this
+ * method is called from modperl_perl_destruct. Perl_warn works
+ * just fine. may be we need to switch to perl_warn when apache
+ * closes the logging api (when?) */
+ MP_TRACE_g(MP_FUNC, "pid %lu running %d %s subs",
+ (unsigned long)getpid(), AvFILLp(subs)+1, name);
for (i=0; i<=AvFILLp(subs); i++) {
CV *cv = (CV*)ary[i];
@@ -764,27 +771,6 @@
return newRV_noinc(sv);
}
-#ifdef MP_TRACE
-/* XXX: internal debug function */
-/* any non-false value for MOD_PERL_TRACE/PerlTrace enables this function */
-void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name)
-{
- int i;
- const apr_array_header_t *array;
- apr_table_entry_t *elts;
-
- array = apr_table_elts(table);
- elts = (apr_table_entry_t *)array->elts;
- modperl_trace(MP_FUNC, "Contents of table %s", name);
- for (i = 0; i < array->nelts; i++) {
- if (!elts[i].key || !elts[i].val) {
- continue;
- }
- modperl_trace(MP_FUNC, "%s => %s", elts[i].key, elts[i].val);
- }
-}
-#endif
-
#define MP_VALID_PKG_CHAR(c) (isalnum(c) ||(c) == '_')
#define MP_VALID_PATH_DELIM(c) ((c) == '/' || (c) =='\\')
char *modperl_file2package(apr_pool_t *p, const char *file)
@@ -858,3 +844,108 @@
/* copy the SV in case the pool goes out of scope before the perl scalar */
return newSVpv(ap_server_root_relative(p, fname), 0);
}
+
+char *modperl_coderef2text(pTHX_ apr_pool_t *p, CV *cv)
+{
+ dSP;
+ int count;
+ SV *bdeparse;
+ char *text;
+
+ /* B::Deparse >= 0.61 needed for blessed code references.
+ * 0.6 works fine for non-blessed code refs.
+ * notice that B::Deparse is not CPAN-updatable.
+ * 0.61 is available starting from 5.8.0
+ */
+ load_module(PERL_LOADMOD_NOIMPORT,
+ newSVpvn("B::Deparse", 10),
+ newSVnv(SvOBJECT((SV*)cv) ? 0.61 : 0.60));
+
+ ENTER;
+ SAVETMPS;
+
+ /* create the B::Deparse object */
+ PUSHMARK(sp);
+ XPUSHs(sv_2mortal(newSVpvn("B::Deparse", 10)));
+ PUTBACK;
+ count = call_method("new", G_SCALAR);
+ SPAGAIN;
+ if (count != 1) {
+ Perl_croak(aTHX_ "Unexpected return value from B::Deparse::new\n");
+ }
+ if (SvTRUE(ERRSV)) {
+ Perl_croak(aTHX_ "error: %s", SvPVX(ERRSV));
+ }
+ bdeparse = POPs;
+
+ PUSHMARK(sp);
+ XPUSHs(bdeparse);
+ XPUSHs(sv_2mortal(newRV_inc((SV*)cv)));
+ PUTBACK;
+ count = call_method("coderef2text", G_SCALAR);
+ SPAGAIN;
+ if (count != 1) {
+ Perl_croak(aTHX_ "Unexpected return value from "
+ "B::Deparse::coderef2text\n");
+ }
+ if (SvTRUE(ERRSV)) {
+ Perl_croak(aTHX_ "error: %s", SvPVX(ERRSV));
+ }
+
+ {
+ STRLEN n_a;
+ text = apr_pstrcat(p, "sub ", POPpx, NULL);
+ }
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return text;
+}
+
+#ifdef MP_TRACE
+
+/* XXX: internal debug function, a candidate for modperl_debug.c */
+/* any non-false value for MOD_PERL_TRACE/PerlTrace enables this function */
+void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name)
+{
+ int i;
+ const apr_array_header_t *array;
+ apr_table_entry_t *elts;
+
+ array = apr_table_elts(table);
+ elts = (apr_table_entry_t *)array->elts;
+ modperl_trace(MP_FUNC, "Contents of table %s", name);
+ for (i = 0; i < array->nelts; i++) {
+ if (!elts[i].key || !elts[i].val) {
+ continue;
+ }
+ modperl_trace(MP_FUNC, "%s => %s", elts[i].key, elts[i].val);
+ }
+}
+
+/* XXX: internal debug function, a candidate for modperl_debug.c */
+void modperl_perl_modglobal_dump(pTHX)
+{
+ HV *hv = PL_modglobal;
+ AV *val;
+ char *key;
+ I32 klen;
+ hv_iterinit(hv);
+
+ MP_TRACE_g(MP_FUNC, "|-------- PL_modglobal --------");
+ MP_TRACE_g(MP_FUNC, "| perl 0x%lx PL_modglobal 0x%lx",
+ (unsigned long)aTHX, (unsigned long)PL_modglobal);
+
+ while ((val = (AV*)hv_iternextsv(hv, &key, &klen))) {
+ MP_TRACE_g(MP_FUNC, "| %s => 0x%lx", key, val);
+ }
+
+ MP_TRACE_g(MP_FUNC, "|-------- PL_modglobal --------\n");
+
+}
+
+
+#endif
1.53 +16 -3 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.52
retrieving revision 1.53
diff -u -u -r1.52 -r1.53
--- modperl_util.h 4 Mar 2004 06:01:07 -0000 1.52
+++ modperl_util.h 2 Apr 2004 02:17:45 -0000 1.53
@@ -169,12 +169,25 @@
void modperl_clear_symtab(pTHX_ HV *symtab);
+char *modperl_file2package(apr_pool_t *p, const char *file);
+
+SV *modperl_server_root_relative(pTHX_ SV *sv, const char *fname);
+
+/**
+ * convert a compiled *CV ref to its original source code
+ * @param p pool object (with a shortest possible life scope)
+ * @param cv compiled *CV
+ * @return string of original source code
+ */
+char *modperl_coderef2text(pTHX_ apr_pool_t *p, CV *cv);
+
#ifdef MP_TRACE
+
void modperl_apr_table_dump(pTHX_ apr_table_t *table, char *name);
-#endif
-char *modperl_file2package(apr_pool_t *p, const char *file);
+/* dump the contents of PL_modglobal */
+void modperl_perl_modglobal_dump(pTHX);
-SV *modperl_server_root_relative(pTHX_ SV *sv, const char *fname);
+#endif
#endif /* MODPERL_UTIL_H */
1.3 +14 -4 modperl-2.0/t/response/TestModperl/endav.pm
Index: endav.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestModperl/endav.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -u -r1.2 -r1.3
--- endav.pm 11 Apr 2002 11:08:44 -0000 1.2
+++ endav.pm 2 Apr 2004 02:17:46 -0000 1.3
@@ -17,27 +17,37 @@
#just to make sure we dont segv with bogus values
my $not = 'NoSuchPackage';
for my $name ('END', $not) {
- ModPerl::Global::special_list_call($name => $not);
+ ModPerl::Global::special_list_call( $name => $not);
ModPerl::Global::special_list_clear($name => $not);
}
+ # register the current package to set its END blocks aside
+ ModPerl::Global::special_list_register(END => __PACKAGE__);
+ # clear anything that was previously set
+ ModPerl::Global::special_list_clear(END => __PACKAGE__);
eval 'END { ok 1 }';
+ # now run them twice:ok 1 (1), ok 1 (2)
ModPerl::Global::special_list_call(END => __PACKAGE__);
ModPerl::Global::special_list_call(END => __PACKAGE__);
ModPerl::Global::special_list_clear(END => __PACKAGE__);
#should do nothing
- ModPerl::Global::special_list_call(END => __PACKAGE__);
+ ModPerl::Global::special_list_call( END => __PACKAGE__);
+ # this we've already registered this package's END blocks, adding
+ # new ones will set them aside
eval 'END { ok 1 }';
- ModPerl::Global::special_list_call(END => __PACKAGE__);
+
+ # so this will run ok 1 (3)
+ ModPerl::Global::special_list_call( END => __PACKAGE__);
ModPerl::Global::special_list_clear(END => __PACKAGE__);
ModPerl::Global::special_list_clear(END => __PACKAGE__);
#should do nothing
- ModPerl::Global::special_list_call(END => __PACKAGE__);
+ ModPerl::Global::special_list_call( END => __PACKAGE__);
+ # one plain ok 1 (4)
ok 1;
Apache::OK;
1.5 +9 -0 modperl-2.0/xs/ModPerl/Global/ModPerl__Global.h
Index: ModPerl__Global.h
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/ModPerl/Global/ModPerl__Global.h,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- ModPerl__Global.h 4 Mar 2004 06:01:13 -0000 1.4
+++ ModPerl__Global.h 2 Apr 2004 02:17:46 -0000 1.5
@@ -50,3 +50,12 @@
return mpxs_special_list_do(aTHX_ name, package,
modperl_perl_global_avcv_clear);
}
+
+static
+MP_INLINE int mpxs_ModPerl__Global_special_list_register(pTHX_
+ const char *name,
+ SV *package)
+{
+ return mpxs_special_list_do(aTHX_ name, package,
+ modperl_perl_global_avcv_register);
+}
1.71 +1 -0 modperl-2.0/xs/maps/modperl_functions.map
Index: modperl_functions.map
===================================================================
RCS file: /home/cvs/modperl-2.0/xs/maps/modperl_functions.map,v
retrieving revision 1.70
retrieving revision 1.71
diff -u -u -r1.70 -r1.71
--- modperl_functions.map 5 Mar 2004 18:19:15 -0000 1.70
+++ modperl_functions.map 2 Apr 2004 02:17:46 -0000 1.71
@@ -10,6 +10,7 @@
MODULE=ModPerl::Global
mpxs_ModPerl__Global_special_list_call
mpxs_ModPerl__Global_special_list_clear
+ mpxs_ModPerl__Global_special_list_register
MODULE=Apache::RequestRec PACKAGE=Apache::RequestRec
mpxs_Apache__RequestRec_content_type | | r, type=Nullsv
1.149 +61 -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.148
retrieving revision 1.149
diff -u -u -r1.148 -r1.149
--- FunctionTable.pm 3 Mar 2004 06:29:33 -0000 1.148
+++ FunctionTable.pm 2 Apr 2004 02:17:46 -0000 1.149
@@ -3839,6 +3839,28 @@
},
{
'return_type' => 'void',
+ 'name' => 'modperl_perl_global_avcv_register',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'modperl_modglobal_key_t *',
+ 'name' => 'gkey'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'package'
+ },
+ {
+ 'type' => 'I32',
+ 'name' => 'packlen'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'void',
'name' => 'modperl_perl_global_request_restore',
'args' => [
{
@@ -6191,6 +6213,27 @@
]
},
{
+ 'return_type' => 'int',
+ 'name' => 'mpxs_ModPerl__Global_special_list_register',
+ 'attr' => [
+ '__inline__'
+ ],
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'const char *',
+ 'name' => 'name'
+ },
+ {
+ 'type' => 'SV *',
+ 'name' => 'package'
+ }
+ ]
+ },
+ {
'return_type' => 'void',
'name' => 'mpxs_ModPerl__Util_untaint',
'attr' => [
@@ -6414,6 +6457,24 @@
{
'type' => 'const char *',
'name' => 'fname'
+ }
+ ]
+ },
+ {
+ 'return_type' => 'char *',
+ 'name' => 'modperl_coderef2text',
+ 'args' => [
+ {
+ 'type' => 'PerlInterpreter *',
+ 'name' => 'my_perl'
+ },
+ {
+ 'type' => 'apr_pool_t *',
+ 'name' => 'p'
+ },
+ {
+ 'type' => 'CV *',
+ 'name' => 'cv'
}
]
},
1.355 +11 -0 modperl-2.0/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl-2.0/Changes,v
retrieving revision 1.354
retrieving revision 1.355
diff -u -u -r1.354 -r1.355
--- Changes 26 Mar 2004 22:17:07 -0000 1.354
+++ Changes 2 Apr 2004 02:17:46 -0000 1.355
@@ -12,6 +12,17 @@
=item 1.99_14-dev
+'SetHandler perl-script' no longer grabs any newly encountered END
+blocks, and removes them from PL_endav, but only if they are
+explicitly registered via ModPerl::Global::special_list_register(END
+=> $package_name) (this is a new function). It's now possible to have
+a complete control of when END blocks are run from the user space, not
+only in the registry handlers [Stas]
+
+END blocks encountered by child processes and not hijacked by
+ModPerl::Global::special_list_register() are now executed at the
+server shutdown (previously they weren't executed at all). [Stas]
+
Added test to ensure <Perl> sections can have things like %Location
tied [Gozer]
1.20 +0 -13 modperl-2.0/todo/release
Index: release
===================================================================
RCS file: /home/cvs/modperl-2.0/todo/release,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -u -r1.19 -r1.20
--- release 4 Mar 2004 01:09:50 -0000 1.19
+++ release 2 Apr 2004 02:17:46 -0000 1.20
@@ -52,19 +52,6 @@
Apache->server->process->pconf->cleanup_register(sub { ... });
Report: geoff
-* child processes never run END blocks. a good example is
- Apache::TestUtil, which doesn't cleanup files and dirs it has
- created, because the END block is not run.
- also: see the next item
- owner: stas
-
-* ModPerl::Registry END {} block woes , described in details at the
- forwarded message from Jim Schueler
- http://marc.theaimsgroup.com/?l=apache-modperl&m=103720834717981&w=2
- the whole thread is here:
- http://marc.theaimsgroup.com/?t=103713532800003&r=1&w=2
- owner: stas
-
- PerlModule, PerlRequire, <Perl> in .htaccess is missing
http://marc.theaimsgroup.com/?t=105370088700001&r=1&w=2
Owner: geoff
Re: remaing END blocks issues (was Re: cvs commit: modperl-2.0/todo
release)
Posted by Stas Bekman <st...@stason.org>.
Philippe M. Chiasson wrote:
>>The gist of this big patch is simple.
>>
>>1) Now only registered packages will snap END blocks from PL_endav under
>>perl-script (and a user has a complete control if they want any extra packages
>>to be registered and their END blocks to be run).
>>
>>2) the END blocks are now run by the child processes (they weren't before,
>>since they were never moved out of PL_modglobal into PL_endav).
>
>
> Awesome!
:)
>>A few remaining END blocks issues:
>>
>>1) we probably should *not* run END blocks inherited from the parent process,
>>otherwise we have BEGIN blocks run once in the parent, and END blocks run N
>>times (once in the parent and once in each child process). So we should
>>probably reset PL_endav in child_init.
>
>
> Yes, this makes sense and it's the assumption I would make as a user.
Actually, I'm not sure it's a good idea after all. Normally fork() inherits
END blocks in perl:
% perl -le 'END { warn "$$: This is the end"}; fork'
8912: This is the end at -e line 1.
8911: This is the end at -e line 1.
So if we want to keep things indentical to perl we should keep it?
Looking at mp1, it doesn't run END blocks in the child processes. I guess
noone needed that feature.
Actually I found that problem when Apache-Test wasn't cleaning files/dirs it
created at run time and supposed to cleanup via an END block.
So now I'm a bit puzzled what's the best course to take.
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org
Re: remaing END blocks issues (was Re: cvs commit:
modperl-2.0/todo release)
Posted by "Philippe M. Chiasson" <go...@cpan.org>.
On Thu, 2004-04-01 at 18:31, Stas Bekman wrote:
> stas@apache.org wrote:
> > stas 2004/04/01 18:17:46
> >
> > Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
> > ModPerl-Registry/t perlrun_extload.t special_blocks.t
> > ModPerl-Registry/t/cgi-bin perlrun_decl.pm
> > perlrun_extload.pl perlrun_nondecl.pl
> > special_blocks.pl
> > ModPerl-Registry/t/conf modperl_extra_startup.pl
> > src/modules/perl mod_perl.c modperl_handler.c modperl_perl.c
> > modperl_perl.h modperl_perl_global.c
> > modperl_perl_global.h modperl_util.c modperl_util.h
> > t/response/TestModperl endav.pm
> > xs/ModPerl/Global ModPerl__Global.h
> > xs/maps modperl_functions.map
> > xs/tables/current/ModPerl FunctionTable.pm
> > . Changes
> > todo release
> [...]
> > -* child processes never run END blocks. a good example is
> > - Apache::TestUtil, which doesn't cleanup files and dirs it has
> > - created, because the END block is not run.
> > - also: see the next item
> > - owner: stas
> > -
> > -* ModPerl::Registry END {} block woes , described in details at the
> > - forwarded message from Jim Schueler
> > - http://marc.theaimsgroup.com/?l=apache-modperl&m=103720834717981&w=2
> > - the whole thread is here:
> > - http://marc.theaimsgroup.com/?t=103713532800003&r=1&w=2
> > - owner: stas
>
> The gist of this big patch is simple.
>
> 1) Now only registered packages will snap END blocks from PL_endav under
> perl-script (and a user has a complete control if they want any extra packages
> to be registered and their END blocks to be run).
>
> 2) the END blocks are now run by the child processes (they weren't before,
> since they were never moved out of PL_modglobal into PL_endav).
Awesome!
> A few remaining END blocks issues:
>
> 1) we probably should *not* run END blocks inherited from the parent process,
> otherwise we have BEGIN blocks run once in the parent, and END blocks run N
> times (once in the parent and once in each child process). So we should
> probably reset PL_endav in child_init.
Yes, this makes sense and it's the assumption I would make as a user.
> 2) there are several issues with threaded mpms at the server shutdown:
> Attempt to free unreferenced scalar: SV 0xc4b8fd8 during global destruction.
> Attempt to free temp prematurely: SV 0xc46a2ac during global destruction.
> Scalars leaked: 1
> I'll be looking at it.
>
> 3) I have a concern regarding 'httpd -k stop', sending SIGTERM. It's known
> that we have a problem with httpd, which is not considered of any pool
> cleanups that are still running and will just abort them if they are too slow.
> So by enabling this run of END blocks in child_exit we raise the chance that
> pool cleanups will be aborted. Making cleanups very unreliable. Last I
> mentioned this on apr-dev, I was sent to httpd-dev. I guess we need to pursue
> this issue with httpd-dev.
>
> 4) END blocks running too many times:
> http://marc.theaimsgroup.com/?t=106387825600002&r=1&w=2
> I haven't had a change to work on this one yet.
>
> __________________________________________________________________
> Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
> http://stason.org/ mod_perl Guide ---> http://perl.apache.org
> mailto:stas@stason.org http://use.perl.org http://apacheweek.com
> http://modperlbook.org http://apache.org http://ticketmaster.com
>
> ---------------------------------------------------------------------
> To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
> For additional commands, e-mail: dev-help@perl.apache.org
--
Philippe M. Chiasson m/gozer\@(apache|cpan|ectoplasm)\.org/ GPG KeyID : 88C3A5A5
http://gozer.ectoplasm.org/ FPR:F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3A5A5
remaing END blocks issues (was Re: cvs commit: modperl-2.0/todo release)
Posted by Stas Bekman <st...@stason.org>.
stas@apache.org wrote:
> stas 2004/04/01 18:17:46
>
> Modified: ModPerl-Registry/lib/ModPerl RegistryCooker.pm
> ModPerl-Registry/t perlrun_extload.t special_blocks.t
> ModPerl-Registry/t/cgi-bin perlrun_decl.pm
> perlrun_extload.pl perlrun_nondecl.pl
> special_blocks.pl
> ModPerl-Registry/t/conf modperl_extra_startup.pl
> src/modules/perl mod_perl.c modperl_handler.c modperl_perl.c
> modperl_perl.h modperl_perl_global.c
> modperl_perl_global.h modperl_util.c modperl_util.h
> t/response/TestModperl endav.pm
> xs/ModPerl/Global ModPerl__Global.h
> xs/maps modperl_functions.map
> xs/tables/current/ModPerl FunctionTable.pm
> . Changes
> todo release
[...]
> -* child processes never run END blocks. a good example is
> - Apache::TestUtil, which doesn't cleanup files and dirs it has
> - created, because the END block is not run.
> - also: see the next item
> - owner: stas
> -
> -* ModPerl::Registry END {} block woes , described in details at the
> - forwarded message from Jim Schueler
> - http://marc.theaimsgroup.com/?l=apache-modperl&m=103720834717981&w=2
> - the whole thread is here:
> - http://marc.theaimsgroup.com/?t=103713532800003&r=1&w=2
> - owner: stas
The gist of this big patch is simple.
1) Now only registered packages will snap END blocks from PL_endav under
perl-script (and a user has a complete control if they want any extra packages
to be registered and their END blocks to be run).
2) the END blocks are now run by the child processes (they weren't before,
since they were never moved out of PL_modglobal into PL_endav).
A few remaining END blocks issues:
1) we probably should *not* run END blocks inherited from the parent process,
otherwise we have BEGIN blocks run once in the parent, and END blocks run N
times (once in the parent and once in each child process). So we should
probably reset PL_endav in child_init.
2) there are several issues with threaded mpms at the server shutdown:
Attempt to free unreferenced scalar: SV 0xc4b8fd8 during global destruction.
Attempt to free temp prematurely: SV 0xc46a2ac during global destruction.
Scalars leaked: 1
I'll be looking at it.
3) I have a concern regarding 'httpd -k stop', sending SIGTERM. It's known
that we have a problem with httpd, which is not considered of any pool
cleanups that are still running and will just abort them if they are too slow.
So by enabling this run of END blocks in child_exit we raise the chance that
pool cleanups will be aborted. Making cleanups very unreliable. Last I
mentioned this on apr-dev, I was sent to httpd-dev. I guess we need to pursue
this issue with httpd-dev.
4) END blocks running too many times:
http://marc.theaimsgroup.com/?t=106387825600002&r=1&w=2
I haven't had a change to work on this one yet.
__________________________________________________________________
Stas Bekman JAm_pH ------> Just Another mod_perl Hacker
http://stason.org/ mod_perl Guide ---> http://perl.apache.org
mailto:stas@stason.org http://use.perl.org http://apacheweek.com
http://modperlbook.org http://apache.org http://ticketmaster.com
---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@perl.apache.org
For additional commands, e-mail: dev-help@perl.apache.org