1 # XXX - These tests seem to be somewhat flaky and timing-dependent. I
2 # have seen them all run to completion, and I've seen them fail
3 # partway through. If someone can come up with a better way to test
4 # this stuff that'd be great.
11 plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
14 use File::Spec::Functions qw(updir catdir);
16 use File::Basename qw(dirname);
17 use File::Temp qw(tempdir);
18 use File::Path qw(rmtree);
21 use IPC::Open3 qw(open3);
22 use Time::HiRes qw/sleep/;
24 use File::Copy::Recursive qw(dircopy);
28 my $helper_lib = abs_path(catdir(dirname($INC{'Catalyst/Helper.pm'}), updir));
30 my $tmpdir = tempdir(CLEANUP => 1);
31 my $appdir = catdir($tmpdir, 'TestApp');
35 my $helper = Catalyst::Helper->new(
42 $helper->mk_app('TestApp');
46 # remove TestApp's tests
49 # spawn the standalone HTTP server
50 my $port = 30000 + int rand( 1 + 10000 );
52 my ( $pid, $server ) = start_server($port);
54 # change various files
56 "$appdir/lib/TestApp.pm",
57 "$appdir/lib/TestApp/Controller/Foo.pm",
58 "$appdir/lib/TestApp/Controller/Root.pm",
61 # change some files and make sure the server restarts itself
64 my $index = rand @files;
65 open my $pm, '>>', $files[$index]
66 or die "Unable to open $files[$index] for writing: $!";
70 if ( ! look_for_restart() ) {
73 skip "Server did not restart, no sense in checking further", 1;
75 next NON_ERROR_RESTART;
78 my $response = get("http://localhost:$port/");
79 like( $response, qr/Welcome to the world of Catalyst/,
80 'Non-error restart, request OK' );
83 # add errors to the file and make sure server does die
86 my $index = rand @files;
87 open my $pm, '>>', $files[$index]
88 or die "Unable to open $files[$index] for writing: $!";
92 if ( ! look_for_death() ) {
95 skip "Server restarted, no sense in checking further", 2;
101 if ( ! look_for_restart() ) {
104 skip "Server did not restart, no sense in checking further", 1;
109 my $response = get("http://localhost:$port/");
110 like( $response, qr/Welcome to the world of Catalyst/,
111 'Non-error restart after death, request OK' );
114 # multiple restart directories
116 # we need different options so we have to rebuild most
117 # of the testing environment
119 kill 9, $pid or die "Cannot send kill signal to $pid: $!";
120 close $server or die "Cannot close handle to server process: $!";
123 # pick next port because the last one might still be blocked from
124 # previous server. This might fail if this port is unavailable
125 # but picking the first one has the same problem so this is acceptable
132 "$appdir/lib/TestApp/Controller/Subdir1/Foo.pm",
133 "$appdir/lib/TestApp/Controller/Subdir2/Foo.pm",
136 ( $pid, $server ) = start_server($port);
141 my $index = rand @files;
142 open my $pm, '>>', $files[$index]
143 or die "Unable to open $files[$index] for writing: $!";
147 if ( ! look_for_restart() ) {
148 skip "Server did not restart, no sense in checking further", 1;
151 my $response = get("http://localhost:$port/");
152 like( $response, qr/Welcome to the world of Catalyst/,
153 'Non-error restart with multiple watched dirs' );
162 local $File::Copy::Recursive::RMTrgFil = 1;
163 dircopy( 't/lib/TestApp', "$appdir/lib/TestApp" );
171 undef, $server, undef,
172 $^X, "-I$helper_lib",
173 "$appdir/script/testapp_server.pl", '--port',
175 ) or die "Unable to spawn standalone HTTP server: $!";
177 # switch to non-blocking reads so we can fail gracefully instead
178 # of just hanging forever
179 $server->blocking(0);
183 diag('Waiting for server to start...');
184 while ( check_port( 'localhost', $port ) != 1 ) {
188 if ( $waited >= 10 ) {
189 BAIL_OUT('Waited 10 seconds for server to start, to no avail');
193 return ($pid, $server);
197 my ( $host, $port ) = @_;
199 my $remote = IO::Socket::INET->new(
213 sub look_for_restart {
214 # give the server time to notice the change and restart
218 while ( ( $line || '' ) !~ /can connect/ ) {
219 $line = $server->getline;
221 if ( $count++ > 300 ) {
222 fail "Server restarted";
227 pass "Server restarted";
233 # give the server time to notice the change and restart
237 while ( ( $line || '' ) !~ /failed/ ) {
238 $line = $server->getline;
240 if ( $count++ > 300 ) {