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