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 2003/05/30 04:09:57 UTC
cvs commit: modperl-2.0/t/hooks/TestHooks cleanup2.pm
stas 2003/05/29 19:09:57
Added: t/hooks cleanup2.t
t/hooks/TestHooks cleanup2.pm
Log:
another cleanup test, which performs a creation and cleanup of a temp file
Revision Changes Path
1.1 modperl-2.0/t/hooks/cleanup2.t
Index: cleanup2.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
use File::Spec::Functions qw(catfile catdir);
my $vars = Apache::Test::config->{vars};
my $dir = catdir $vars->{documentroot}, "hooks";
my $file = catfile $dir, "cleanup2";
plan tests => 2;
{
# cleanup, just to make sure we start with virgin state
if (-e $file) {
unlink $file or die "Couldn't remove $file";
}
# this registers and performs cleanups, but we test whether the
# cleanup was run only in the next sub-test
my $location = "/TestHooks__cleanup2";
my $expected = 'cleanup2 is ok';
my $received = GET_BODY $location;
ok t_cmp($expected, $received, "register req cleanup");
}
{
# this sub-tests checks that the cleanup stage was run successfully
# which is supposed to remove the file that was created
#
# since Apache destroys the request rec after the logging has been
# finished, we have to give it some time to get there
# and remove in the file. (wait 0.25 .. 5 sec)
my $t = 0;
select undef, undef, undef, 0.25
while -e $file && -s _ == 10 || $t++ == 20;
if (-e $file) {
t_debug("$file wasn't removed by the cleanup phase");
ok 0;
unlink $file; # cleanup
}
else {
ok 1;
}
}
1.1 modperl-2.0/t/hooks/TestHooks/cleanup2.pm
Index: cleanup2.pm
===================================================================
package TestHooks::cleanup2;
# test the cleanup handler removing a temp file
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestTrace;
use File::Spec::Functions qw(catdir);
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::RequestUtil ();
use Apache::Const -compile => qw(OK DECLINED);
use APR::Const -compile => 'SUCCESS';
my $file = catdir Apache::Test::config->{vars}->{documentroot},
"hooks", "cleanup2";
sub handler {
my $r = shift;
$r->content_type('text/plain');
t_write_file($file, "cleanup2 is ok");
my $status = $r->sendfile($file);
die "sendfile has failed" unless $status == APR::SUCCESS;
$r->push_handlers(PerlCleanupHandler => \&cleanup);
return Apache::OK;
}
sub cleanup {
my $r = shift;
debug_sub "called";
die "Can't find file: $file" unless -e $file;
unlink $file or die "failed to unlink $file";
return Apache::OK;
}
1;
__DATA__
<NoAutoConfig>
<Location /TestHooks__cleanup2>
SetHandler modperl
PerlResponseHandler TestHooks::cleanup2
</Location>
</NoAutoConfig>