perl-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From "Philippe M. Chiasson" <go...@cpan.org>
Subject [mp1 Patch] per_request_cleanup() for subrequests
Date Mon, 26 May 2003 07:33:14 GMT
From STATUS:

per_request_cleanup() only cleans up the current request. As one
consequence, pnotes of child requests will not get cleaned up.

# $Id: destroy.patch,v 1.1 2003/05/26 07:25:32 gozer Exp $

Run per_request_cleanup() on the main request as well as for subrequests.

On bug caused by this was that for subrequests, the pnotes array would not
be cleaned up at all.

Index: src/modules/perl/mod_perl.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.c,v
retrieving revision 1.146
diff -u -I$Id -r1.146 mod_perl.c
--- src/modules/perl/mod_perl.c	14 Mar 2003 04:45:52 -0000	1.146
+++ src/modules/perl/mod_perl.c	26 May 2003 07:23:16 -0000
@@ -1139,8 +1139,11 @@
 
     MP_TRACE_g(fprintf(stderr, "perl_end_cleanup..."));
     perl_run_rgy_endav(r->uri);
-    per_request_cleanup(r);
-
+    
+    do {
+        per_request_cleanup(r);
+    } while (r = r->next);
+    
     /* clear %ENV */
     perl_clear_env();
 
Index: t/conf/httpd.conf-dist
===================================================================
RCS file: /home/cvs/modperl/t/conf/httpd.conf-dist,v
retrieving revision 1.32
diff -u -I$Id -r1.32 httpd.conf-dist
--- t/conf/httpd.conf-dist	26 Sep 2000 16:55:41 -0000	1.32
+++ t/conf/httpd.conf-dist	26 May 2003 07:23:16 -0000
@@ -27,6 +27,7 @@
 
 =cut
 
+DirectoryIndex index.pl
 <Directory />
 AllowOverride None
 </Directory>
Index: t/internal/destroy.t
===================================================================
RCS file: t/internal/destroy.t
diff -N t/internal/destroy.t
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ t/internal/destroy.t	26 May 2003 07:23:16 -0000
@@ -0,0 +1,10 @@
+use Apache::testold;
+
+my $i = 0;
+print "1..2\n";
+
+fetch "$PERL_DIR/index.pl?reset";
+test ++$i, 1 == fetch "$PERL_DIR/index.pl";
+
+fetch "$PERL_DIR/?reset";
+test ++$i, 1 == fetch "$PERL_DIR/";
Index: t/net/perl/index.pl
===================================================================
RCS file: t/net/perl/index.pl
diff -N t/net/perl/index.pl
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ t/net/perl/index.pl	26 May 2003 07:23:16 -0000
@@ -0,0 +1,17 @@
+#!perl
+use vars qw($Destroy);
+
+my $r = Apache->request;
+$r->content_type("text/plain");
+$r->send_http_header;
+
+if ($r->args eq 'reset') {
+    print STDERR "Reset request for ", $r->uri, "\n";
+    $Destroy = 0;
+}
+
+sub Destroy::DESTROY {$Destroy++}
+
+$r->pnotes('Destroy' , bless {}, 'Destroy');
+
+$r->print($Destroy);


-- 
-- -----------------------------------------------------------------------------
Philippe M. Chiasson /gozer\@(cpan|ectoplasm)\.org/ 88C3A5A5 (122FF51B/C634E37B)
http://gozer.ectoplasm.org/    F9BF E0C2 480E 7680 1AE5 3631 CB32 A107 88C3 A5A5
Q: It is impossible to make anything foolproof because fools are so ingenious.
perl -e'$$=\${gozer};{$_=unpack(P7,pack(L,$$));/^JAm_pH\n$/&&print||$$++&&redo}'

Mime
View raw message