1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152
|
# please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
package TestDirective::perlloadmodule;
use strict;
use warnings FATAL => 'all';
use Apache::Test;
use Apache::TestUtil;
use Apache::TestTrace;
use Apache2::Const -compile => qw(OK OR_ALL RSRC_CONF TAKE1 TAKE23);
use Apache2::CmdParms ();
use Apache2::Module ();
my @directives = (
{
name => 'MyTest',
func => __PACKAGE__ . '::MyTest',
req_override => Apache2::Const::RSRC_CONF,
# req_override => 'RSRC_CONF', #test 1.x compat for strings
# args_how => Apache2::Const::TAKE23,
args_how => 'TAKE23', #test 1.x compat for strings
errmsg => 'A test',
},
{
name => 'MyOtherTest',
cmd_data => 'some info',
},
{
name => 'ServerTest',
req_override => Apache2::Const::RSRC_CONF,
}
);
Apache2::Module::add(__PACKAGE__, \@directives);
sub DIR_CREATE {
my ($class, $parms) = @_;
bless {
path => $parms->path || "/",
}, $class;
}
sub merge {
my ($base, $add) = @_;
my %new = ();
@new{keys %$base, keys %$add} =
(values %$base, values %$add);
return bless \%new, ref($base);
}
sub DIR_MERGE {
my $class = ref $_[0];
debug "$class->DIR_MERGE\n";
merge(@_);
}
#sub SERVER_MERGE {
# my $class = ref $_[0];
# debug "$class->SERVER_MERGE\n";
# merge(@_);
#}
sub SERVER_CREATE {
my ($class, $parms) = @_;
debug "$class->SERVER_CREATE\n";
return bless {
name => __PACKAGE__,
}, $class;
}
sub MyTest {
my ($self, $parms, @args) = @_;
$self->{MyTest} = \@args;
$self->{MyTestInfo} = $parms->info;
}
sub MyOtherTest {
my ($self, $parms, $arg) = @_;
$self->{MyOtherTest} = $arg;
$self->{MyOtherTestInfo} = $parms->info;
}
sub ServerTest {
my ($self, $parms, $arg) = @_;
my $srv_cfg = $self->get_config($parms->server);
$srv_cfg->{ServerTest} = $arg;
}
sub get_config {
my ($self, $s) = (shift, shift);
Apache2::Module::get_config($self, $s, @_);
}
sub handler : method {
my ($self, $r) = @_;
my $s = $r->server;
my $dir_cfg = $self->get_config($s, $r->per_dir_config);
my $srv_cfg = $self->get_config($s);
plan $r, tests => 9;
t_debug("per-dir config:", $dir_cfg);
t_debug("per-srv config:", $srv_cfg);
ok $dir_cfg->isa($self);
ok $srv_cfg->isa($self);
my $path = $dir_cfg->{path};
ok t_cmp($r->uri, qr{^$path},
'r->uri =~ parms->path');
ok t_cmp($srv_cfg->{name}, $self,
'$self eq $srv_cfg->{name}');
ok t_cmp($dir_cfg->{MyOtherTest}, 'value',
'MyOtherTest value');
ok t_cmp($dir_cfg->{MyOtherTestInfo}, 'some info',
'MyOtherTest cmd_data');
ok t_cmp($dir_cfg->{MyTest}, ['one', 'two'],
'MyTest one two');
ok ! $dir_cfg->{MyTestInfo};
ok t_cmp($srv_cfg->{ServerTest}, 'per-server');
Apache2::Const::OK;
}
1;
__END__
# APACHE_TEST_CONFIG_ORDER 950
<Base>
PerlLoadModule TestDirective::perlloadmodule
MyTest one two
ServerTest per-server
</Base>
MyOtherTest value
|