From: Marcus Ramberg <marcus@nordaaker.com>
Date: Mon, 17 Nov 2008 17:17:20 +0000 (+0000)
Subject: Support virtualhosts in tests
X-Git-Tag: 5.8000_03~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=d9d04deddc21923005721f9f86298b068c656369

Support virtualhosts in tests
---

diff --git a/Changes b/Changes
index 66f1207..df4e31c 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,8 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+        - Support mocking virtualhosts in test suite (Jason Gottshall)
+        - Add README
+
 5.8000_03 2008-10-14 14:13:00
         - Fix forwarding to Catalyst::Action objects (Rafael Kitover).
         - Fix links to the mailing lists (RT #39754 and Florian Ragwitz).
diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm
index 3ff6b43..be452c3 100644
--- a/lib/Catalyst/Test.pm
+++ b/lib/Catalyst/Test.pm
@@ -1,5 +1,7 @@
 package Catalyst::Test;
 
+use strict;
+use warnings;
 use Test::More;
 
 use Catalyst::Exception;
@@ -56,6 +58,7 @@ sub build_exports {
 }
 
 use namespace::clean;
+our $default_host;
 
 {
     my $import = Sub::Exporter::build_exporter({
@@ -63,9 +66,12 @@ use namespace::clean;
         into_level => 1,
     });
 
+
     sub import {
-        my ($self, $class) = @_;
+        my ($self, $class, $opts) = @_;
         $import->($self, '-all' => { class => $class });
+        $opts ||= {};
+        $default_host = $opts->{default_host} if exists $opts->{default_host};
     }
 }
 
@@ -111,6 +117,15 @@ Catalyst::Test - Test Catalyst Applications
 
     ok( get('/foo') =~ /bar/ );
 
+    # mock virtual hosts
+    use Catalyst::Test 'MyApp', { default_host => 'myapp.com' };
+    like( get('/whichhost'), qr/served by myapp.com/ );
+    like( get( '/whichhost', { host => 'yourapp.com' } ), qr/served by yourapp.com/ );
+    {
+        local $Catalyst::Test::default_host = 'otherapp.com';
+        like( get('/whichhost'), qr/served by otherapp.com/ );
+    }
+
 =head1 DESCRIPTION
 
 This module allows you to make requests to a Catalyst application either without
@@ -143,9 +158,11 @@ method and the L<request> method below:
 
 =head2 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 = request('foo/bar?test=1');
+    my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'});
 
 =head2 local_request
 
@@ -159,6 +176,7 @@ sub local_request {
     require HTTP::Request::AsCGI;
 
     my $request = Catalyst::Utils::request( shift(@_) );
+    _customize_request($request, @_);
     my $cgi     = HTTP::Request::AsCGI->new( $request, %ENV )->setup;
 
     $class->handle_request;
@@ -181,6 +199,8 @@ sub remote_request {
     my $request = Catalyst::Utils::request( shift(@_) );
     my $server  = URI->new( $ENV{CATALYST_SERVER} );
 
+    _customize_request($request, @_);
+
     if ( $server->path =~ m|^(.+)?/$| ) {
         my $path = $1;
         $server->path("$path") if $path;    # need to be quoted
@@ -228,6 +248,14 @@ sub remote_request {
     return $agent->request($request);
 }
 
+sub _customize_request {
+    my $request = shift;
+    my $opts = pop(@_) || {};
+    if ( my $host = exists $opts->{host} ? $opts->{host} : $default_host  ) {
+        $request->header( 'Host' => $host );
+    }
+}
+
 =head2 action_ok
 
 Fetches the given url and check that the request was successful
diff --git a/t/live_catalyst_test.t b/t/live_catalyst_test.t
index 6f1bacc..f4f695e 100644
--- a/t/live_catalyst_test.t
+++ b/t/live_catalyst_test.t
@@ -1,11 +1,32 @@
 use FindBin;
 use lib "$FindBin::Bin/lib";
-use Catalyst::Test 'TestApp';
+use Catalyst::Test 'TestApp', {default_host => 'default.com'};
+use Catalyst::Request;
 
-use Test::More tests => 5;
+use Test::More tests => 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 = '/dump/request';
+
+{
+    eval '$creq = ' . request($req)->content;
+    is( $creq->uri->host, 'default.com', 'request targets default host set via import' );
+}
+
+{
+    local $Catalyst::Test::default_host = 'localized.com';
+    eval '$creq = ' . request($req)->content;
+    is( $creq->uri->host, 'localized.com', 'target host is mutable via package var' );
+}
+
+{
+    my %opts = ( host => 'opthash.com' );
+    eval '$creq = ' . request($req, \%opts)->content;
+    is( $creq->uri->host, $opts{host}, 'target host is mutable via options hashref' );
+}
diff --git a/t/unit_load_catalyst_test.t b/t/unit_load_catalyst_test.t
index 0dbf8e3..9c9c61c 100644
--- a/t/unit_load_catalyst_test.t
+++ b/t/unit_load_catalyst_test.t
@@ -4,8 +4,9 @@ use strict;
 use warnings;
 
 use Test::More;
+use Catalyst::Utils;
 
-plan tests => 3;
+plan tests => 8;
 
 use_ok('Catalyst::Test');
 
@@ -14,3 +15,38 @@ isnt( $@, "", "get returns an error message with no app specified");
 
 eval "request('http://localhost')";
 isnt( $@, "", "request returns an error message with no app specified");
+
+sub customize { Catalyst::Test::_customize_request(@_) }
+
+{
+    my $req = Catalyst::Utils::request('/dummy');
+    customize( $req );
+    is( $req->header('Host'), undef, 'normal request is unmodified' );
+}
+
+{
+    my $req = Catalyst::Utils::request('/dummy');
+    customize( $req, { host => 'customized.com' } );
+    like( $req->header('Host'), qr/customized.com/, 'request is customizable via opts hash' );
+}
+
+{
+    my $req = Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host = 'localized.com';
+    customize( $req );
+    like( $req->header('Host'), qr/localized.com/, 'request is customizable via package var' );
+}
+
+{
+    my $req = Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host = 'localized.com';
+    customize( $req, { host => 'customized.com' } );
+    like( $req->header('Host'), qr/customized.com/, 'opts hash takes precedence over package var' );
+}
+
+{
+    my $req = Catalyst::Utils::request('/dummy');
+    local $Catalyst::Test::default_host = 'localized.com';
+    customize( $req, { host => '' } );
+    is( $req->header('Host'), undef, 'default value can be temporarily cleared via opts hash' );
+}