On Wednesday 24 October 2007, Torsten Foertsch wrote: > This one ... Ups, forgot to add t/directive/perlcleanuphandler.t
Torsten
Index: src/modules/perl/mod_perl.c
===================================================================
--- src/modules/perl/mod_perl.c (revision 4)
+++ src/modules/perl/mod_perl.c (working copy)
@@ -746,6 +746,7 @@
#endif
modperl_config_req_init(r, rcfg);
+ modperl_config_req_cleanup_register(r, rcfg);
/* set the default for cgi header parsing On as early as possible
* so $r->content_type in any phase after header_parser could turn
Index: src/modules/perl/modperl_callback.c
===================================================================
--- src/modules/perl/modperl_callback.c (revision 4)
+++ src/modules/perl/modperl_callback.c (working copy)
@@ -201,14 +201,6 @@
}
#endif
- /* XXX: would like to do this in modperl_hook_create_request()
- * but modperl_interp_select() is what figures out if
- * PerlInterpScope eq handler, in which case we do not register
- * a cleanup. modperl_hook_create_request() is also currently always
- * run even if modperl isn't handling any part of the request
- */
- modperl_config_req_cleanup_register(r, rcfg);
-
switch (type) {
case MP_HANDLER_TYPE_PER_SRV:
modperl_handler_make_args(aTHX_ &av_args,
Index: t/response/TestDirective/perlcleanuphandler.pm
===================================================================
--- t/response/TestDirective/perlcleanuphandler.pm (revision 0)
+++ t/response/TestDirective/perlcleanuphandler.pm (revision 0)
@@ -0,0 +1,70 @@
+package TestDirective::perlcleanuphandler;
+
+use strict;
+use warnings FATAL => 'all';
+
+use Apache2::RequestRec ();
+use Apache2::RequestIO ();
+use Apache2::RequestUtil ();
+use Apache2::Connection ();
+use Apache2::ConnectionUtil ();
+use Apache2::Const -compile => 'OK', 'DECLINED';
+
+# This test is to show an error that occurs if in the whole request cycle
+# only a PerlCleanupHandler is defined. In this case it is not called.
+# To check that "/get?incr" is called first. This returns "UNDEF" to the
+# browser and sets the counter to "1". Next "/get" is called again without
+# args to check the counter without increment. Then we fetch
+# "/index.html?incr". Here no other Perl*Handler save the PerlCleanupHandler
+# is involved. So the next "/get" must return "2" but it shows "1".
+
+sub cleanup {
+ my $r=shift;
+ $r->connection->pnotes->{counter}++ if( $r->args eq 'incr' );
+ return Apache2::Const::OK;
+}
+
+sub get {
+ my $r=shift;
+ $r->content_type('text/plain');
+ $r->print($r->connection->pnotes->{counter} || "UNDEF");
+ return Apache2::Const::OK;
+}
+
+1;
+
+__END__
+<VirtualHost TestDirective::perlcleanuphandler>
+
+ <IfDefine PERL_USEITHREADS>
+ # a new interpreter pool
+ PerlOptions +Parent
+ PerlInterpStart 1
+ PerlInterpMax 1
+ PerlInterpMinSpare 0
+ PerlInterpMaxSpare 1
+ PerlInterpScope connection
+ </IfDefine>
+
+ KeepAlive On
+ KeepAliveTimeout 300
+ MaxKeepAliveRequests 100
+
+ # use test system's @INC
+ PerlSwitches [EMAIL PROTECTED]@
+ PerlRequire "conf/modperl_inc.pl"
+ PerlModule TestDirective::perlcleanuphandler
+
+ <Location /get>
+ SetHandler modperl
+ PerlResponseHandler TestDirective::perlcleanuphandler::get
+ </Location>
+
+ PerlCleanupHandler TestDirective::perlcleanuphandler::cleanup
+
+</VirtualHost>
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
Index: t/directive/perlcleanuphandler.t
===================================================================
--- t/directive/perlcleanuphandler.t (revision 0)
+++ t/directive/perlcleanuphandler.t (revision 0)
@@ -0,0 +1,24 @@
+use strict;
+use warnings FATAL => 'all';
+
+use Apache::Test;
+use Apache::TestUtil;
+use Apache::TestRequest 'GET_BODY';
+
+plan tests => 3;
+
+my $module = 'TestDirective::perlcleanuphandler';
+
+Apache::TestRequest::user_agent(reset => 1, keep_alive=>1);
+sub u {Apache::TestRequest::module2url($module, {path=>$_[0]})}
+
+t_debug("connecting to ".u(''));
+ok t_cmp GET_BODY(u('/get?incr')), 'UNDEF', 'before increment';
+ok t_cmp GET_BODY(u('/get')), '1', 'incremented';
+(undef)=GET_BODY(u('/index.html?incr'));
+ok t_cmp GET_BODY(u('/get')), '2', 'incremented again';
+
+# Local Variables: #
+# mode: cperl #
+# cperl-indent-level: 4 #
+# End: #
signature.asc
Description: This is a digitally signed message part.
