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 my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib",
  49   "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
  50   $port, '-restart');
  51
  52 $pid = open3( undef, $server, undef, @cmd )
  53     or die "Unable to spawn standalone HTTP server: $!";
  54
  55 # switch to non-blocking reads so we can fail
  56 # gracefully instead of just hanging forever
  57
  58 $server->blocking( 0 );
  59
  60 # wait for it to start
  61 print "Waiting for server to start...\n";
  62 while ( check_port( 'localhost', $port ) != 1 ) {
  63     sleep 1;
  64 }
  65
  66 # change various files
  67 my @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",
  72 );
  73
  74 # change some files and make sure the server restarts itself
  75 NON_ERROR_RESTART:
  76 for ( 1 .. 20 ) {
  77     my $index = rand @files;
  78     open my $pm, '>>', $files[$index]
  79       or die "Unable to open $files[$index] for writing: $!";
  80     print $pm "\n";
  81     close $pm;
  82
  83     # give the server time to notice the change and restart
  84     my $count = 0;
  85     my $line;
  86     while ( ( $line || '' ) !~ /can connect/ ) {
  87         # wait for restart message
  88         $line = $server->getline;
  89         sleep 0.1;
  90         if ( $count++ > 100 ) {
  91             fail "Server restarted";
  92             SKIP: {
  93                 skip "Server didn't restart, no sense in checking response", 1;
  94             }
  95             next NON_ERROR_RESTART;
  96         }
  97     };
  98     pass "Server restarted";
  99
 100     $count = 0;
 101     while ( check_port( 'localhost', $port ) != 1 ) {
 102         # wait for it to restart
 103         sleep 0.1;
 104         die "Server appears to have died" if $count++ > 100;
 105     }
 106     my $response = get("http://localhost:$port/action/default");
 107     like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
 108
 109     # give the server some time to reindex its files
 110     sleep 1;
 111 }
 112
 113 # add errors to the file and make sure server does not die or restart
 114 NO_RESTART_ON_ERROR:
 115 for ( 1 .. 20 ) {
 116     my $index = rand @files;
 117     open my $pm, '>>', $files[$index]
 118       or die "Unable to open $files[$index] for writing: $!";
 119     print $pm "bleh";
 120     close $pm;
 121
 122     my $count = 0;
 123     my $line;
 124
 125     while ( ( $line || '' ) !~ /failed/ ) {
 126         # wait for restart message
 127         $line = $server->getline;
 128         sleep 0.1;
 129         if ( $count++ > 100 ) {
 130             fail "Server restarted";
 131             SKIP: {
 132                 skip "Server didn't restart, no sense in checking response", 1;
 133             }
 134             next NO_RESTART_ON_ERROR;
 135         }
 136     };
 137
 138     pass "Server refused to restart";
 139
 140     if ( check_port( 'localhost', $port ) != 1 ) {
 141         die "Server appears to have died";
 142     }
 143     my $response = get("http://localhost:$port/action/default");
 144     like( $response, qr/Catalyst::Request/,
 145         'Syntax error, no restart, request OK' );
 146
 147     # give the server some time to reindex its files
 148     sleep 1;
 149
 150 }
 151
 152 # multiple restart directories
 153
 154 # we need different options so we have to rebuild most
 155 # of the testing environment
 156
 157 kill 'KILL', $pid;
 158 close $server;
 159
 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
 163
 164 $port += 1;
 165
 166 { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
 167 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
 168
 169 # change various files
 170 @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",
 173 );
 174
 175 my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
 176 my $restartdirs = join ' ', map{
 177     "-restartdirectory $app_root/lib/TestApp/Controller/$_"
 178 } qw/Action Engine/;
 179
 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 );
 186
 187
 188 # wait for it to start
 189 print "Waiting for server to start...\n";
 190 while ( check_port( 'localhost', $port ) != 1 ) {
 191     sleep 1;
 192 }
 193
 194 MULTI_DIR_RESTART:
 195 for ( 1 .. 20 ) {
 196     my $index = rand @files;
 197     open my $pm, '>>', $files[$index]
 198       or die "Unable to open $files[$index] for writing: $!";
 199     print $pm "\n";
 200     close $pm;
 201
 202     # give the server time to notice the change and restart
 203     my $count = 0;
 204     my $line;
 205
 206     while ( ( $line || '' ) !~ /can connect/ ) {
 207         # wait for restart message
 208         $line = $server->getline;
 209         sleep 0.1;
 210         if ( $count++ > 100 ) {
 211             fail "Server restarted";
 212             SKIP: {
 213                 skip "Server didn't restart, no sense in checking response", 1;
 214             }
 215             next MULTI_DIR_RESTART;
 216         }
 217     };
 218     pass "Server restarted with multiple restartdirs";
 219
 220     $count = 0;
 221     while ( check_port( 'localhost', $port ) != 1 ) {
 222         # wait for it to restart
 223         sleep 0.1;
 224         die "Server appears to have died" if $count++ > 100;
 225     }
 226     my $response = get("http://localhost:$port/action/default");
 227     like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );
 228
 229     # give the server some time to reindex its files
 230     sleep 1;
 231 }
 232
 233 # shut it down again
 234
 235 kill 'KILL', $pid;
 236 close $server;
 237
 238 # clean up
 239 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
 240
 241 sub check_port {
 242     my ( $host, $port ) = @_;
 243
 244     my $remote = IO::Socket::INET->new(
 245         Proto    => "tcp",
 246         PeerAddr => $host,
 247         PeerPort => $port
 248     );
 249     if ($remote) {
 250         close $remote;
 251         return 1;
 252     }
 253     else {
 254         return 0;
 255     }
 256 }