From: Brian Cassidy Date: Fri, 14 Sep 2007 12:38:23 +0000 (+0000) Subject: restarting engine fixes from willert X-Git-Tag: 5.7099_04~135 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=9c71d51daf53bfd6f77d7e252b594392bd4be3de restarting engine fixes from willert --- diff --git a/Changes b/Changes index 67be1e7..756b1a5 100644 --- a/Changes +++ b/Changes @@ -1,6 +1,10 @@ # This file documents the revision history for Perl extension Catalyst. 5.7011 + - Allow multiple restart directories and added option to follow + symlinks in the HTTP::Restarter engine (Sebastian Willert) + - Fixed t/optional_http-server-restart.t so it actually tests + if the server restarted or notified of an error (Sebastian Willert) - Patch for emacs temp files with module::pluggable::object. (Dave Rolsky) - Return child PID from the HTTP engine when run with the 'background' option. (Emanuele Zeppieri) diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 06bcf09..0e9ebc2 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -2381,6 +2381,8 @@ Sam Vilain Sascha Kiefer +Sebastian Willert + Tatsuhiko Miyagawa Ulf Edvinsson diff --git a/lib/Catalyst/Engine/HTTP/Restarter.pm b/lib/Catalyst/Engine/HTTP/Restarter.pm index 30cb9e4..02c58ba 100644 --- a/lib/Catalyst/Engine/HTTP/Restarter.pm +++ b/lib/Catalyst/Engine/HTTP/Restarter.pm @@ -23,6 +23,7 @@ sub run { $options->{restart_directory} || File::Spec->catdir( $FindBin::Bin, '..' ) ), + follow_symlinks => $options->{follow_symlinks}, regex => $options->{restart_regex}, delay => $options->{restart_delay}, ); diff --git a/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm b/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm index c013450..b45c3da 100644 --- a/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm +++ b/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm @@ -13,6 +13,7 @@ __PACKAGE__->mk_accessors( directory modified regex + follow_symlinks watch_list/ ); @@ -102,7 +103,9 @@ sub watch { sub _index_directory { my $self = shift; - my $dir = $self->directory || die "No directory specified"; + my $dir = $self->directory; + die "No directory specified" if !$dir or ref($dir) && !@{$dir}; + my $regex = $self->regex || '\.pm$'; my %list; @@ -120,9 +123,10 @@ sub _index_directory { $cur_dir =~ s{/script/..}{}; $list{$cur_dir} = 1; }, + follow_fast => $self->follow_symlinks ? 1 : 0, no_chdir => 1 }, - $dir + ref $dir eq 'ARRAY' ? @{$dir} : $dir ); return \%list; } diff --git a/t/optional_http-server-restart.t b/t/optional_http-server-restart.t index 7193a53..10e8a60 100644 --- a/t/optional_http-server-restart.t +++ b/t/optional_http-server-restart.t @@ -15,10 +15,11 @@ eval "use Catalyst::Devel 1.0;"; plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP}; plan skip_all => 'Catalyst::Devel required' if $@; +plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03; eval "use File::Copy::Recursive"; plan skip_all => 'File::Copy::Recursive required' if $@; -plan tests => 40; +plan tests => 120; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; @@ -36,10 +37,16 @@ rmtree 't/tmp/TestApp/t'; # spawn the standalone HTTP server my $port = 30000 + int rand( 1 + 10000 ); + my $pid = open my $server, "perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |" or die "Unable to spawn standalone HTTP server: $!"; +# switch to non-blocking reads so we can fail +# gracefully instead of just hanging forever + +$server->blocking( 0 ); + # wait for it to start print "Waiting for server to start...\n"; while ( check_port( 'localhost', $port ) != 1 ) { @@ -54,6 +61,7 @@ my @files = ( ); # change some files and make sure the server restarts itself +NON_ERROR_RESTART: for ( 1 .. 20 ) { my $index = rand @files; open my $pm, '>>', $files[$index] @@ -63,20 +71,37 @@ for ( 1 .. 20 ) { # give the server time to notice the change and restart my $count = 0; - sleep 1; - while ( check_port( 'localhost', $port ) != 1 ) { + my $line; + while ( ( $line || '' ) !~ /can connect/ ) { + # wait for restart message + $line = $server->getline; + sleep 0.1; + if ( $count++ > 100 ) { + fail "Server restarted"; + SKIP: { + skip "Server didn't restart, no sense in checking response", 1; + } + next NON_ERROR_RESTART; + } + }; + pass "Server restarted"; + + $count = 0; + while ( check_port( 'localhost', $port ) != 1 ) { # wait for it to restart sleep 0.1; - die "Server appears to have died" if $count++ > 50; + die "Server appears to have died" if $count++ > 100; } my $response = get("http://localhost:$port/action/default"); like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); - #print $server->getline; + # give the server some time to reindex its files + sleep 1; } # add errors to the file and make sure server does not die or restart +NO_RESTART_ON_ERROR: for ( 1 .. 20 ) { my $index = rand @files; open my $pm, '>>', $files[$index] @@ -84,8 +109,24 @@ for ( 1 .. 20 ) { print $pm "bleh"; close $pm; - # give the server time to notice the change - sleep 1; + my $count = 0; + my $line; + + while ( ( $line || '' ) !~ /failed/ ) { + # wait for restart message + $line = $server->getline; + sleep 0.1; + if ( $count++ > 100 ) { + fail "Server restarted"; + SKIP: { + skip "Server didn't restart, no sense in checking response", 1; + } + next NO_RESTART_ON_ERROR; + } + }; + + pass "Server refused to restart"; + if ( check_port( 'localhost', $port ) != 1 ) { die "Server appears to have died"; } @@ -93,11 +134,93 @@ for ( 1 .. 20 ) { like( $response, qr/Catalyst::Request/, 'Syntax error, no restart, request OK' ); - #print $server->getline; + # give the server some time to reindex its files + sleep 1; + } -# shut it down -kill 'INT', $pid; +# multiple restart directories + +# we need different options so we have to rebuild most +# of the testing environment + +kill 'KILL', $pid; +close $server; + +# pick next port because the last one might still be blocked from +# previous server. This might fail if this port is unavailable +# but picking the first one has the same problem so this is acceptable + +$port += 1; + +{ no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; } +File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); + +# change various files +@files = ( + "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", + "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Engine/Request/URI.pm", +); + +my $app_root = "$FindBin::Bin/../t/tmp/TestApp"; +my $restartdirs = join ' ', map{ + "-restartdirectory $app_root/lib/TestApp/Controller/$_" +} qw/Action Engine/; + +$pid = open $server, +"perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart $restartdirs 2>&1 |" + or die "Unable to spawn standalone HTTP server: $!"; +$server->blocking( 0 ); + + +# wait for it to start +print "Waiting for server to start...\n"; +while ( check_port( 'localhost', $port ) != 1 ) { + sleep 1; +} + +MULTI_DIR_RESTART: +for ( 1 .. 20 ) { + my $index = rand @files; + open my $pm, '>>', $files[$index] + or die "Unable to open $files[$index] for writing: $!"; + print $pm "\n"; + close $pm; + + # give the server time to notice the change and restart + my $count = 0; + my $line; + + while ( ( $line || '' ) !~ /can connect/ ) { + # wait for restart message + $line = $server->getline; + sleep 0.1; + if ( $count++ > 100 ) { + fail "Server restarted"; + SKIP_NO_RESTART_2: { + skip "Server didn't restart, no sense in checking response", 1; + } + next MULTI_DIR_RESTART; + } + }; + pass "Server restarted with multiple restartdirs"; + + $count = 0; + while ( check_port( 'localhost', $port ) != 1 ) { + # wait for it to restart + sleep 0.1; + die "Server appears to have died" if $count++ > 100; + } + my $response = get("http://localhost:$port/action/default"); + like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); + + # give the server some time to reindex its files + sleep 1; +} + +# shut it down again + +kill 'KILL', $pid; close $server; # clean up