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 |
d96e14c2 | 26 | CATALYST_SERVER='http://localhost:3000/' prove -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; |
a2f2cde9 | 82 | |
83 | if ( $@ ) { | |
84 | ||
85 | my $error = $UNIVERSAL::require::ERROR; | |
86 | ||
87 | Catalyst::Exception->throw( | |
88 | message => qq/Couldn't load "$class", "$error"/ | |
89 | ); | |
90 | } | |
e646f111 | 91 | |
d96e14c2 | 92 | $class->import; |
93 | ||
45374ac6 | 94 | $request = sub { $class->run(@_) }; |
95 | $get = sub { $class->run(@_)->content }; | |
49faa307 | 96 | } |
45374ac6 | 97 | |
98 | no strict 'refs'; | |
99 | my $caller = caller(0); | |
100 | *{"$caller\::request"} = $request; | |
101 | *{"$caller\::get"} = $get; | |
102 | } | |
103 | ||
523d44ec | 104 | my $agent; |
105 | ||
bea4160a | 106 | =item remote_request |
107 | ||
b77e7869 | 108 | Do an actual remote request using LWP. |
bea4160a | 109 | |
110 | =cut | |
111 | ||
45374ac6 | 112 | sub remote_request { |
45374ac6 | 113 | |
d837e1a7 | 114 | require LWP::UserAgent; |
115 | ||
116 | my $request = Catalyst::Utils::request( shift(@_) ); | |
45374ac6 | 117 | |
d837e1a7 | 118 | my $server = URI->new( $ENV{CATALYST_SERVER} ); |
523d44ec | 119 | |
120 | if ( $server->path =~ m|^(.+)?/$| ) { | |
9ffadf88 | 121 | $server->path("$1"); # need to be quoted |
523d44ec | 122 | } |
123 | ||
124 | $request->uri->scheme( $server->scheme ); | |
125 | $request->uri->host( $server->host ); | |
126 | $request->uri->port( $server->port ); | |
127 | $request->uri->path( $server->path . $request->uri->path ); | |
128 | ||
d837e1a7 | 129 | unless ( $agent ) { |
9ffadf88 | 130 | |
d837e1a7 | 131 | $agent = LWP::UserAgent->new( |
523d44ec | 132 | keep_alive => 1, |
133 | max_redirect => 0, | |
134 | timeout => 60, | |
135 | ); | |
d837e1a7 | 136 | |
523d44ec | 137 | $agent->env_proxy; |
138 | } | |
45374ac6 | 139 | |
140 | return $agent->request($request); | |
fc7ec1d9 | 141 | } |
142 | ||
bea4160a | 143 | =back |
144 | ||
fc7ec1d9 | 145 | =head1 SEE ALSO |
146 | ||
147 | L<Catalyst>. | |
148 | ||
149 | =head1 AUTHOR | |
150 | ||
151 | Sebastian Riedel, C<sri@cpan.org> | |
152 | ||
153 | =head1 COPYRIGHT | |
154 | ||
155 | This program is free software, you can redistribute it and/or modify it under | |
156 | the same terms as Perl itself. | |
157 | ||
158 | =cut | |
159 | ||
160 | 1; |