diff options
-rw-r--r-- | lib/Web/Request.pm | 23 | ||||
-rw-r--r-- | t/base.t | 8 |
2 files changed, 25 insertions, 6 deletions
diff --git a/lib/Web/Request.pm b/lib/Web/Request.pm index fa8cf3a..d0d90e0 100644 --- a/lib/Web/Request.pm +++ b/lib/Web/Request.pm @@ -81,10 +81,7 @@ has _base_uri => ( my $env = $self->env; my $scheme = $self->scheme || "http"; - my $server = $env->{HTTP_HOST}; - $server = ($env->{SERVER_NAME} || '') . ':' - . ($env->{SERVER_PORT} || 80) - unless defined $server; + my $server = $self->host; my $path = $self->script_name || '/'; return "${scheme}://${server}${path}"; @@ -431,6 +428,18 @@ sub _new_upload { $self->upload_class->new(@_); } +sub host { + my $self = shift; + + my $env = $self->env; + my $host = $env->{HTTP_HOST}; + $host = ($env->{SERVER_NAME} || '') . ':' + . ($env->{SERVER_PORT} || 80) + unless defined $host; + + return $host; +} + sub path { my $self = shift; @@ -559,6 +568,12 @@ Returns the HTTP method (GET, POST, etc.) used in the current request. Returns the local port that this request was made on. +=method host + +Returns the contents of the HTTP C<Host> header. If it doesn't exist, falls +back to recreating the host from the C<SERVER_NAME> and C<SERVER_PORT> +variables. + =method path Returns the request path for the current request. Unlike C<path_info>, this @@ -26,11 +26,13 @@ my @tests = ( { scheme => 'http', server_name => 'example.com', server_port => 80, - base => 'http://example.com/' }, + base => 'http://example.com/', + expected_host => 'example.com:80' }, { scheme => 'http', server_name => 'example.com', server_port => 8080, - base => 'http://example.com:8080/' }, + base => 'http://example.com:8080/', + expected_host => 'example.com:8080' }, { host => 'foobar.com', server_name => 'example.com', server_port => 8080, @@ -48,6 +50,8 @@ for my $block (@tests) { my $req = Web::Request->new_from_env($env); is $req->base_uri, $block->{base}; + my $expected_host = $block->{expected_host} || $block->{host}; + is $req->host, $expected_host; } done_testing; |