geoff 2003/10/07 12:09:05
Modified: lib/ModPerl Code.pm t/response/TestApache conftree.pm xs/tables/current/ModPerl FunctionTable.pm Added: t/hooks default_port.t t/hooks/TestHooks default_port.pm Log: add PerlDefaultPortHandler Revision Changes Path 1.108 +2 -2 modperl-2.0/lib/ModPerl/Code.pm Index: Code.pm =================================================================== RCS file: /home/cvs/modperl-2.0/lib/ModPerl/Code.pm,v retrieving revision 1.107 retrieving revision 1.108 diff -u -r1.107 -r1.108 --- Code.pm 1 Oct 2003 19:53:05 -0000 1.107 +++ Code.pm 7 Oct 2003 19:09:05 -0000 1.108 @@ -18,7 +18,7 @@ my %handlers = ( Process => [qw(ChildInit ChildExit)], #Restart PreConfig Files => [qw(OpenLogs PostConfig)], - PerSrv => [qw(PostReadRequest Trans)], + PerSrv => [qw(PostReadRequest Trans DefaultPort)], PerDir => [qw(HeaderParser Access Authen Authz Type Fixup Response Log Cleanup @@ -217,7 +217,7 @@ my $ix = $self->{handler_index}->{$class}->[$i]; if ($callback =~ m/modperl_callback_per_(dir|srv)/) { - if ($ix =~ m/AUTH|TYPE|TRANS/) { + if ($ix =~ m/AUTH|TYPE|TRANS|PORT/) { $pass =~ s/MP_HOOK_RUN_ALL/MP_HOOK_RUN_FIRST/; } } 1.1 modperl-2.0/t/hooks/default_port.t Index: default_port.t =================================================================== use strict; use warnings FATAL => 'all'; # force use of Apache:TestClient, which doesn't # require us to set a port in the URI BEGIN { $ENV{APACHE_TEST_PRETEND_NO_LWP} = 1 } use Apache::Test; use Apache::TestUtil; use Apache::TestRequest; plan tests => 4; { Apache::TestRequest::module("TestHooks::default_port"); my $uri = '/TestHooks__default_port'; my $response = GET $uri; ok t_cmp(80, $response->content, "$uri, default Apache hook"); } { Apache::TestRequest::module("TestHooks::default_port"); my $uri = '/TestHooks__default_port'; my $response = GET "$uri?362"; ok t_cmp(362, $response->content, "$uri, PerlDefaultPortHandler"); } { Apache::TestRequest::module("TestHooks::default_port2"); my $hostport = Apache::TestRequest::hostport(Apache::Test::config()); my $port = (split ':', $hostport)[1]; my $uri = '/TestHooks__default_port2'; my $response = GET $uri; ok t_cmp($port, $response->content, "$uri, no PerlDefaultHandler configured"); } { Apache::TestRequest::module("TestHooks::default_port3"); my $hostport = Apache::TestRequest::hostport(Apache::Test::config()); my $port = (split ':', $hostport)[1]; my $uri = "http://$hostport/"; my $response = GET $uri; ok t_cmp($port, $response->content, "$uri, no PerlDefaultHandler configured"); } 1.1 modperl-2.0/t/hooks/TestHooks/default_port.pm Index: default_port.pm =================================================================== package TestHooks::default_port; use strict; use warnings FATAL => 'all'; use Apache::Test; use APR::Table (); use Apache::RequestRec (); use Apache::RequestIO (); use Apache::Const -compile => qw(OK DECLINED); sub handler { my $r = shift; my $port = $r->args || Apache::OK; return int $port; } sub response { my $r = shift; $r->content_type('text/plain'); $r->print($r->get_server_port); return Apache::OK; } 1; __DATA__ # create a new virtual host so we can put the # PerlDefaultPortHandler on a per-server level # and it doesn't muck with existing tests <NoAutoConfig> <VirtualHost TestHooks::default_port> # this ServerName overrides the configured ServerName # hope that doesn't change someday... ServerName foo.example.com UseCanonicalName Off PerlModule TestHooks::default_port PerlDefaultPortHandler TestHooks::default_port PerlResponseHandler TestHooks::default_port::response SetHandler modperl </VirtualHost> # make sure that default mod_perl behavior # (DECLINED) doesn't mess up everyone else <VirtualHost TestHooks::default_port2> UseCanonicalName Off PerlResponseHandler TestHooks::default_port::response SetHandler modperl </VirtualHost> # make sure that default mod_perl behavior # (DECLINED) doesn't mess up everyone else (again) <VirtualHost TestHooks::default_port3> UseCanonicalName On PerlResponseHandler TestHooks::default_port::response SetHandler modperl </VirtualHost> </NoAutoConfig> 1.6 +6 -0 modperl-2.0/t/response/TestApache/conftree.pm Index: conftree.pm =================================================================== RCS file: /home/cvs/modperl-2.0/t/response/TestApache/conftree.pm,v retrieving revision 1.5 retrieving revision 1.6 diff -u -r1.5 -r1.6 --- conftree.pm 29 Jan 2003 03:56:00 -0000 1.5 +++ conftree.pm 7 Oct 2003 19:09:05 -0000 1.6 @@ -52,6 +52,12 @@ my $vhost_failed; for my $vhost ($tree->lookup("VirtualHost")) { + + # temporary fix for foo.example.com ServerName override + if (ref $vhost->{'ServerName'} eq 'ARRAY') { + $vhost->{'ServerName'} = $vhost->{'ServerName'}[0] + } + unless (exists $vhosts{$vhost->{'ServerName'} || $vhost->{'PerlProcessConnectionHandler'}}) { $vhost_failed++; 1.124 +10 -0 modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm Index: FunctionTable.pm =================================================================== RCS file: /home/cvs/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v retrieving revision 1.123 retrieving revision 1.124 diff -u -r1.123 -r1.124 --- FunctionTable.pm 26 Sep 2003 08:29:26 -0000 1.123 +++ FunctionTable.pm 7 Oct 2003 19:09:05 -0000 1.124 @@ -4718,6 +4718,16 @@ }, { 'return_type' => 'int', + 'name' => 'modperl_default_port__handler', + 'args' => [ + { + 'type' => 'request_rec *', + 'name' => 'r' + } + ] + }, + { + 'return_type' => 'int', 'name' => 'modperl_type_handler', 'args' => [ {