stas 2002/12/12 02:13:56
Added: t/directive perlloadmodule3.t perlloadmodule4.t
perlloadmodule5.t perlloadmodule6.t
t/response/TestDirective perlloadmodule3.pm
perlloadmodule4.pm perlloadmodule5.pm
perlloadmodule6.pm
Log:
add various tests that exercise PerlLoadModule and vhosts
Revision Changes Path
1.1 modperl-2.0/t/directive/perlloadmodule3.t
Index: perlloadmodule3.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestRequest;
my $module = "TestDirective::perlloadmodule3";
my $config = Apache::Test::config();
my $base_hostport = Apache::TestRequest::hostport($config);
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
# XXX: probably a good idea to split into more tests, that test
# smaller portions of information, but requires a more elaborated
# logic.
plan tests => 3;
t_debug("connecting to $base_hostport");
{
my $expected = <<EOI;
Processing by main server.
Section 1: Main Server
MyAppend : MainServer
MyList : ["MainServer"]
MyOverride : MainServer
MyPlus : 5
Section 2: Location
MyAppend : MainServer
MyList : ["MainServer"]
MyOverride : MainServer
MyPlus : 5
EOI
my $location = "http://$base_hostport/$module";;
my $received = GET_BODY $location;
ok t_cmp($expected, $received, "server merge");
}
t_debug("connecting to $hostport");
{
my $expected = <<EOI;
Processing by virtual host.
Section 1: Main Server
MyAppend : MainServer
MyList : ["MainServer"]
MyOverride : MainServer
MyPlus : 5
Section 2: Virtual Host
MyAppend : MainServer VHost
MyList : ["MainServer", "VHost"]
MyOverride : VHost
MyPlus : 7
Section 3: Location
MyAppend : MainServer VHost Dir
MyList : ["MainServer", "VHost", "Dir"]
MyOverride : Dir
MyPlus : 10
EOI
my $location = "http://$hostport/$module";;
my $received = GET_BODY $location;
ok t_cmp($expected, $received, "server/dir merge");
}
{
my $expected = <<EOI;
Processing by virtual host.
Section 1: Main Server
MyAppend : MainServer
MyList : ["MainServer"]
MyOverride : MainServer
MyPlus : 5
Section 2: Virtual Host
MyAppend : MainServer VHost
MyList : ["MainServer", "VHost"]
MyOverride : VHost
MyPlus : 7
Section 3: Location
MyAppend : MainServer VHost Dir SubDir
MyList : ["MainServer", "VHost", "Dir", "SubDir"]
MyOverride : SubDir
MyPlus : 11
EOI
my $location = "http://$hostport/$module/subdir";;
my $received = GET_BODY $location;
ok t_cmp($expected, $received, "server/dir/subdir merge");
}
1.1 modperl-2.0/t/directive/perlloadmodule4.t
Index: perlloadmodule4.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest;
my $module = "TestDirective::perlloadmodule4";
my $config = Apache::Test::config();
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
print GET_BODY "http://$hostport/$module";;
1.1 modperl-2.0/t/directive/perlloadmodule5.t
Index: perlloadmodule5.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest;
my $module = "TestDirective::perlloadmodule5";
my $config = Apache::Test::config();
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
print GET_BODY "http://$hostport/$module";;
1.1 modperl-2.0/t/directive/perlloadmodule6.t
Index: perlloadmodule6.t
===================================================================
use strict;
use warnings FATAL => 'all';
use Apache::TestRequest;
my $module = "TestDirective::perlloadmodule6";
my $config = Apache::Test::config();
Apache::TestRequest::module($module);
my $hostport = Apache::TestRequest::hostport($config);
print GET_BODY "http://$hostport/$module";;
1.1 modperl-2.0/t/response/TestDirective/perlloadmodule3.pm
Index: perlloadmodule3.pm
===================================================================
package TestDirective::perlloadmodule3;
# in this test we test various merging techniques. As a side effect it
# tests how mod_perl works when its forced to start early outside
# vhosts and how it works with vhosts. See perlloadmodule4.pm and
# perlloadmodule5.pm, for similar tests that starts mod_perl early
# from a vhost.
use strict;
use warnings FATAL => 'all';
use Apache::CmdParms ();
use Apache::Module ();
use Apache::ServerUtil ();
use Apache::Const -compile => qw(OK);
our @APACHE_MODULE_COMMANDS = (
{ name => 'MyPlus' },
{ name => 'MyList' },
{ name => 'MyAppend' },
{ name => 'MyOverride' },
);
sub MyPlus { set_val('MyPlus', @_) }
sub MyAppend { set_val('MyAppend', @_) }
sub MyOverride { set_val('MyOverride', @_) }
sub MyList { push_val('MyList', @_) }
sub DIR_MERGE { merge(@_) }
sub SERVER_MERGE { merge(@_) }
sub set_val {
my($key, $self, $parms, $arg) = @_;
$self->{$key} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache::Module->get_config($self, $parms->server);
$srv_cfg->{$key} = $arg;
}
}
sub push_val {
my($key, $self, $parms, $arg) = @_;
push @{ $self->{$key} }, $arg;
unless ($parms->path) {
my $srv_cfg = Apache::Module->get_config($self, $parms->server);
push @{ $srv_cfg->{$key} }, $arg;
}
}
sub merge {
my($base, $add) = @_;
my %mrg = ();
for my $key (keys %$base, %$add) {
next if exists $mrg{$key};
if ($key eq 'MyPlus') {
$mrg{$key} = ($base->{$key}||0) + ($add->{$key}||0);
}
elsif ($key eq 'MyList') {
push @{ $mrg{$key} },
@{ $base->{$key}||[] }, @{ $add->{$key}||[] };
}
elsif ($key eq 'MyAppend') {
$mrg{$key} = join " ", grep defined, $base->{$key}, $add->{$key};
}
else {
# override mode
$mrg{$key} = $base->{$key} if exists $base->{$key};
$mrg{$key} = $add->{$key} if exists $add->{$key};
}
}
return bless \%mrg, ref($base);
}
### response handler ###
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::Module ();
use Apache::Const -compile => qw(OK);
sub get_config {
Apache::Module->get_config(__PACKAGE__, @_);
}
sub handler {
my($r) = @_;
my %secs = ();
$r->content_type('text/plain');
my $s = $r->server;
my $dir_cfg = get_config($s, $r->per_dir_config);
my $srv_cfg = get_config($s);
if ($s->is_virtual) {
$secs{"1: Main Server"} = get_config(Apache->server);
$secs{"2: Virtual Host"} = $srv_cfg;
$secs{"3: Location"} = $dir_cfg;
}
else {
$secs{"1: Main Server"} = $srv_cfg;
$secs{"2: Location"} = $dir_cfg;
}
$r->printf("Processing by %s.\n",
$s->is_virtual ? "virtual host" : "main server");
for my $sec (sort keys %secs) {
$r->print("\nSection $sec\n");
for my $k (sort keys %{ $secs{$sec}||{} }) {
my $v = exists $secs{$sec}->{$k} ? $secs{$sec}->{$k} : 'UNSET';
$v = '[' . (join ", ", map {qq{"$_"}} @$v) . ']'
if ref($v) eq 'ARRAY';
$r->printf("%-10s : %s\n", $k, $v);
}
}
return Apache::OK;
}
1;
__END__
<Base>
PerlLoadModule TestDirective::perlloadmodule3
MyPlus 5
MyList "MainServer"
MyAppend "MainServer"
MyOverride "MainServer"
</Base>
<VirtualHost TestDirective::perlloadmodule3>
MyPlus 2
MyList "VHost"
MyAppend "VHost"
MyOverride "VHost"
<Location /TestDirective::perlloadmodule3>
MyPlus 3
MyList "Dir"
MyAppend "Dir"
MyOverride "Dir"
SetHandler modperl
PerlResponseHandler TestDirective::perlloadmodule3
</Location>
<Location /TestDirective::perlloadmodule3/subdir>
MyPlus 1
MyList "SubDir"
MyAppend "SubDir"
MyOverride "SubDir"
</Location>
</VirtualHost>
1.1 modperl-2.0/t/response/TestDirective/perlloadmodule4.pm
Index: perlloadmodule4.pm
===================================================================
package TestDirective::perlloadmodule4;
# XXX: the package is 99% the same as perlloadlmodule5 and 6, just the
# configuration is different. Consider removing the code dups.
#
# in this test we test an early mod_perl startup caused by an
# EXEC_ON_READ directive in the baseserver. In this test the
# non-native mod_perl directive sets scfg on behalf of mod_perl in
# that vhost.
#
# See also perlloadmodule5.pm, which is almost the same, but uses a
# mod_perl native directive before a non-native directive in vhost. In
# that test mod_perl sets scfg for that vhost by itself.
#
# see perlloadmodule6.pm for the case where mod_perl starts early, but
# from within the vhost.
use strict;
use warnings FATAL => 'all';
use Apache::CmdParms ();
use Apache::Module ();
use Apache::ServerUtil ();
use Apache::Const -compile => qw(OK);
use constant KEY => "MyTest4";
our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
sub MyTest4 {
my($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache::Module->get_config($self, $parms->server);
$srv_cfg->{+KEY} = $arg;
}
}
### response handler ###
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::Module ();
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => qw(OK);
sub get_config {
Apache::Module->get_config(__PACKAGE__, @_);
}
sub handler {
my($r) = @_;
my %secs = ();
$r->content_type('text/plain');
my $s = $r->server;
my $dir_cfg = get_config($s, $r->per_dir_config);
my $srv_cfg = get_config($s);
plan $r, tests => 3;
ok $s->is_virtual;
ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
return Apache::OK;
}
1;
__END__
<Base>
PerlLoadModule TestDirective::perlloadmodule4
</Base>
<VirtualHost TestDirective::perlloadmodule4>
# here perlloadmodule sets scfg on behalf of the base server
MyTest4 "Vhost"
<Location /TestDirective::perlloadmodule4>
MyTest4 "Dir"
SetHandler modperl
PerlResponseHandler TestDirective::perlloadmodule4
</Location>
</VirtualHost>
1.1 modperl-2.0/t/response/TestDirective/perlloadmodule5.pm
Index: perlloadmodule5.pm
===================================================================
package TestDirective::perlloadmodule5;
# in this test we test an early mod_perl startup caused by an
# EXEC_ON_READ directive in the baseserver. In this test we have a
# mod_perl native directive before a non-native directive inside vhost
# section. Here mod_perl sets scfg for that vhost by itself.
#
# See also perlloadmodule4.pm, which is almost the same, but has no
# mod_perl native directive before a non-native directive in vhost. In
# that test the non-native mod_perl directive sets scfg on behalf of
# mod_perl in that vhost.
#
# see perlloadmodule6.pm for the case where mod_perl starts early, but
# from within the vhost.
use strict;
use warnings FATAL => 'all';
use Apache::CmdParms ();
use Apache::Module ();
use Apache::ServerUtil ();
use Apache::Const -compile => qw(OK);
use constant KEY => "MyTest5";
our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
sub MyTest5 {
my($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache::Module->get_config($self, $parms->server);
$srv_cfg->{+KEY} = $arg;
}
}
### response handler ###
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::Module ();
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => qw(OK);
sub get_config {
Apache::Module->get_config(__PACKAGE__, @_);
}
sub handler {
my($r) = @_;
my %secs = ();
$r->content_type('text/plain');
my $s = $r->server;
my $dir_cfg = get_config($s, $r->per_dir_config);
my $srv_cfg = get_config($s);
plan $r, tests => 3;
ok $s->is_virtual;
ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
return Apache::OK;
}
1;
__END__
<Base>
PerlLoadModule TestDirective::perlloadmodule5
</Base>
<VirtualHost TestDirective::perlloadmodule5>
# here mod_perl sets the scfg by itself for this vhost
PerlModule CGI
MyTest5 "Vhost"
<Location /TestDirective::perlloadmodule5>
MyTest5 "Dir"
SetHandler modperl
PerlResponseHandler TestDirective::perlloadmodule5
</Location>
</VirtualHost>
1.1 modperl-2.0/t/response/TestDirective/perlloadmodule6.pm
Index: perlloadmodule6.pm
===================================================================
package TestDirective::perlloadmodule6;
# in this test we test an early mod_perl startup caused by an
# EXEC_ON_READ directive in vhost.
use strict;
use warnings FATAL => 'all';
use Apache::CmdParms ();
use Apache::Module ();
use Apache::ServerUtil ();
use Apache::Const -compile => qw(OK);
use constant KEY => "MyTest6";
our @APACHE_MODULE_COMMANDS = ({ name => +KEY },);
sub MyTest6 {
my($self, $parms, $arg) = @_;
$self->{+KEY} = $arg;
unless ($parms->path) {
my $srv_cfg = Apache::Module->get_config($self, $parms->server);
$srv_cfg->{+KEY} = $arg;
}
}
### response handler ###
use Apache::RequestRec ();
use Apache::RequestIO ();
use Apache::Server ();
use Apache::ServerUtil ();
use Apache::Module ();
use Apache::Test;
use Apache::TestUtil;
use Apache::Const -compile => qw(OK);
sub get_config {
Apache::Module->get_config(__PACKAGE__, @_);
}
sub handler {
my($r) = @_;
my %secs = ();
$r->content_type('text/plain');
my $s = $r->server;
my $dir_cfg = get_config($s, $r->per_dir_config);
my $srv_cfg = get_config($s);
plan $r, tests => 3;
ok $s->is_virtual;
ok t_cmp("Dir", $dir_cfg->{+KEY}, "Section");
ok t_cmp("Vhost", $srv_cfg->{+KEY}, "Section");
return Apache::OK;
}
1;
__END__
<VirtualHost TestDirective::perlloadmodule6>
PerlLoadModule TestDirective::perlloadmodule6
MyTest6 "Vhost"
<Location /TestDirective::perlloadmodule6>
MyTest6 "Dir"
SetHandler modperl
PerlResponseHandler TestDirective::perlloadmodule6
</Location>
</VirtualHost>
