Set Host: header and HTTP_HOST based on $request->uri. Fixes plack#177

karenetheridge · Mar 31, 2012 · e91f4c6 · e91f4c6
1 parent b2f3ffb
commit e91f4c6
Show file tree

Hide file tree

Showing 2 changed files with 31 additions and 0 deletions.
diff --git a/lib/HTTP/Message/PSGI.pm b/lib/HTTP/Message/PSGI.pm
@@ -88,6 +88,10 @@ sub req_to_psgi {
         $env->{PATH_INFO} =~ s/^\/+/\//;
     }
 
+    if (!$env->{HTTP_HOST} && $req->uri->can('host')) {
+        $env->{HTTP_HOST} = $req->uri->host;
+    }
+
     return $env;
 }
 

diff --git a/t/HTTP-Message-PSGI/host.t b/t/HTTP-Message-PSGI/host.t
@@ -0,0 +1,27 @@
+use strict;
+use warnings;
+use Test::More;
+use HTTP::Message::PSGI qw(req_to_psgi);
+use HTTP::Request;
+
+{
+    my $req = HTTP::Request->new(GET => "http://example.com/");
+    my $env = req_to_psgi $req;
+
+    is $env->{HTTP_HOST}, 'example.com';
+    is $env->{PATH_INFO}, '/';
+}
+
+{
+    my $req = HTTP::Request->new(GET => "/");
+    $req->header('Host' => "perl.com");
+    my $env = req_to_psgi $req;
+
+    is $env->{HTTP_HOST}, 'perl.com';
+    is $env->{PATH_INFO}, '/';
+}
+
+done_testing;
+
+
+