[Catalyst-commits] r8612 - in Catalyst-Runtime/5.80/trunk: .
lib/Catalyst t
marcus at dev.catalyst.perl.org
marcus at dev.catalyst.perl.org
Mon Nov 17 17:17:21 GMT 2008
Author: marcus
Date: 2008-11-17 17:17:20 +0000 (Mon, 17 Nov 2008)
New Revision: 8612
Modified:
Catalyst-Runtime/5.80/trunk/Changes
Catalyst-Runtime/5.80/trunk/lib/Catalyst/Test.pm
Catalyst-Runtime/5.80/trunk/t/live_catalyst_test.t
Catalyst-Runtime/5.80/trunk/t/unit_load_catalyst_test.t
Log:
Support virtualhosts in tests
Modified: Catalyst-Runtime/5.80/trunk/Changes
===================================================================
--- Catalyst-Runtime/5.80/trunk/Changes 2008-11-17 16:43:13 UTC (rev 8611)
+++ Catalyst-Runtime/5.80/trunk/Changes 2008-11-17 17:17:20 UTC (rev 8612)
@@ -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).
Modified: Catalyst-Runtime/5.80/trunk/lib/Catalyst/Test.pm
===================================================================
--- Catalyst-Runtime/5.80/trunk/lib/Catalyst/Test.pm 2008-11-17 16:43:13 UTC (rev 8611)
+++ Catalyst-Runtime/5.80/trunk/lib/Catalyst/Test.pm 2008-11-17 17:17:20 UTC (rev 8612)
@@ -1,5 +1,7 @@
package Catalyst::Test;
+use strict;
+use warnings;
use Test::More;
use Catalyst::Exception;
@@ -56,6 +58,7 @@
}
use namespace::clean;
+our $default_host;
{
my $import = Sub::Exporter::build_exporter({
@@ -63,9 +66,12 @@
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 @@
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 @@
=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 @@
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 @@
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 @@
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
Modified: Catalyst-Runtime/5.80/trunk/t/live_catalyst_test.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/live_catalyst_test.t 2008-11-17 16:43:13 UTC (rev 8611)
+++ Catalyst-Runtime/5.80/trunk/t/live_catalyst_test.t 2008-11-17 17:17:20 UTC (rev 8612)
@@ -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' );
+}
Modified: Catalyst-Runtime/5.80/trunk/t/unit_load_catalyst_test.t
===================================================================
--- Catalyst-Runtime/5.80/trunk/t/unit_load_catalyst_test.t 2008-11-17 16:43:13 UTC (rev 8611)
+++ Catalyst-Runtime/5.80/trunk/t/unit_load_catalyst_test.t 2008-11-17 17:17:20 UTC (rev 8612)
@@ -4,8 +4,9 @@
use warnings;
use Test::More;
+use Catalyst::Utils;
-plan tests => 3;
+plan tests => 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 = 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' );
+}
More information about the Catalyst-commits
mailing list