dougm 01/10/16 20:20:02 Added: t/modperl interp.t t/response/TestModperl interp.pm Log: add a test that uses the same interpreter each time Revision Changes Path 1.1 modperl-2.0/t/modperl/interp.t Index: interp.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestRequest; use constant INTERP => 'X-PerlInterpreter'; plan tests => 3, \&have_lwp; my $url = "/TestModperl::interp"; #request an interpreter instance my $res = GET $url, INTERP, 'init'; #use this interpreter id to select the same interpreter in requests below my $interp = $res->header(INTERP); print "using interp: $interp\n"; print $res->content; my $found_interp = ""; my $find_interp = sub { $res->code == 200 and (($found_interp = $res->header(INTERP)) eq $interp); }; for (1..2) { my $times = 0; do { #loop until we get a response from our interpreter instance $res = GET $url, INTERP, $interp; #trace info unless ($find_interp->()) { print $found_interp ? "wrong interpreter: $found_interp\n" : "no interpreter\n"; } if ($times++ > 15) { #prevent endless loop die "unable to find interp $interp\n"; } } while (not $find_interp->()); print $res->content; #ok $value++ } 1.1 modperl-2.0/t/response/TestModperl/interp.pm Index: interp.pm =================================================================== package TestModperl::interp; use warnings FATAL => 'all'; use strict; use APR::UUID (); use Apache::Const -compile => qw(OK NOT_FOUND SERVER_ERROR); use constant INTERP => 'X-PerlInterpreter'; my $interp_id = ""; my $value = 0; sub fixup { my $r = shift; my $interp = $r->headers_in->get(INTERP); my $rc = Apache::OK; unless ($interp) { #shouldn't be requesting this without an INTERP header return Apache::SERVER_ERROR; } my $id = $interp_id; if ($interp eq 'init') { #first request for an interpreter instance #unique id for this instance $interp_id = $id = APR::UUID->new->format; $value = 0; #reset our global data } elsif ($interp ne $interp_id) { #this is not the request interpreter instance $rc = Apache::NOT_FOUND; } #so client can save the created instance id or check the existing value $r->headers_out->set(INTERP, $id); return $rc; } sub handler { my $r = shift; #test the actual global data $value++; $r->puts("ok $value\n"); Apache::OK; } 1; __END__ PerlFixupHandler TestModperl::interp::fixup