Commit | Line | Data |
c7ded7aa |
1 | # This test tests the standalone server's auto-restart feature. |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
4853fb50 |
6 | use Test::More; |
7 | BEGIN { |
8 | plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP}; |
9 | } |
10 | |
c7ded7aa |
11 | use File::Path; |
12 | use FindBin; |
13 | use LWP::Simple; |
14 | use IO::Socket; |
2f381252 |
15 | use IPC::Open3; |
65b708a6 |
16 | use Catalyst::Engine::HTTP::Restarter::Watcher; |
c7ded7aa |
17 | use Time::HiRes qw/sleep/; |
18 | eval "use Catalyst::Devel 1.0;"; |
19 | |
c7ded7aa |
20 | plan skip_all => 'Catalyst::Devel required' if $@; |
9c71d51d |
21 | plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03; |
c7ded7aa |
22 | eval "use File::Copy::Recursive"; |
23 | plan skip_all => 'File::Copy::Recursive required' if $@; |
24 | |
9c71d51d |
25 | plan tests => 120; |
c7ded7aa |
26 | |
2f381252 |
27 | my $tmpdir = "$FindBin::Bin/../t/tmp"; |
28 | |
c7ded7aa |
29 | # clean up |
2f381252 |
30 | rmtree $tmpdir if -d $tmpdir; |
c7ded7aa |
31 | |
32 | # create a TestApp and copy the test libs into it |
2f381252 |
33 | mkdir $tmpdir; |
34 | chdir $tmpdir; |
35 | |
868a7cca |
36 | system( $^X, "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' ); |
2f381252 |
37 | |
c7ded7aa |
38 | chdir "$FindBin::Bin/.."; |
39 | File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); |
40 | |
41 | # remove TestApp's tests |
42 | rmtree 't/tmp/TestApp/t'; |
43 | |
44 | # spawn the standalone HTTP server |
45 | my $port = 30000 + int rand( 1 + 10000 ); |
9c71d51d |
46 | |
2f381252 |
47 | my( $server, $pid ); |
48 | $pid = open3( undef, $server, undef, |
868a7cca |
49 | $^X, "-I$FindBin::Bin/../lib", |
2f381252 |
50 | "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', |
51 | $port, '-restart' ) |
52 | or die "Unable to spawn standalone HTTP server: $!"; |
c7ded7aa |
53 | |
9c71d51d |
54 | # switch to non-blocking reads so we can fail |
55 | # gracefully instead of just hanging forever |
56 | |
57 | $server->blocking( 0 ); |
58 | |
c7ded7aa |
59 | # wait for it to start |
60 | print "Waiting for server to start...\n"; |
61 | while ( check_port( 'localhost', $port ) != 1 ) { |
62 | sleep 1; |
63 | } |
64 | |
65 | # change various files |
66 | my @files = ( |
67 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm", |
68 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", |
7d9921b1 |
69 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm", |
c7ded7aa |
70 | ); |
71 | |
65b708a6 |
72 | push(@files, "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm") |
73 | if Catalyst::Engine::HTTP::Restarter::Watcher::DETECT_PACKAGE_COMPILATION(); |
74 | |
c7ded7aa |
75 | # change some files and make sure the server restarts itself |
9c71d51d |
76 | NON_ERROR_RESTART: |
c7ded7aa |
77 | for ( 1 .. 20 ) { |
78 | my $index = rand @files; |
79 | open my $pm, '>>', $files[$index] |
80 | or die "Unable to open $files[$index] for writing: $!"; |
81 | print $pm "\n"; |
82 | close $pm; |
83 | |
84 | # give the server time to notice the change and restart |
85 | my $count = 0; |
9c71d51d |
86 | my $line; |
c7ded7aa |
87 | |
9c71d51d |
88 | while ( ( $line || '' ) !~ /can connect/ ) { |
89 | # wait for restart message |
90 | $line = $server->getline; |
91 | sleep 0.1; |
92 | if ( $count++ > 100 ) { |
93 | fail "Server restarted"; |
94 | SKIP: { |
95 | skip "Server didn't restart, no sense in checking response", 1; |
96 | } |
97 | next NON_ERROR_RESTART; |
98 | } |
99 | }; |
100 | pass "Server restarted"; |
101 | |
102 | $count = 0; |
103 | while ( check_port( 'localhost', $port ) != 1 ) { |
c7ded7aa |
104 | # wait for it to restart |
105 | sleep 0.1; |
9c71d51d |
106 | die "Server appears to have died" if $count++ > 100; |
c7ded7aa |
107 | } |
108 | my $response = get("http://localhost:$port/action/default"); |
109 | like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); |
110 | |
9c71d51d |
111 | # give the server some time to reindex its files |
112 | sleep 1; |
c7ded7aa |
113 | } |
114 | |
115 | # add errors to the file and make sure server does not die or restart |
9c71d51d |
116 | NO_RESTART_ON_ERROR: |
c7ded7aa |
117 | for ( 1 .. 20 ) { |
118 | my $index = rand @files; |
119 | open my $pm, '>>', $files[$index] |
120 | or die "Unable to open $files[$index] for writing: $!"; |
121 | print $pm "bleh"; |
122 | close $pm; |
123 | |
9c71d51d |
124 | my $count = 0; |
125 | my $line; |
126 | |
127 | while ( ( $line || '' ) !~ /failed/ ) { |
128 | # wait for restart message |
129 | $line = $server->getline; |
130 | sleep 0.1; |
131 | if ( $count++ > 100 ) { |
132 | fail "Server restarted"; |
133 | SKIP: { |
134 | skip "Server didn't restart, no sense in checking response", 1; |
135 | } |
136 | next NO_RESTART_ON_ERROR; |
137 | } |
138 | }; |
139 | |
140 | pass "Server refused to restart"; |
141 | |
c7ded7aa |
142 | if ( check_port( 'localhost', $port ) != 1 ) { |
143 | die "Server appears to have died"; |
144 | } |
145 | my $response = get("http://localhost:$port/action/default"); |
146 | like( $response, qr/Catalyst::Request/, |
147 | 'Syntax error, no restart, request OK' ); |
148 | |
9c71d51d |
149 | # give the server some time to reindex its files |
150 | sleep 1; |
151 | |
c7ded7aa |
152 | } |
153 | |
9c71d51d |
154 | # multiple restart directories |
155 | |
156 | # we need different options so we have to rebuild most |
157 | # of the testing environment |
158 | |
159 | kill 'KILL', $pid; |
160 | close $server; |
161 | |
162 | # pick next port because the last one might still be blocked from |
163 | # previous server. This might fail if this port is unavailable |
164 | # but picking the first one has the same problem so this is acceptable |
165 | |
166 | $port += 1; |
167 | |
168 | { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; } |
169 | File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); |
170 | |
171 | # change various files |
172 | @files = ( |
173 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", |
174 | "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm", |
175 | ); |
176 | |
177 | my $app_root = "$FindBin::Bin/../t/tmp/TestApp"; |
178 | my $restartdirs = join ' ', map{ |
179 | "-restartdirectory $app_root/lib/TestApp/Controller/$_" |
180 | } qw/Action Engine/; |
181 | |
2f381252 |
182 | $pid = open3( undef, $server, undef, |
868a7cca |
183 | $^X, "-I$FindBin::Bin/../lib", |
2f381252 |
184 | "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', |
185 | $port, '-restart', $restartdirs ) |
186 | or die "Unable to spawn standalone HTTP server: $!"; |
9c71d51d |
187 | $server->blocking( 0 ); |
188 | |
189 | |
190 | # wait for it to start |
191 | print "Waiting for server to start...\n"; |
192 | while ( check_port( 'localhost', $port ) != 1 ) { |
193 | sleep 1; |
194 | } |
195 | |
196 | MULTI_DIR_RESTART: |
197 | for ( 1 .. 20 ) { |
198 | my $index = rand @files; |
199 | open my $pm, '>>', $files[$index] |
200 | or die "Unable to open $files[$index] for writing: $!"; |
201 | print $pm "\n"; |
202 | close $pm; |
203 | |
204 | # give the server time to notice the change and restart |
205 | my $count = 0; |
206 | my $line; |
207 | |
208 | while ( ( $line || '' ) !~ /can connect/ ) { |
209 | # wait for restart message |
210 | $line = $server->getline; |
211 | sleep 0.1; |
212 | if ( $count++ > 100 ) { |
213 | fail "Server restarted"; |
191cf700 |
214 | SKIP: { |
9c71d51d |
215 | skip "Server didn't restart, no sense in checking response", 1; |
216 | } |
217 | next MULTI_DIR_RESTART; |
218 | } |
219 | }; |
220 | pass "Server restarted with multiple restartdirs"; |
221 | |
222 | $count = 0; |
223 | while ( check_port( 'localhost', $port ) != 1 ) { |
224 | # wait for it to restart |
225 | sleep 0.1; |
226 | die "Server appears to have died" if $count++ > 100; |
227 | } |
228 | my $response = get("http://localhost:$port/action/default"); |
229 | like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); |
230 | |
231 | # give the server some time to reindex its files |
232 | sleep 1; |
233 | } |
234 | |
235 | # shut it down again |
236 | |
237 | kill 'KILL', $pid; |
c7ded7aa |
238 | close $server; |
239 | |
240 | # clean up |
241 | rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; |
242 | |
243 | sub check_port { |
244 | my ( $host, $port ) = @_; |
245 | |
246 | my $remote = IO::Socket::INET->new( |
247 | Proto => "tcp", |
248 | PeerAddr => $host, |
249 | PeerPort => $port |
250 | ); |
251 | if ($remote) { |
252 | close $remote; |
253 | return 1; |
254 | } |
255 | else { |
256 | return 0; |
257 | } |
258 | } |