1 # This test tests the standalone server's auto-restart feature.
8 plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
16 use Catalyst::Engine::HTTP::Restarter::Watcher;
17 use Time::HiRes qw/sleep/;
18 eval "use Catalyst::Devel 1.0;";
20 plan skip_all => 'Catalyst::Devel required' if $@;
21 plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03;
22 eval "use File::Copy::Recursive";
23 plan skip_all => 'File::Copy::Recursive required' if $@;
27 my $tmpdir = "$FindBin::Bin/../t/tmp";
30 rmtree $tmpdir if -d $tmpdir;
32 # create a TestApp and copy the test libs into it
36 system( $^X, "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' );
38 chdir "$FindBin::Bin/..";
39 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
41 # remove TestApp's tests
42 rmtree 't/tmp/TestApp/t';
44 # spawn the standalone HTTP server
45 my $port = 30000 + int rand( 1 + 10000 );
48 $pid = open3( undef, $server, undef,
49 $^X, "-I$FindBin::Bin/../lib",
50 "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
52 or die "Unable to spawn standalone HTTP server: $!";
54 # switch to non-blocking reads so we can fail
55 # gracefully instead of just hanging forever
57 $server->blocking( 0 );
59 # wait for it to start
60 print "Waiting for server to start...\n";
61 while ( check_port( 'localhost', $port ) != 1 ) {
65 # change various files
67 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
68 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
69 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm",
72 push(@files, "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm")
73 if Catalyst::Engine::HTTP::Restarter::Watcher::DETECT_PACKAGE_COMPILATION();
75 # change some files and make sure the server restarts itself
78 my $index = rand @files;
79 open my $pm, '>>', $files[$index]
80 or die "Unable to open $files[$index] for writing: $!";
84 # give the server time to notice the change and restart
88 while ( ( $line || '' ) !~ /can connect/ ) {
89 # wait for restart message
90 $line = $server->getline;
92 if ( $count++ > 100 ) {
93 fail "Server restarted";
95 skip "Server didn't restart, no sense in checking response", 1;
97 next NON_ERROR_RESTART;
100 pass "Server restarted";
103 while ( check_port( 'localhost', $port ) != 1 ) {
104 # wait for it to restart
106 die "Server appears to have died" if $count++ > 100;
108 my $response = get("http://localhost:$port/action/default");
109 like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
111 # give the server some time to reindex its files
115 # add errors to the file and make sure server does not die or restart
118 my $index = rand @files;
119 open my $pm, '>>', $files[$index]
120 or die "Unable to open $files[$index] for writing: $!";
127 while ( ( $line || '' ) !~ /failed/ ) {
128 # wait for restart message
129 $line = $server->getline;
131 if ( $count++ > 100 ) {
132 fail "Server restarted";
134 skip "Server didn't restart, no sense in checking response", 1;
136 next NO_RESTART_ON_ERROR;
140 pass "Server refused to restart";
142 if ( check_port( 'localhost', $port ) != 1 ) {
143 die "Server appears to have died";
145 my $response = get("http://localhost:$port/action/default");
146 like( $response, qr/Catalyst::Request/,
147 'Syntax error, no restart, request OK' );
149 # give the server some time to reindex its files
154 # multiple restart directories
156 # we need different options so we have to rebuild most
157 # of the testing environment
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
168 { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
169 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
171 # change various 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",
177 my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
178 my $restartdirs = join ' ', map{
179 "-restartdirectory $app_root/lib/TestApp/Controller/$_"
182 $pid = open3( undef, $server, undef,
183 $^X, "-I$FindBin::Bin/../lib",
184 "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
185 $port, '-restart', $restartdirs )
186 or die "Unable to spawn standalone HTTP server: $!";
187 $server->blocking( 0 );
190 # wait for it to start
191 print "Waiting for server to start...\n";
192 while ( check_port( 'localhost', $port ) != 1 ) {
198 my $index = rand @files;
199 open my $pm, '>>', $files[$index]
200 or die "Unable to open $files[$index] for writing: $!";
204 # give the server time to notice the change and restart
208 while ( ( $line || '' ) !~ /can connect/ ) {
209 # wait for restart message
210 $line = $server->getline;
212 if ( $count++ > 100 ) {
213 fail "Server restarted";
215 skip "Server didn't restart, no sense in checking response", 1;
217 next MULTI_DIR_RESTART;
220 pass "Server restarted with multiple restartdirs";
223 while ( check_port( 'localhost', $port ) != 1 ) {
224 # wait for it to restart
226 die "Server appears to have died" if $count++ > 100;
228 my $response = get("http://localhost:$port/action/default");
229 like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
231 # give the server some time to reindex its files
241 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
244 my ( $host, $port ) = @_;
246 my $remote = IO::Socket::INET->new(