along with the map_to_storage hook, I noticed that there are two other Apache hooks that don't have Perl counterparts: ap_hook_default_port and ap_hook_http_method.
here is an implementation for the PerlDefaultPortHandler. unlike other hooks, this one doesn't enter the request cycle by default - it's called when ap_default_port is invoked (such as with ap_get_server_port, depending on your server settings), giving modules a chance to alter the default port via a callback. the only example I can find is in mod_ssl, where the hook is used to reflect 443 over 80 as the default port.
while it may seem inconsequential now, I can see it being important for protocol handlers someday (and the same with hook_http_method, however misnamed). and besides, it's there in Apache so it should be there in Perl :)
anyway, patches for PerlMapToStorageHandler and PerlHttpMethodHandler coming soon...
--Geoff
Index: lib/ModPerl/Code.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/lib/ModPerl/Code.pm,v
retrieving revision 1.107
diff -u -r1.107 Code.pm
--- lib/ModPerl/Code.pm 1 Oct 2003 19:53:05 -0000 1.107
+++ lib/ModPerl/Code.pm 7 Oct 2003 06:40:32 -0000
@@ -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/;
}
}
Index: src/modules/perl/modperl_callback.c
===================================================================
RCS file: /home/cvspublic/modperl-2.0/src/modules/perl/modperl_callback.c,v
retrieving revision 1.60
diff -u -r1.60 modperl_callback.c
--- src/modules/perl/modperl_callback.c 2 Oct 2003 17:45:52 -0000 1.60
+++ src/modules/perl/modperl_callback.c 7 Oct 2003 06:40:32 -0000
@@ -82,9 +82,8 @@
/* ModPerl::Util::exit doesn't return an integer value */
status = OK;
}
- /* assume OK for non-http status codes and for 200 (HTTP_OK) */
- if (((status > 0) && (status < 100)) ||
- (status == 200) || (status > 600)) {
+ /* assume OK for 200 (HTTP_OK) */
+ if ((status == 200)) {
status = OK;
}
}
Index: t/response/TestApache/conftree.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/t/response/TestApache/conftree.pm,v
retrieving revision 1.5
diff -u -r1.5 conftree.pm
--- t/response/TestApache/conftree.pm 29 Jan 2003 03:56:00 -0000 1.5
+++ t/response/TestApache/conftree.pm 7 Oct 2003 06:40:32 -0000
@@ -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++;
Index: xs/maps/apache_functions.map
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/maps/apache_functions.map,v
retrieving revision 1.64
diff -u -r1.64 apache_functions.map
--- xs/maps/apache_functions.map 12 Jun 2003 23:27:03 -0000 1.64
+++ xs/maps/apache_functions.map 7 Oct 2003 06:40:33 -0000
@@ -432,7 +432,7 @@
>ap_run_post_config
>ap_run_insert_filter
>ap_run_child_init
-?ap_run_default_port
+ap_run_default_port
?ap_run_http_method
>ap_run_create_connection
>ap_run_pre_connection
Index: xs/tables/current/ModPerl/FunctionTable.pm
===================================================================
RCS file: /home/cvspublic/modperl-2.0/xs/tables/current/ModPerl/FunctionTable.pm,v
retrieving revision 1.123
diff -u -r1.123 FunctionTable.pm
--- xs/tables/current/ModPerl/FunctionTable.pm 26 Sep 2003 08:29:26 -0000 1.123
+++ xs/tables/current/ModPerl/FunctionTable.pm 7 Oct 2003 06:40:37 -0000
@@ -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' => [
{
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ t/hooks/TestHooks/default_port.pm 2003-10-07 02:21:07.000000000 -0400
@@ -0,0 +1,48 @@
+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>
+</NoAutoConfig>
--- /dev/null 2003-01-30 05:24:37.000000000 -0500
+++ t/hooks/default_port.t 2003-10-07 02:04:59.000000000 -0400
@@ -0,0 +1,29 @@
+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 => 2;
+
+my $module = "TestHooks::default_port";
+Apache::TestRequest::module($module);
+
+my $uri = '/TestHooks__default_port';
+
+t_debug("connecting to $uri");
+
+{
+ my $response = GET $uri;
+ ok t_cmp(80, $response->content, 'default Apache hook');
+}
+
+{
+ my $response = GET "$uri?362";
+ ok t_cmp(362, $response->content, 'PerlDefaultPortHandler');
+}
--------------------------------------------------------------------- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED]
