t/optional_http-server-restart.t

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