[Catalyst-commits] r10114 - in Catalyst-Devel/1.00/trunk: .
lib/Catalyst t t/lib t/lib/TestApp t/lib/TestApp/Controller
t/lib/TestApp/Controller/Subdir1 t/lib/TestApp/Controller/Subdir2
rafl at dev.catalyst.perl.org
rafl at dev.catalyst.perl.org
Wed May 13 18:03:45 GMT 2009
Author: rafl
Date: 2009-05-13 18:03:45 +0000 (Wed, 13 May 2009)
New Revision: 10114
Added:
Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm
Catalyst-Devel/1.00/trunk/t/lib/TestApp/
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Foo.pm
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Root.pm
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir1/
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir1/Foo.pm
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir2/
Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir2/Foo.pm
Catalyst-Devel/1.00/trunk/t/optional_http-server-restart.t
Modified:
Catalyst-Devel/1.00/trunk/Changes
Catalyst-Devel/1.00/trunk/Makefile.PL
Catalyst-Devel/1.00/trunk/lib/Catalyst/Devel.pm
Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm
Catalyst-Devel/1.00/trunk/t/03podcoverage.t
Log:
Merge branch 'improved-restarter'
Conflicts:
Changes
lib/Catalyst/Devel.pm
Modified: Catalyst-Devel/1.00/trunk/Changes
===================================================================
--- Catalyst-Devel/1.00/trunk/Changes 2009-05-13 17:41:21 UTC (rev 10113)
+++ Catalyst-Devel/1.00/trunk/Changes 2009-05-13 18:03:45 UTC (rev 10114)
@@ -4,6 +4,30 @@
as it should be -port|-p (t0m)
- Document -pidfile in myapp_server.pl POD (t0m)
+1.14_02 2009-05-11 04:29
+ - Small changes to work with File::ChangeNotify 0.03.
+
+1.14_01 2009-05-11 03:45
+ - This release moves the restarter functionality into a new
+ module Catalyst::Restarter, that is not a Catalyst Engine
+ subclass.
+
+ The new restarter is simpler and more reliable, because it
+ does not try to test if a changed piece of code can be
+ compiled. It simply restarts the server whenever it detects
+ changes. This also makes it much faster.
+
+ However, this does mean that the server can simply die when
+ a changed file cannot compile. This is different than the
+ old behavior, where the server remained running without
+ incorporating the change.
+
+ Finally, the new restarter relies on File::ChangeNotify,
+ which is designed to accomodate per-OS methods of detecting
+ changed files. As of this writing, it currently ships with a
+ file watcher that uses inotify on Linux systems, and a
+ default fallback class that does everything in pure Perl.
+
1.13 2009-05-11 02:50
- add [-pidfile|-p] option for myapp_server.pl (caelum)
- Bump dependency on Config::General (caelum)
Modified: Catalyst-Devel/1.00/trunk/Makefile.PL
===================================================================
--- Catalyst-Devel/1.00/trunk/Makefile.PL 2009-05-13 17:41:21 UTC (rev 10113)
+++ Catalyst-Devel/1.00/trunk/Makefile.PL 2009-05-13 18:03:45 UTC (rev 10114)
@@ -9,6 +9,7 @@
requires 'Catalyst::Plugin::ConfigLoader';
requires 'Class::Accessor::Fast';
requires 'Config::General' => '2.42'; # as of 1.07, we use .conf and not .yaml
+requires 'File::ChangeNotify' => '0.03';
requires 'File::Copy::Recursive';
requires 'Module::Install' => '0.64';
requires 'parent'; # as of 1.04
Modified: Catalyst-Devel/1.00/trunk/lib/Catalyst/Devel.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Devel.pm 2009-05-13 17:41:21 UTC (rev 10113)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Devel.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -3,9 +3,11 @@
use strict;
use warnings;
-our $VERSION = '1.13';
+our $VERSION = '1.14_02';
our $CATALYST_SCRIPT_GEN = 36;
+$VERSION = eval $VERSION;
+
=head1 NAME
Catalyst::Devel - Catalyst Development Tools
Modified: Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm 2009-05-13 17:41:21 UTC (rev 10113)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -969,13 +969,14 @@
my $port = $ENV{[% appenv %]_PORT} || $ENV{CATALYST_PORT} || 3000;
my $keepalive = 0;
my $restart = $ENV{[% appenv %]_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
-my $restart_delay = 1;
-my $restart_regex = '(?:/|^)(?!\.#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$';
-my $restart_directory = undef;
-my $follow_symlinks = 0;
my $background = 0;
my $pidfile = undef;
+my $check_interval;
+my $file_regex;
+my $watch_directory;
+my $follow_symlinks;
+
my @argv = @ARGV;
GetOptions(
@@ -986,9 +987,9 @@
'port=s' => \$port,
'keepalive|k' => \$keepalive,
'restart|r' => \$restart,
- 'restartdelay|rd=s' => \$restart_delay,
- 'restartregex|rr=s' => \$restart_regex,
- 'restartdirectory=s@' => \$restart_directory,
+ 'restartdelay|rd=s' => \$check_interval,
+ 'restartregex|rr=s' => \$file_regex,
+ 'restartdirectory=s@' => \$watch_directory,
'followsymlinks' => \$follow_symlinks,
'background' => \$background,
'pidfile=s' => \$pidfile,
@@ -996,30 +997,62 @@
pod2usage(1) if $help;
-if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
- $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
-}
if ( $debug ) {
$ENV{CATALYST_DEBUG} = 1;
}
-# This is require instead of use so that the above environment
-# variables can be set at runtime.
-require [% name %];
+# If we load this here, then in the case of a restarter, it does not
+# need to be reloaded for each restart.
+require Catalyst;
-[% name %]->run( $port, $host, {
- argv => \@argv,
- 'fork' => $fork,
- keepalive => $keepalive,
- restart => $restart,
- restart_delay => $restart_delay,
- restart_regex => qr/$restart_regex/,
- restart_directory => $restart_directory,
- follow_symlinks => $follow_symlinks,
- background => $background,
- pidfile => $pidfile,
-} );
+# If this isn't done, then the Catalyst::Devel tests for the restarter
+# fail.
+$| = 1 if $ENV{HARNESS_ACTIVE};
+my $runner = sub {
+ # This is require instead of use so that the above environment
+ # variables can be set at runtime.
+ require [% name %];
+
+ [% name %]->run(
+ $port, $host,
+ {
+ argv => \@argv,
+ 'fork' => $fork,
+ keepalive => $keepalive,
+ background => $background,
+ pidfile => $pidfile,
+ }
+ );
+};
+
+if ( $restart ) {
+ require Catalyst::Restarter;
+
+ die "Cannot run in the background and also watch for changed files.\n"
+ if $background;
+
+ my %args;
+ $args{follow_symlinks} = 1
+ if $follow_symlinks;
+ $args{directories} = $watch_directory
+ if defined $watch_directory;
+ $args{sleep_interval} = $check_interval
+ if defined $check_interval;
+ $args{filter} = qr/$file_regex/
+ if defined $file_regex;
+
+ my $restarter = Catalyst::Restarter->new(
+ %args,
+ start_sub => $runner,
+ );
+
+ $restarter->run_and_watch;
+}
+else {
+ $runner->();
+}
+
1;
=head1 NAME
@@ -1041,6 +1074,7 @@
-r -restart restart when files get modified
(defaults to false)
-rd -restartdelay delay between file checks
+ (ignored if you have Linux::Inotify2 installed)
-rr -restartregex regex match files that trigger
a restart when modified
(defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
Added: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,168 @@
+package Catalyst::Restarter;
+
+use Moose;
+
+use Cwd qw( abs_path );
+use File::ChangeNotify;
+use FindBin;
+use namespace::clean -except => 'meta';
+
+has start_sub => (
+ is => 'ro',
+ isa => 'CodeRef',
+ required => 1,
+);
+
+has _watcher => (
+ is => 'rw',
+ isa => 'File::ChangeNotify::Watcher',
+);
+
+has _child => (
+ is => 'rw',
+ isa => 'Int',
+);
+
+sub BUILD {
+ my $self = shift;
+ my $p = shift;
+
+ delete $p->{start_sub};
+
+ $p->{filter} ||= qr/(?:\/|^)(?!\.\#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
+ $p->{directories} ||= abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) );
+
+ # We could make this lazily, but this lets us check that we
+ # received valid arguments for the watcher up front.
+ $self->_watcher( File::ChangeNotify->instantiate_watcher( %{$p} ) );
+}
+
+sub run_and_watch {
+ my $self = shift;
+
+ $self->_fork_and_start;
+
+ return unless $self->_child;
+
+ $self->_restart_on_changes;
+}
+
+sub _fork_and_start {
+ my $self = shift;
+
+ if ( my $pid = fork ) {
+ $self->_child($pid);
+ }
+ else {
+ $self->start_sub->();
+ }
+}
+
+sub _restart_on_changes {
+ my $self = shift;
+
+ my @events = $self->_watcher->wait_for_events();
+ $self->_handle_events(@events);
+}
+
+sub _handle_events {
+ my $self = shift;
+ my @events = @_;
+
+ print STDERR "\n";
+ print STDERR "Saw changes to the following files:\n";
+
+ for my $event (@events) {
+ my $path = $event->path();
+ my $type = $event->type();
+
+ print STDERR " - $path ($type)\n";
+ }
+
+ print STDERR "\n";
+ print STDERR "Attempting to restart the server\n\n";
+
+ $self->_kill_child;
+
+ $self->_fork_and_start;
+
+ $self->_restart_on_changes;
+}
+
+sub _kill_child {
+ my $self = shift;
+
+ return unless $self->_child;
+
+ return unless kill 0, $self->_child;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ( kill 'INT', $self->_child ) {
+ # The kill 0 thing does not work on Windows, but the restarter
+ # seems to work fine on Windows with this hack.
+ return if $^O eq 'MSWin32';
+ die "Cannot send INT signal to ", $self->_child, ": $!";
+ }
+}
+
+sub DEMOLISH {
+ my $self = shift;
+
+ $self->_kill_child;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and restart the server
+
+=head1 SYNOPSIS
+
+ my $restarter = Catalyst::Restarter->new(
+ directories => '/path/to/MyApp',
+ regex => '\.yml$|\.yaml$|\.conf|\.pm$',
+ start_sub => sub { ... }
+ );
+
+ $restarter->run_and_watch;
+
+=head1 DESCRIPTION
+
+This class uses L<File::ChangeNotify> to watch one or more directories
+of files and restart the Catalyst server when any of those files
+changes.
+
+=head1 METHODS
+
+=head2 new ( start_sub => sub { ... }, ... )
+
+This method creates a new restarter object.
+
+The "start_sub" argument is required. This is a subroutine reference
+that can be used to start the Catalyst server.
+
+=head2 run_and_watch
+
+This method forks, starts the server in a child process, and then
+watched for changed files in the parent. When files change, it kills
+the child, forks again, and starts a new server.
+
+=head1 SEE ALSO
+
+L<Catalyst>, <File::ChangeNotify>
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Modified: Catalyst-Devel/1.00/trunk/t/03podcoverage.t
===================================================================
--- Catalyst-Devel/1.00/trunk/t/03podcoverage.t 2009-05-13 17:41:21 UTC (rev 10113)
+++ Catalyst-Devel/1.00/trunk/t/03podcoverage.t 2009-05-13 18:03:45 UTC (rev 10114)
@@ -4,4 +4,4 @@
plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD};
-all_pod_coverage_ok();
+all_pod_coverage_ok( { trustme => [ qr/^(?:BUILD|DEMOLISH)$/ ] } );
Added: Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Foo.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Foo.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,5 @@
+package TestApp::Controller::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+no Moose;
+__PACKAGE__->meta->make_immutable;
Added: Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Root.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Root.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,61 @@
+package TestApp::Controller::Root;
+
+use strict;
+use warnings;
+use parent 'Catalyst::Controller';
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+TestApp::Controller::Root - Root Controller for TestApp
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 METHODS
+
+=cut
+
+=head2 index
+
+=cut
+
+sub index :Path :Args(0) {
+ my ( $self, $c ) = @_;
+
+ # Hello World
+ $c->response->body( $c->welcome_message );
+}
+
+sub default :Path {
+ my ( $self, $c ) = @_;
+ $c->response->body( 'Page not found' );
+ $c->response->status(404);
+}
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+Dave Rolsky,,,
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;
Added: Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir1/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir1/Foo.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir1/Foo.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,4 @@
+package TestApp::Controller::Subdir1::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;
Added: Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir2/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir2/Foo.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/t/lib/TestApp/Controller/Subdir2/Foo.pm 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,4 @@
+package TestApp::Controller::Subdir2::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;
Added: Catalyst-Devel/1.00/trunk/t/optional_http-server-restart.t
===================================================================
--- Catalyst-Devel/1.00/trunk/t/optional_http-server-restart.t (rev 0)
+++ Catalyst-Devel/1.00/trunk/t/optional_http-server-restart.t 2009-05-13 18:03:45 UTC (rev 10114)
@@ -0,0 +1,264 @@
+# XXX - These tests seem to be somewhat flaky and timing-dependent. I
+# have seen them all run to completion, and I've seen them fail
+# partway through. If someone can come up with a better way to test
+# this stuff that'd be great.
+
+use strict;
+use warnings;
+
+use Test::More;
+BEGIN {
+ plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
+}
+
+use File::Copy qw( copy );
+use File::Path;
+use FindBin;
+use LWP::Simple;
+use IO::Socket;
+use IPC::Open3;
+use Time::HiRes qw/sleep/;
+use Catalyst::Helper;
+eval "use Catalyst::Devel 1.04;";
+
+plan skip_all => 'Catalyst::Devel >= 1.04 required' if $@;
+eval "use File::Copy::Recursive";
+plan skip_all => 'File::Copy::Recursive required' if $@;
+
+plan tests => 35;
+
+my $tmpdir = "$FindBin::Bin/../t/tmp";
+
+# clean up
+rmtree $tmpdir if -d $tmpdir;
+
+# create a TestApp and copy the test libs into it
+mkdir $tmpdir;
+chdir $tmpdir;
+
+my $helper = Catalyst::Helper->new(
+ {
+ '.newfiles' => 1,
+ }
+);
+
+$helper->mk_app('TestApp');
+
+chdir "$FindBin::Bin/..";
+
+copy_test_app();
+
+# remove TestApp's tests
+rmtree 't/tmp/TestApp/t';
+
+# spawn the standalone HTTP server
+my $port = 30000 + int rand( 1 + 10000 );
+
+my ( $pid, $server ) = start_server($port);
+
+# change various files
+my @files = (
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Foo.pm",
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Root.pm",
+);
+
+# change some files and make sure the server restarts itself
+NON_ERROR_RESTART:
+for ( 1 .. 5 ) {
+ my $index = rand @files;
+ open my $pm, '>>', $files[$index]
+ or die "Unable to open $files[$index] for writing: $!";
+ print $pm "\n";
+ close $pm;
+
+ if ( ! look_for_restart() ) {
+ SKIP:
+ {
+ skip "Server did not restart, no sense in checking further", 1;
+ }
+ next NON_ERROR_RESTART;
+ }
+
+ my $response = get("http://localhost:$port/");
+ like( $response, qr/Welcome to the world of Catalyst/,
+ 'Non-error restart, request OK' );
+}
+
+# add errors to the file and make sure server does die
+DIES_ON_ERROR:
+for ( 1 .. 5 ) {
+ my $index = rand @files;
+ open my $pm, '>>', $files[$index]
+ or die "Unable to open $files[$index] for writing: $!";
+ print $pm "bleh";
+ close $pm;
+
+ if ( ! look_for_death() ) {
+ SKIP:
+ {
+ skip "Server restarted, no sense in checking further", 2;
+ }
+ next DIES_ON_ERROR;
+ }
+ copy_test_app();
+
+ if ( ! look_for_restart() ) {
+ SKIP:
+ {
+ skip "Server did not restart, no sense in checking further", 1;
+ }
+ next DIES_ON_ERROR;
+ }
+
+ my $response = get("http://localhost:$port/");
+ like( $response, qr/Welcome to the world of Catalyst/,
+ 'Non-error restart after death, request OK' );
+}
+
+# multiple restart directories
+
+# we need different options so we have to rebuild most
+# of the testing environment
+
+kill 'KILL', $pid or die "Cannot kill $pid: $!";
+close $server or die "Cannot close handle to server process: $!";
+wait;
+
+# 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;
+
+copy_test_app();
+
+ at files = (
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Subdir1/Foo.pm",
+ "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Subdir2/Foo.pm",
+);
+
+my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
+my $restartdirs = join ' ', map{
+ "-restartdirectory $app_root/lib/TestApp/Controller/Subdir$_"
+} 1, 2;
+
+( $pid, $server ) = start_server($port);
+
+MULTI_DIR_RESTART:
+for ( 1 .. 5 ) {
+ my $index = rand @files;
+ open my $pm, '>>', $files[$index]
+ or die "Unable to open $files[$index] for writing: $!";
+ print $pm "\n";
+ close $pm;
+
+ if ( ! look_for_restart() ) {
+ SKIP:
+ {
+ skip "Server did not restart, no sense in checking further", 1;
+ }
+ next MULTI_DIR_RESTART;
+ }
+
+ my $response = get("http://localhost:$port/");
+ like( $response, qr/Welcome to the world of Catalyst/,
+ 'Non-error restart with multiple watched dirs' );
+}
+
+kill 'KILL', $pid;
+close $server;
+wait;
+
+rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+
+sub copy_test_app {
+ { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
+ copy( 't/lib/TestApp.pm', 't/tmp/TestApp/lib/TestApp.pm' );
+ File::Copy::Recursive::dircopy( 't/lib/TestApp', 't/tmp/TestApp/lib/TestApp' );
+}
+
+sub start_server {
+ my $port = shift;
+
+ my $server;
+ my $pid = open3(
+ undef, $server, undef,
+ $^X, "-I$FindBin::Bin/../lib",
+ "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
+ $port, '-restart'
+ ) 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);
+
+ my $waited = 0;
+
+ diag('Waiting for server to start...');
+ while ( check_port( 'localhost', $port ) != 1 ) {
+ sleep 1;
+ $waited++;
+
+ if ( $waited >= 10 ) {
+ BAIL_OUT('Waited 10 seconds for server to start, to no avail');
+ }
+ }
+
+ return ($pid, $server);
+}
+
+sub check_port {
+ my ( $host, $port ) = @_;
+
+ my $remote = IO::Socket::INET->new(
+ Proto => "tcp",
+ PeerAddr => $host,
+ PeerPort => $port
+ );
+ if ($remote) {
+ close $remote;
+ return 1;
+ }
+ else {
+ return 0;
+ }
+}
+
+sub look_for_restart {
+ # give the server time to notice the change and restart
+ my $count = 0;
+ my $line;
+
+ while ( ( $line || '' ) !~ /can connect/ ) {
+ $line = $server->getline;
+ sleep 0.1;
+ if ( $count++ > 300 ) {
+ fail "Server restarted";
+ return 0;
+ }
+ };
+
+ pass "Server restarted";
+
+ return 1;
+}
+
+sub look_for_death {
+ # give the server time to notice the change and restart
+ my $count = 0;
+ my $line;
+
+ while ( ( $line || '' ) !~ /failed/ ) {
+ $line = $server->getline;
+ sleep 0.1;
+ if ( $count++ > 300 ) {
+ fail "Server died";
+ return 0;
+ }
+ };
+
+ pass "Server died";
+
+ return 1;
+}
More information about the Catalyst-commits
mailing list