t/optional_http-server-restart.t

   1 #!perl\r
   2 \r
   3 # This test tests the standalone server's auto-restart feature.\r
   4 \r
   5 use strict;\r
   6 use warnings;\r
   7 \r
   8 use File::Path;\r
   9 use FindBin;\r
  10 use LWP::Simple;\r
  11 use IO::Socket;\r
  12 use Test::More;\r
  13 use Time::HiRes qw/sleep/;\r
  14 eval "use Catalyst::Devel 1.0;";\r
  15 \r
  16 plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};\r
  17 plan skip_all => 'Catalyst::Devel required' if $@;\r
  18 eval "use File::Copy::Recursive";\r
  19 plan skip_all => 'File::Copy::Recursive required' if $@;\r
  20 \r
  21 plan tests => 40;\r
  22 \r
  23 # clean up\r
  24 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";\r
  25 \r
  26 # create a TestApp and copy the test libs into it\r
  27 mkdir "$FindBin::Bin/../t/tmp";\r
  28 chdir "$FindBin::Bin/../t/tmp";\r
  29 system\r
  30   "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp";\r
  31 chdir "$FindBin::Bin/..";\r
  32 File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );\r
  33 \r
  34 # remove TestApp's tests\r
  35 rmtree 't/tmp/TestApp/t';\r
  36 \r
  37 # spawn the standalone HTTP server\r
  38 my $port = 30000 + int rand( 1 + 10000 );\r
  39 my $pid  = open my $server,\r
  40 "perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |"\r
  41   or die "Unable to spawn standalone HTTP server: $!";\r
  42 \r
  43 # wait for it to start\r
  44 print "Waiting for server to start...\n";\r
  45 while ( check_port( 'localhost', $port ) != 1 ) {\r
  46     sleep 1;\r
  47 }\r
  48 \r
  49 # change various files\r
  50 my @files = (\r
  51     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",\r
  52     "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm",\r
  53 "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm",\r
  54 );\r
  55 \r
  56 # change some files and make sure the server restarts itself\r
  57 for ( 1 .. 20 ) {\r
  58     my $index = rand @files;\r
  59     open my $pm, '>>', $files[$index]\r
  60       or die "Unable to open $files[$index] for writing: $!";\r
  61     print $pm "\n";\r
  62     close $pm;\r
  63 \r
  64     # give the server time to notice the change and restart\r
  65     my $count = 0;\r
  66     sleep 1;\r
  67     while ( check_port( 'localhost', $port ) != 1 ) {\r
  68 \r
  69         # wait for it to restart\r
  70         sleep 0.1;\r
  71         die "Server appears to have died" if $count++ > 50;\r
  72     }\r
  73     my $response = get("http://localhost:$port/action/default");\r
  74     like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' );\r
  75 \r
  76     #print $server->getline;\r
  77 }\r
  78 \r
  79 # add errors to the file and make sure server does not die or restart\r
  80 for ( 1 .. 20 ) {\r
  81     my $index = rand @files;\r
  82     open my $pm, '>>', $files[$index]\r
  83       or die "Unable to open $files[$index] for writing: $!";\r
  84     print $pm "bleh";\r
  85     close $pm;\r
  86 \r
  87     # give the server time to notice the change\r
  88     sleep 1;\r
  89     if ( check_port( 'localhost', $port ) != 1 ) {\r
  90         die "Server appears to have died";\r
  91     }\r
  92     my $response = get("http://localhost:$port/action/default");\r
  93     like( $response, qr/Catalyst::Request/,\r
  94         'Syntax error, no restart, request OK' );\r
  95 \r
  96     #print $server->getline;\r
  97 }\r
  98 \r
  99 # shut it down\r
 100 kill 'INT', $pid;\r
 101 close $server;\r
 102 \r
 103 # clean up\r
 104 rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";\r
 105 \r
 106 sub check_port {\r
 107     my ( $host, $port ) = @_;\r
 108 \r
 109     my $remote = IO::Socket::INET->new(\r
 110         Proto    => "tcp",\r
 111         PeerAddr => $host,\r
 112         PeerPort => $port\r
 113     );\r
 114     if ($remote) {\r
 115         close $remote;\r
 116         return 1;\r
 117     }\r
 118     else {\r
 119         return 0;\r
 120     }\r
 121 }\r