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