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 my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib",
49 "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
52 $pid = open3( undef, $server, undef, @cmd )
53 or die "Unable to spawn standalone HTTP server: $!";
55 # switch to non-blocking reads so we can fail
56 # gracefully instead of just hanging forever
58 $server->blocking( 0 );
60 # wait for it to start
61 print "Waiting for server to start...\n";
62 while ( check_port( 'localhost', $port ) != 1 ) {
66 # change various files
68 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
69 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
70 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm",
71 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm",
74 # change some files and make sure the server restarts itself
77 my $index = rand @files;
78 open my $pm, '>>', $files[$index]
79 or die "Unable to open $files[$index] for writing: $!";
83 # give the server time to notice the change and restart
86 while ( ( $line || '' ) !~ /can connect/ ) {
87 # wait for restart message
88 $line = $server->getline;
90 if ( $count++ > 100 ) {
91 fail "Server restarted";
93 skip "Server didn't restart, no sense in checking response", 1;
95 next NON_ERROR_RESTART;
98 pass "Server restarted";
101 while ( check_port( 'localhost', $port ) != 1 ) {
102 # wait for it to restart
104 die "Server appears to have died" if $count++ > 100;
106 my $response = get("http://localhost:$port/action/default");
107 like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
109 # give the server some time to reindex its files
113 # add errors to the file and make sure server does not die or restart
116 my $index = rand @files;
117 open my $pm, '>>', $files[$index]
118 or die "Unable to open $files[$index] for writing: $!";
125 while ( ( $line || '' ) !~ /failed/ ) {
126 # wait for restart message
127 $line = $server->getline;
129 if ( $count++ > 100 ) {
130 fail "Server restarted";
132 skip "Server didn't restart, no sense in checking response", 1;
134 next NO_RESTART_ON_ERROR;
138 pass "Server refused to restart";
140 if ( check_port( 'localhost', $port ) != 1 ) {
141 die "Server appears to have died";
143 my $response = get("http://localhost:$port/action/default");
144 like( $response, qr/Catalyst::Request/,
145 'Syntax error, no restart, request OK' );
147 # give the server some time to reindex its files
152 # multiple restart directories
154 # we need different options so we have to rebuild most
155 # of the testing environment
160 # pick next port because the last one might still be blocked from
161 # previous server. This might fail if this port is unavailable
162 # but picking the first one has the same problem so this is acceptable
166 { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
167 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
169 # change various files
171 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",
172 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",
175 my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
176 my $restartdirs = join ' ', map{
177 "-restartdirectory $app_root/lib/TestApp/Controller/$_"
180 $pid = open3( undef, $server, undef,
181 $^X, "-I$FindBin::Bin/../lib",
182 "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
183 $port, '-restart', $restartdirs )
184 or die "Unable to spawn standalone HTTP server: $!";
185 $server->blocking( 0 );
188 # wait for it to start
189 print "Waiting for server to start...\n";
190 while ( check_port( 'localhost', $port ) != 1 ) {
196 my $index = rand @files;
197 open my $pm, '>>', $files[$index]
198 or die "Unable to open $files[$index] for writing: $!";
202 # give the server time to notice the change and restart
206 while ( ( $line || '' ) !~ /can connect/ ) {
207 # wait for restart message
208 $line = $server->getline;
210 if ( $count++ > 100 ) {
211 fail "Server restarted";
213 skip "Server didn't restart, no sense in checking response", 1;
215 next MULTI_DIR_RESTART;
218 pass "Server restarted with multiple restartdirs";
221 while ( check_port( 'localhost', $port ) != 1 ) {
222 # wait for it to restart
224 die "Server appears to have died" if $count++ > 100;
226 my $response = get("http://localhost:$port/action/default");
227 like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
229 # give the server some time to reindex its files
239 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
242 my ( $host, $port ) = @_;
244 my $remote = IO::Socket::INET->new(