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