Permalink
Browse files

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

  • Loading branch information...
1 parent b2f3ffb commit e91f4c66b20759840b5bb2aa8e4be7ec41ea621e @miyagawa miyagawa committed Mar 31, 2012
Showing with 31 additions and 0 deletions.
  1. +4 −0 lib/HTTP/Message/PSGI.pm
  2. +27 −0 t/HTTP-Message-PSGI/host.t
@@ -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;
}
@@ -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;
+
+
+

0 comments on commit e91f4c6

Please sign in to comment.