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 PerlLoadModule TestDirective::perlloadmodule MyTest one two ServerTest per-server MyOtherTest value