Commit | Line | Data |
---|---|---|
fc7ec1d9 | 1 | package Catalyst::Test; |
2 | ||
3 | use strict; | |
d837e1a7 | 4 | |
a2f2cde9 | 5 | use Catalyst::Exception; |
d837e1a7 | 6 | use Catalyst::Utils; |
fc7ec1d9 | 7 | use UNIVERSAL::require; |
fc7ec1d9 | 8 | |
e05c5e3c | 9 | $ENV{CATALYST_ENGINE} = 'Test'; |
fc7ec1d9 | 10 | |
11 | =head1 NAME | |
12 | ||
13 | Catalyst::Test - Test Catalyst applications | |
14 | ||
15 | =head1 SYNOPSIS | |
16 | ||
49faa307 | 17 | # Helper |
49faa307 | 18 | script/test.pl |
19 | ||
fc7ec1d9 | 20 | # Tests |
21 | use Catalyst::Test 'TestApp'; | |
22 | request('index.html'); | |
23 | get('index.html'); | |
24 | ||
45374ac6 | 25 | # Run tests against a remote server |
21465c88 | 26 | CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/ |
45374ac6 | 27 | |
b6898a9f | 28 | # Tests with inline apps need to use Catalyst::Engine::Test |
29 | package TestApp; | |
30 | ||
31 | use Catalyst qw[-Engine=Test]; | |
32 | ||
c46c32fa | 33 | sub foo : Global { |
b6898a9f | 34 | my ( $self, $c ) = @_; |
35 | $c->res->output('bar'); | |
c46c32fa | 36 | } |
37 | ||
38 | __PACKAGE__->setup(); | |
b6898a9f | 39 | |
40 | package main; | |
41 | ||
42 | use Test::More tests => 1; | |
43 | use Catalyst::Test 'TestApp'; | |
44 | ||
45 | ok( get('/foo') =~ /bar/ ); | |
46 | ||
fc7ec1d9 | 47 | =head1 DESCRIPTION |
48 | ||
49 | Test Catalyst applications. | |
50 | ||
51 | =head2 METHODS | |
52 | ||
bea4160a | 53 | =over 4 |
54 | ||
55 | =item get | |
fc7ec1d9 | 56 | |
57 | Returns the content. | |
58 | ||
59 | my $content = get('foo/bar?test=1'); | |
60 | ||
bea4160a | 61 | =item request |
fc7ec1d9 | 62 | |
63 | Returns a C<HTTP::Response> object. | |
64 | ||
65 | my $res =request('foo/bar?test=1'); | |
66 | ||
67 | =cut | |
68 | ||
fc7ec1d9 | 69 | sub import { |
66d9e175 | 70 | my $self = shift; |
45374ac6 | 71 | my $class = shift; |
72 | ||
73 | my ( $get, $request ); | |
74 | ||
d96e14c2 | 75 | if ( $ENV{CATALYST_SERVER} ) { |
45374ac6 | 76 | $request = sub { remote_request(@_) }; |
77 | $get = sub { remote_request(@_)->content }; | |
78 | } | |
79 | ||
80 | else { | |
bc024080 | 81 | $class->require; |
d96e14c2 | 82 | $class->import; |
83 | ||
45374ac6 | 84 | $request = sub { $class->run(@_) }; |
85 | $get = sub { $class->run(@_)->content }; | |
49faa307 | 86 | } |
45374ac6 | 87 | |
88 | no strict 'refs'; | |
89 | my $caller = caller(0); | |
90 | *{"$caller\::request"} = $request; | |
91 | *{"$caller\::get"} = $get; | |
92 | } | |
93 | ||
523d44ec | 94 | my $agent; |
95 | ||
bea4160a | 96 | =item remote_request |
97 | ||
b77e7869 | 98 | Do an actual remote request using LWP. |
bea4160a | 99 | |
100 | =cut | |
101 | ||
45374ac6 | 102 | sub remote_request { |
45374ac6 | 103 | |
68eb5874 | 104 | require LWP::UserAgent; |
105 | ||
d837e1a7 | 106 | my $request = Catalyst::Utils::request( shift(@_) ); |
45374ac6 | 107 | |
68eb5874 | 108 | my $server = URI->new( $ENV{CATALYST_SERVER} ); |
523d44ec | 109 | |
110 | if ( $server->path =~ m|^(.+)?/$| ) { | |
9ffadf88 | 111 | $server->path("$1"); # need to be quoted |
523d44ec | 112 | } |
113 | ||
114 | $request->uri->scheme( $server->scheme ); | |
115 | $request->uri->host( $server->host ); | |
116 | $request->uri->port( $server->port ); | |
117 | $request->uri->path( $server->path . $request->uri->path ); | |
118 | ||
68eb5874 | 119 | unless ($agent) { |
9ffadf88 | 120 | |
d837e1a7 | 121 | $agent = LWP::UserAgent->new( |
523d44ec | 122 | keep_alive => 1, |
123 | max_redirect => 0, | |
124 | timeout => 60, | |
125 | ); | |
d837e1a7 | 126 | |
523d44ec | 127 | $agent->env_proxy; |
128 | } | |
45374ac6 | 129 | |
130 | return $agent->request($request); | |
fc7ec1d9 | 131 | } |
132 | ||
bea4160a | 133 | =back |
134 | ||
fc7ec1d9 | 135 | =head1 SEE ALSO |
136 | ||
137 | L<Catalyst>. | |
138 | ||
139 | =head1 AUTHOR | |
140 | ||
141 | Sebastian Riedel, C<sri@cpan.org> | |
142 | ||
143 | =head1 COPYRIGHT | |
144 | ||
145 | This program is free software, you can redistribute it and/or modify it under | |
146 | the same terms as Perl itself. | |
147 | ||
148 | =cut | |
149 | ||
150 | 1; |