[Catalyst-dev] PATCH: enable virtual hosts in Catalyst::Test

[Jason Gottshall]

Marcus Ramberg wrote:
> On 11. nov.. 2008, at 16.55, Jason Gottshall wrote:
> =

>> Here's my first stab at a Catalyst contrib. Patch against 5.80/trunk. =

>> Tests and pod included. Let me know how I did! Remainder of message is =

>> svn diff:
> =

> Can you please resend this diff as an attachment, as it's been mangled =

> in the main body.

Sorry. See attached.

-------------- next part --------------
Index: t/unit_load_catalyst_test.t
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- t/unit_load_catalyst_test.t    (revision 8583)
+++ t/unit_load_catalyst_test.t    (working copy)
@@ -4,8 +4,9 @@
 use warnings;

 use Test::More;
+use Catalyst::Utils;

-plan tests =3D> 3;
+plan tests =3D> 8;

 use_ok('Catalyst::Test');

@@ -14,3 +15,38 @@

 eval "request('http://localhost')";
 isnt( $@, "", "request returns an error message with no app specified");
+
+sub customize { Catalyst::Test::_customize_request(@_) }
+
+{
+    my $req =3D Catalyst::Utils::request('/dummy');
+    customize( $req );
+    is( $req->header('Host'), undef, 'normal request is unmodified' );
+}
+
+{
+    my $req =3D Catalyst::Utils::request('/dummy');
+    customize( $req, { host =3D> 'customized.com' } );
+    like( $req->header('Host'), qr/customized.com/, 'request is customizab=
le via opts hash' );
+}
+
+{
+    my $req =3D Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host =3D 'localized.com';
+    customize( $req );
+    like( $req->header('Host'), qr/localized.com/, 'request is customizabl=
e via package var' );
+}
+
+{
+    my $req =3D Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host =3D 'localized.com';
+    customize( $req, { host =3D> 'customized.com' } );
+    like( $req->header('Host'), qr/customized.com/, 'opts hash takes prece=
dence over package var' );
+}
+
+{
+    my $req =3D Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host =3D 'localized.com';
+    customize( $req, { host =3D> '' } );
+    is( $req->header('Host'), undef, 'default value can be temporarily cle=
ared via opts hash' );
+}
Index: t/live_catalyst_test.t
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- t/live_catalyst_test.t    (revision 8583)
+++ t/live_catalyst_test.t    (working copy)
@@ -1,11 +1,32 @@
 use FindBin;
 use lib "$FindBin::Bin/lib";
-use Catalyst::Test 'TestApp';
+use Catalyst::Test 'TestApp', {default_host =3D> 'default.com'};
+use Catalyst::Request;

-use Test::More tests =3D> 5;
+use Test::More tests =3D> 8;

 content_like('/',qr/root/,'content check');
 action_ok('/','Action ok ok','normal action ok');
 action_redirect('/engine/response/redirect/one','redirect check');
 action_notfound('/engine/response/status/s404','notfound check');
-contenttype_is('/action/local/one','text/plain','Contenttype check');
\ No newline at end of file
+contenttype_is('/action/local/one','text/plain','Contenttype check');
+
+my $creq;
+my $req =3D '/dump/request';
+
+{
+    eval '$creq =3D ' . request($req)->content;
+    is( $creq->uri->host, 'default.com', 'request targets default host set=
 via import' );
+}
+
+{
+    local $Catalyst::Test::default_host =3D 'localized.com';
+    eval '$creq =3D ' . request($req)->content;
+    is( $creq->uri->host, 'localized.com', 'target host is mutable via pac=
kage var' );
+}
+
+{
+    my %opts =3D ( host =3D> 'opthash.com' );
+    eval '$creq =3D ' . request($req, \%opts)->content;
+    is( $creq->uri->host, $opts{host}, 'target host is mutable via options=
 hashref' );
+}
Index: lib/Catalyst/Test.pm
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D
--- lib/Catalyst/Test.pm    (revision 8583)
+++ lib/Catalyst/Test.pm    (working copy)
@@ -63,9 +63,13 @@
         into_level =3D> 1,
     });

+    our $default_host;
+
     sub import {
-        my ($self, $class) =3D @_;
+        my ($self, $class, $opts) =3D @_;
         $import->($self, '-all' =3D> { class =3D> $class });
+        $opts ||=3D {};
+        $default_host =3D $opts->{default_host} if exists $opts->{default_=
host};
     }
 }

@@ -111,6 +115,15 @@

     ok( get('/foo') =3D~ /bar/ );

+    # mock virtual hosts
+    use Catalyst::Test 'MyApp', { default_host =3D> 'myapp.com' };
+    like( get('/whichhost'), qr/served by myapp.com/ );
+    like( get( '/whichhost', { host =3D> 'yourapp.com' } ), qr/served by y=
ourapp.com/ );
+    {
+        local $Catalyst::Test::default_host =3D 'otherapp.com';
+        like( get('/whichhost'), qr/served by otherapp.com/ );
+    }
+
 =3Dhead1 DESCRIPTION

 This module allows you to make requests to a Catalyst application either w=
ithout
@@ -143,9 +156,11 @@

 =3Dhead2 request

-Returns a C<HTTP::Response> object.
+Returns a C<HTTP::Response> object. Accepts an optional hashref for request
+header configuration; currently only supports setting 'host' value.

     my $res =3D request('foo/bar?test=3D1');
+    my $virtual_res =3D request('foo/bar?test=3D1', {host =3D> 'virtualhos=
t.com'});

 =3Dhead2 local_request

@@ -159,6 +174,7 @@
     require HTTP::Request::AsCGI;

     my $request =3D Catalyst::Utils::request( shift(@_) );
+    _customize_request($request, @_);
     my $cgi     =3D HTTP::Request::AsCGI->new( $request, %ENV )->setup;

     $class->handle_request;
@@ -181,6 +197,8 @@
     my $request =3D Catalyst::Utils::request( shift(@_) );
     my $server  =3D URI->new( $ENV{CATALYST_SERVER} );

+    _customize_request($request, @_);
+
     if ( $server->path =3D~ m|^(.+)?/$| ) {
         my $path =3D $1;
         $server->path("$path") if $path;    # need to be quoted
@@ -228,6 +246,14 @@
     return $agent->request($request);
 }

+sub _customize_request {
+    my $request =3D shift;
+    my $opts =3D pop(@_) || {};
+    if ( my $host =3D exists $opts->{host} ? $opts->{host} : $default_host=
  ) {
+        $request->header( 'Host' =3D> $host );
+    }
+}
+
 =3Dhead2 action_ok

 Fetches the given url and check that the request was successful