Commit | Line | Data |
fc7ec1d9 |
1 | package Catalyst::Test; |
2 | |
3 | use strict; |
b39840da |
4 | use warnings; |
d837e1a7 |
5 | |
a2f2cde9 |
6 | use Catalyst::Exception; |
d837e1a7 |
7 | use Catalyst::Utils; |
16d306fa |
8 | use Class::Inspector; |
fc7ec1d9 |
9 | use UNIVERSAL::require; |
0f895006 |
10 | |
fc7ec1d9 |
11 | =head1 NAME |
12 | |
8d2fa70c |
13 | Catalyst::Test - Test Catalyst Applications |
fc7ec1d9 |
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 | |
8d2fa70c |
31 | use Catalyst; |
b6898a9f |
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 | |
8d2fa70c |
49 | Test Catalyst Applications. |
fc7ec1d9 |
50 | |
51 | =head2 METHODS |
52 | |
b5ecfcf0 |
53 | =head2 get |
fc7ec1d9 |
54 | |
55 | Returns the content. |
56 | |
57 | my $content = get('foo/bar?test=1'); |
58 | |
b5ecfcf0 |
59 | =head2 request |
fc7ec1d9 |
60 | |
61 | Returns a C<HTTP::Response> object. |
62 | |
795117cf |
63 | my $res = request('foo/bar?test=1'); |
fc7ec1d9 |
64 | |
65 | =cut |
66 | |
fc7ec1d9 |
67 | sub import { |
66d9e175 |
68 | my $self = shift; |
45374ac6 |
69 | my $class = shift; |
70 | |
71 | my ( $get, $request ); |
72 | |
d96e14c2 |
73 | if ( $ENV{CATALYST_SERVER} ) { |
45374ac6 |
74 | $request = sub { remote_request(@_) }; |
75 | $get = sub { remote_request(@_)->content }; |
76 | } |
77 | |
78 | else { |
16d306fa |
79 | unless( Class::Inspector->loaded( $class ) ) { |
af81c980 |
80 | $class->require; |
81 | die $@ if $@; |
82 | } |
d96e14c2 |
83 | $class->import; |
84 | |
0f895006 |
85 | $request = sub { local_request( $class, @_ ) }; |
86 | $get = sub { local_request( $class, @_ )->content }; |
49faa307 |
87 | } |
45374ac6 |
88 | |
89 | no strict 'refs'; |
90 | my $caller = caller(0); |
91 | *{"$caller\::request"} = $request; |
92 | *{"$caller\::get"} = $get; |
93 | } |
94 | |
b5ecfcf0 |
95 | =head2 local_request |
0f895006 |
96 | |
97 | =cut |
98 | |
99 | sub local_request { |
100 | my $class = shift; |
101 | |
102 | require HTTP::Request::AsCGI; |
103 | |
104 | my $request = Catalyst::Utils::request( shift(@_) ); |
105 | my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup; |
106 | |
107 | $class->handle_request; |
108 | |
109 | return $cgi->restore->response; |
110 | } |
111 | |
523d44ec |
112 | my $agent; |
113 | |
b5ecfcf0 |
114 | =head2 remote_request |
bea4160a |
115 | |
b77e7869 |
116 | Do an actual remote request using LWP. |
bea4160a |
117 | |
118 | =cut |
119 | |
45374ac6 |
120 | sub remote_request { |
45374ac6 |
121 | |
68eb5874 |
122 | require LWP::UserAgent; |
123 | |
d837e1a7 |
124 | my $request = Catalyst::Utils::request( shift(@_) ); |
0f895006 |
125 | my $server = URI->new( $ENV{CATALYST_SERVER} ); |
523d44ec |
126 | |
127 | if ( $server->path =~ m|^(.+)?/$| ) { |
9ffadf88 |
128 | $server->path("$1"); # need to be quoted |
523d44ec |
129 | } |
130 | |
131 | $request->uri->scheme( $server->scheme ); |
132 | $request->uri->host( $server->host ); |
133 | $request->uri->port( $server->port ); |
134 | $request->uri->path( $server->path . $request->uri->path ); |
135 | |
68eb5874 |
136 | unless ($agent) { |
9ffadf88 |
137 | |
d837e1a7 |
138 | $agent = LWP::UserAgent->new( |
523d44ec |
139 | keep_alive => 1, |
140 | max_redirect => 0, |
141 | timeout => 60, |
142 | ); |
d837e1a7 |
143 | |
523d44ec |
144 | $agent->env_proxy; |
145 | } |
45374ac6 |
146 | |
147 | return $agent->request($request); |
fc7ec1d9 |
148 | } |
149 | |
fc7ec1d9 |
150 | =head1 SEE ALSO |
151 | |
152 | L<Catalyst>. |
153 | |
154 | =head1 AUTHOR |
155 | |
156 | Sebastian Riedel, C<sri@cpan.org> |
157 | |
158 | =head1 COPYRIGHT |
159 | |
160 | This program is free software, you can redistribute it and/or modify it under |
161 | the same terms as Perl itself. |
162 | |
163 | =cut |
164 | |
165 | 1; |