stas 2003/12/22 16:31:03
Added: t/hooks startup.t
t/hooks/TestHooks startup.pm
Log:
not a day without a new test:
- test PerlPostConfigHandler and PerlOpenLogsHandler phases
- also test that we can run things on vhost entries from these phases
Revision Changes Path
1.1 modperl-2.0/t/hooks/startup.t
Index: startup.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
my $config = Apache::Test::config();
my $path = Apache::TestRequest::module2path('TestHooks::startup');
my @modules = qw(default TestHooks::startup);
plan tests => scalar @modules;
my $expected = join '', "open_logs ok\n", "post_config ok\n";
for my $module (sort @modules) {
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
t_debug("connecting to $hostport");
ok t_cmp($expected,
GET_BODY_ASSERT("http://$hostport/$path";),
"testing PostConfig");
}
1.1 modperl-2.0/t/hooks/TestHooks/startup.pm
Index: startup.pm
===================================================================
package TestHooks::startup;
# test PerlPostConfigHandler and PerlOpenLogsHandler phases
# also test that we can run things on vhost entries from these phases
use strict;
use warnings FATAL => 'all';
use Apache::TestUtil;
use Apache::Test;
use Apache::TestTrace;
use APR::Table;
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::RequestRec ();
use Apache::RequestIO ();
use File::Spec::Functions qw(catfile catdir);
use File::Path qw(mkpath);
use Apache::Const -compile => 'OK';
my $dir = catdir Apache::Test::config()->{vars}->{documentroot}, 'hooks',
'startup';
sub open_logs {
my($conf_pool, $log_pool, $temp_pool, $s) = @_;
# main server
run("open_logs", $s);
for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
my $port = $vhost_s->port;
my $val = $vhost_s->dir_config->{PostConfig};
# we have one vhost that we want to run open_logs for
next unless $val && $val eq 'VHost';
run("open_logs", $vhost_s);
}
Apache::OK;
}
sub post_config {
my($conf_pool, $log_pool, $temp_pool, $s) = @_;
# main server
run("post_config", $s);
for (my $vhost_s = $s->next; $vhost_s; $vhost_s = $vhost_s->next) {
my $port = $vhost_s->port;
my $val = $vhost_s->dir_config->{PostConfig};
# we have one vhost that we want to run post_config for
next unless $val && $val eq 'VHost';
run("post_config", $vhost_s);
}
Apache::OK;
}
sub run {
my($phase, $s) = @_;
my $val = $s->dir_config->{PostConfig} or die "Can't read PostConfig var";
my $port = $s->port;
my $file = catfile $dir, "$phase-$port";
mkpath $dir, 0, 0755;
open my $fh, ">$file" or die "can't open $file: $!";
print $fh $val;
close $fh;
debug "Phase $phase is completed for server at port $port";
}
sub handler {
my $r = shift;
$r->content_type('text/plain');
my $s = $r->server;
my $expected = $s->dir_config->{PostConfig}
or die "Can't read PostConfig var";
my $port = $s->port;
for my $phase (qw(open_logs post_config)) {
my $file = catfile $dir, "$phase-$port";
open my $fh, "$file" or die "can't open $file: $!";
my $received = <$fh> || '';
close $fh;
# cleanup
unlink $file;
if ($expected eq $received) {
$r->print("$phase ok\n");
} else {
warn "phase: $phase\n";
warn "port: $port\n";
warn "expected: $expected\n";
warn "received: $received\n";
}
}
Apache::OK;
}
1;
__DATA__
<NoAutoConfig>
<VirtualHost TestHooks::startup>
PerlSetVar PostConfig VHost
PerlModule TestHooks::startup
PerlPostConfigHandler TestHooks::startup::post_config
PerlOpenLogsHandler TestHooks::startup::open_logs
<Location /TestHooks__startup>
SetHandler modperl
PerlResponseHandler TestHooks::startup
</Location>
</VirtualHost>
PerlSetVar PostConfig Main
PerlModule TestHooks::startup
PerlPostConfigHandler TestHooks::startup::post_config
PerlOpenLogsHandler TestHooks::startup::open_logs
<Location /TestHooks__startup>
SetHandler modperl
PerlResponseHandler TestHooks::startup
</Location>
</NoAutoConfig>
