stas 2002/12/04 19:31:09 Modified: t/conf extra.last.conf.in Added: t/directive perlloadmodule2.t t/response/TestDirective perlloadmodule2.pm Log: a new test that tests the merging of custom directives, using inheritance from parents, plus new values Revision Changes Path 1.3 +12 -0 modperl-2.0/t/conf/extra.last.conf.in Index: extra.last.conf.in =================================================================== RCS file: /home/cvs/modperl-2.0/t/conf/extra.last.conf.in,v retrieving revision 1.2 retrieving revision 1.3 diff -u -r1.2 -r1.3 --- extra.last.conf.in 3 Dec 2002 15:38:22 -0000 1.2 +++ extra.last.conf.in 5 Dec 2002 03:31:09 -0000 1.3 @@ -11,6 +11,18 @@ </Location> ### --------------------------------- ### +PerlLoadModule TestDirective::perlloadmodule2 + +MyMergeTest one two +<Location /TestDirective::perlloadmodule2> + MyMergeTest three four +</Location> +<Location /TestDirective::perlloadmodule2/subdir> + MyMergeTest five + MyMergeTest six +</Location> + +### --------------------------------- ### <Perl > push @Alias, ['/perl_sections', '@DocumentRoot@'], $Location{'/perl_sections'} = { 1.1 modperl-2.0/t/directive/perlloadmodule2.t Index: perlloadmodule2.t =================================================================== use strict; use warnings FATAL => 'all'; use Apache::Test; use Apache::TestUtil; use Apache::TestRequest; my $url = "/TestDirective::perlloadmodule2"; plan tests => 3; { my $location = "$url?srv"; my $expected = "srv: one two"; my $received = GET_BODY $location; ok t_cmp($expected, $received, "access server settings"); } { my $location = "$url?"; my $expected = "dir: one two three four"; my $received = GET_BODY $location; ok t_cmp($expected, $received, "server/dir merge"); } { my $location = "$url/subdir"; my $expected = "dir: one two three four five six"; my $received = GET_BODY $location; ok t_cmp($expected, $received, "server/dir/subdir merge"); } 1.1 modperl-2.0/t/response/TestDirective/perlloadmodule2.pm Index: perlloadmodule2.pm =================================================================== package TestDirective::perlloadmodule2; # in this test the merge is inherits all the values from the ancestors # and adds new values if such were set use strict; use warnings FATAL => 'all'; use Apache::Const -compile => qw(OK OR_ALL ITERATE); use Apache::CmdParms (); use Apache::Module (); our @APACHE_MODULE_COMMANDS = ( { name => 'MyMergeTest', func => __PACKAGE__ . '::MyMergeTest', req_override => Apache::OR_ALL, args_how => Apache::ITERATE, errmsg => 'Values that get merged', }, ); sub merge { my($base, $add) = @_; #use Data::Dumper; #warn Dumper $base, $add; my %new = (); push @{ $new{$_} }, @{ $base->{$_} } for keys %$base; # XXX: why this approach doesn't work? # @new{keys %$base} = (values %$base); push @{ $new{$_} }, @{ $add->{$_}||[] } for keys %$add; #warn Dumper \%new; return bless \%new, ref($base); } sub DIR_MERGE { my $class = ref $_[0]; warn "$class->DIR_MERGE\n"; merge(@_); } sub SERVER_MERGE { my $class = ref $_[0]; warn "$class->SERVER_MERGE\n"; merge(@_); } # this variable is of type ITERATE, so it'll get called as many times # as arguments, a single argument at a time. This function is called # only during the server startup and when the directive appears in the # .htaccess files sub MyMergeTest { my($self, $parms, $arg) = @_; warn "MyMergeTest: @{[$parms->path||'']}\n\t$arg\n"; push @{ $self->{MyMergeTest} }, $arg; # store the top level srv values in the server struct as well, so # during the request you can query what was the top level (srv) # setting, before it was merged with the current container's # setting if any unless ($parms->path) { my $srv_cfg = $self->get_config($parms->server); push @{ $srv_cfg->{MyMergeTest} }, $arg; } } sub get_config { my($self, $s) = (shift, shift); Apache::Module->get_config($self, $s, @_); } sub handler : method { my($self, $r) = @_; $r->content_type('text/plain'); my $s = $r->server; if ($r->args eq 'srv') { my $srv_cfg = $self->get_config($s); $r->print("srv: @{ $srv_cfg->{MyMergeTest}||[] }"); } else { my $dir_cfg = $self->get_config($s, $r->per_dir_config); $r->print("dir: @{ $dir_cfg->{MyMergeTest}||[] }"); } return Apache::OK; } 1; __END__