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 $check_interval;
+my $file_regex;
+my $watch_directory;
+my $follow_symlinks;
+
my @argv = @ARGV;
GetOptions(
'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,
);
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 %];
-
-[% 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,
-} );
+# If we load this here, then in the case of a restarter, it does not
+# need to be reloaded for each restart.
+require Catalyst;
+
+# 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,
+ }
+ );
+};
+
+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{interval} = $check_interval
+ if defined $check_interval;
+ $args{regex} = qr/$file_regex/
+ if defined $file_regex;
+
+ my $restarter = Catalyst::Restarter->new(
+ %args,
+ restart_sub => $runner,
+ );
+
+ $restarter->run_and_watch;
+}
+else {
+ $runner->();
+}
1;
-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$')
--- /dev/null
+package Catalyst::Restarter;
+
+use Moose;
+
+use Catalyst::Watcher;
+use namespace::clean -except => 'meta';
+
+has restart_sub => (
+ is => 'ro',
+ isa => 'CodeRef',
+ required => 1,
+);
+
+has _watcher => (
+ is => 'rw',
+ isa => 'Catalyst::Watcher',
+);
+
+has _child => (
+ is => 'rw',
+ isa => 'Int',
+);
+
+sub BUILD {
+ my $self = shift;
+ my $p = shift;
+
+ delete $p->{restart_sub};
+
+ # We could make this lazily, but this lets us check that we
+ # received valid arguments for the watcher up front.
+ $self->_watcher( Catalyst::Watcher->instantiate_subclass( %{$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->restart_sub->();
+ }
+}
+
+sub _restart_on_changes {
+ my $self = shift;
+
+ $self->_watcher->watch($self);
+}
+
+sub handle_changes {
+ my $self = shift;
+ my @files = @_;
+
+ print STDERR "\n";
+ print STDERR "Saw changes to the following files:\n";
+ print STDERR " - $_->{file} ($_->{status})\n" for @files;
+ 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 Catalyst::Watcher to check for changed files and restart the server
+
+=head1 SYNOPSIS
+
+ my $watcher = Catalyst::Watcher->new(
+ directory => '/path/to/MyApp',
+ regex => '\.yml$|\.yaml$|\.conf|\.pm$',
+ interval => 3,
+ );
+
+ while (1) {
+ my @changed_files = $watcher->watch();
+ }
+
+=head1 DESCRIPTION
+
+This class monitors a directory of files for changes made to any file
+matching a regular expression. It correctly handles new files added to the
+application as well as files that are deleted.
+
+=head1 METHODS
+
+=head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
+
+Creates a new Watcher object.
+
+=head2 find_changed_files
+
+Returns a list of files that have been added, deleted, or changed
+since the last time watch was called. Each element returned is a hash
+reference with two keys. The C<file> key contains the filename, and
+the C<status> key contains one of "modified", "added", or "deleted".
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Restarter>, <File::Modified>
+
+=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
--- /dev/null
+package Catalyst::Watcher;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+use Cwd qw( abs_path );
+use File::Spec;
+use FindBin;
+use namespace::clean -except => 'meta';
+
+has regex => (
+ is => 'ro',
+ isa => 'RegexpRef',
+ default => sub { qr/(?:\/|^)(?!\.\#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/ },
+);
+
+my $dir = subtype
+ as 'Str'
+ => where { -d $_ }
+ => message { "$_ is not a valid directory" };
+
+my $array_of_dirs = subtype
+ as 'ArrayRef[Str]',
+ => where { map { -d } @{$_} }
+ => message { "@{$_} is not a list of valid directories" };
+
+coerce $array_of_dirs
+ => from $dir
+ => via { [ $_ ] };
+
+has directories => (
+ is => 'ro',
+ isa => $array_of_dirs,
+ default => sub { [ abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) ) ] },
+ coerce => 1,
+);
+
+has follow_symlinks => (
+ is => 'ro',
+ isa => 'Bool',
+ default => 0,
+);
+
+sub instantiate_subclass {
+ my $class = shift;
+
+ if ( eval { require Catalyst::Watcher::Inotify; 1; } ) {
+ return Catalyst::Watcher::Inotify->new(@_);
+ }
+ else {
+ require Catalyst::Watcher::FileModified;
+ return Catalyst::Watcher::FileModified->new(@_);
+ }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
--- /dev/null
+package Catalyst::Watcher::FileModified;
+
+use Moose;
+
+use File::Find;
+use File::Modified;
+use File::Spec;
+use Time::HiRes qw/sleep/;
+use namespace::clean -except => 'meta';
+
+extends 'Catalyst::Watcher';
+
+has interval => (
+ is => 'ro',
+ isa => 'Int',
+ default => 1,
+);
+
+has _watched_files => (
+ is => 'ro',
+ isa => 'HashRef[Str]',
+ lazy_build => 1,
+ clearer => '_clear_watched_files',
+);
+
+has _modified => (
+ is => 'rw',
+ isa => 'File::Modified',
+ lazy_build => 1,
+ clearer => '_clear_modified',
+);
+
+
+sub _build__watched_files {
+ my $self = shift;
+
+ my $regex = $self->regex;
+
+ my %list;
+ finddepth(
+ {
+ wanted => sub {
+ my $path = File::Spec->rel2abs($File::Find::name);
+ return unless $path =~ /$regex/;
+ return unless -f $path;
+
+ $list{$path} = 1;
+
+ # also watch the directory for changes
+ my $cur_dir = File::Spec->rel2abs($File::Find::dir);
+ $cur_dir =~ s{/script/..}{};
+ $list{$cur_dir} = 1;
+ },
+ follow_fast => $self->follow_symlinks ? 1 : 0,
+ no_chdir => 1
+ },
+ @{ $self->directories }
+ );
+
+ return \%list;
+}
+
+sub _build__modified {
+ my $self = shift;
+
+ return File::Modified->new(
+ method => 'mtime',
+ files => [ keys %{ $self->_watched_files } ],
+ );
+}
+
+sub watch {
+ my $self = shift;
+ my $restarter = shift;
+
+ while (1) {
+ sleep $self->interval if $self->interval > 0;
+
+ my @changes = $self->_changed_files;
+
+ next unless @changes;
+
+ $restarter->handle_changes(@changes);
+
+ last;
+ }
+}
+
+sub _changed_files {
+ my $self = shift;
+
+ my @changes;
+
+ eval {
+ @changes = map { { file => $_, status => 'modified' } }
+ grep { -f $_ } $self->_modified->changed;
+ };
+
+ if ($@) {
+ # File::Modified will die if a file is deleted.
+ die unless $@ =~ /stat '(.+)'/;
+
+ push @changes, {
+ file => $1 || 'unknown file',
+ status => 'deleted',
+ };
+
+ $self->_clear_watched_files;
+ $self->_clear_modified;
+ }
+ else {
+ $self->_modified->update;
+
+ my $old_watch = $self->_watched_files;
+
+ $self->_clear_watched_files;
+
+ my $new_watch = $self->_watched_files;
+
+ my @new_files = grep { !defined $old_watch->{$_} }
+ grep {-f}
+ keys %{$new_watch};
+
+ if (@new_files) {
+ $self->_clear_modified;
+ push @changes, map { { file => $_, status => 'added' } } @new_files;
+ }
+ }
+
+ return @changes;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Watcher::FileModified - Watch for changed application files using File::Modified
+
+=head1 SYNOPSIS
+
+ my $watcher = Catalyst::Watcher::FileModified->new(
+ directories => '/path/to/MyApp',
+ regex => '\.yml$|\.yaml$|\.conf|\.pm$',
+ );
+
+ while (1) {
+ my @changed_files = $watcher->watch();
+ ...
+ }
+
+=head1 DESCRIPTION
+
+This class monitors a directory of files for changes made to any file
+matching a regular expression. It correctly handles new files added to the
+application as well as files that are deleted.
+
+=head1 METHODS
+
+=head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
+
+Creates a new Watcher object.
+
+=head2 find_changed_files
+
+Returns a list of files that have been added, deleted, or changed
+since the last time watch was called. Each element returned is a hash
+reference with two keys. The C<file> key contains the filename, and
+the C<status> key contains one of "modified", "added", or "deleted".
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Watcher>, L<Catalyst::Restarter>,
+<File::Modified>
+
+=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
--- /dev/null
+package Catalyst::Watcher::Inotify;
+
+use Moose;
+
+use Linux::Inotify2;
+use namespace::clean -except => 'meta';
+
+extends 'Catalyst::Watcher';
+
+has _inotify => (
+ is => 'rw',
+ isa => 'Linux::Inotify2',
+ lazy_build => 1,
+);
+
+has _mask => (
+ is => 'rw',
+ isa => 'Int',
+ lazy_build => 1,
+);
+
+sub watch {
+ my $self = shift;
+ my $restarter = shift;
+
+ my @events = $self->_wait_for_events;
+
+ $restarter->handle_changes( map { $self->_event_to_change($_) } @events );
+
+ return;
+}
+
+sub _wait_for_events {
+ my $self = shift;
+
+ while (1) {
+ # This is a blocking read, so it will not return until
+ # something happens. The restarter will end up calling ->watch
+ # again after handling the changes.
+ my @events = $self->_inotify->read;
+
+ my @interesting;
+ for my $event ( grep { $_->mask | IN_ISDIR } @events ) {
+ if ( $event->mask | IM_CREATE ) {
+ $self->_add_directory( $event->fullname );
+ push @interesting, $event;
+ }
+ elsif ( $event->mask | IM_DELETE_SELF ) {
+ $event->w->cancel;
+ push @interesting, $event;
+ }
+ elsif ( $event->name =~ /$regex/ ) {
+ push @interesting, $event;
+ }
+ }
+
+ return @interesting if @interesting;
+ }
+}
+
+sub _build__inotify {
+ my $self = shift;
+
+ my $inotify = Linux::Inotify2->new();
+
+ $self->_add_directory($_) for @{ $self->directories };
+
+ return $inotify;
+}
+
+sub _build__mask {
+ my $self = shift;
+
+ my $mask = IN_MODIFY | IN_CREATE | IN_DELETE | IN_DELETE_SELF | IN_MOVE_SELF;
+ $mask |= IN_DONT_FOLLOW unless $self->follow_symlinks;
+
+ return $mask;
+}
+
+sub _add_directory {
+ my $self = shift;
+ my $dir = shift;
+
+ finddepth(
+ {
+ wanted => sub {
+ my $path = File::Spec->rel2abs($File::Find::name);
+ return unless -d $path;
+
+ $self->_inotify->watch( $path, $self->_mask );
+ },
+ follow_fast => $self->follow_symlinks ? 1 : 0,
+ no_chdir => 1
+ },
+ $dir;
+ );
+}
+
+sub _event_to_change {
+ my $self = shift;
+ my $event = shift;
+
+ my %change = { file => $event->fullname };
+ if ( $event->mask() | IN_CREATE || $event->mask() ) {
+ $change{status} = 'added';
+ }
+ elsif ( $event->mask() | IN_MODIFY ) {
+ $change{status} = 'modified';
+ }
+ elsif ( $event->mask() | IN_DELETE || $event->mask() ) {
+ $change{status} = 'deleted';
+ }
+ else {
+ $change{status} = 'containing directory modified';
+ }
+
+ return \%change;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Watcher - Watch for changed application files
+
+=head1 SYNOPSIS
+
+ my $watcher = Catalyst::Watcher->new(
+ directory => '/path/to/MyApp',
+ regex => '\.yml$|\.yaml$|\.conf|\.pm$',
+ interval => 3,
+ );
+
+ while (1) {
+ my @changed_files = $watcher->watch();
+ }
+
+=head1 DESCRIPTION
+
+This class monitors a directory of files for changes made to any file
+matching a regular expression. It correctly handles new files added to the
+application as well as files that are deleted.
+
+=head1 METHODS
+
+=head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
+
+Creates a new Watcher object.
+
+=head2 find_changed_files
+
+Returns a list of files that have been added, deleted, or changed
+since the last time watch was called. Each element returned is a hash
+reference with two keys. The C<file> key contains the filename, and
+the C<status> key contains one of "modified", "added", or "deleted".
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Restarter>, <File::Modified>
+
+=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
--- /dev/null
+package TestApp::Controller::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+no Moose;
+__PACKAGE__->meta->make_immutable;
--- /dev/null
+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;
--- /dev/null
+package TestApp::Controller::Subdir1::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;
--- /dev/null
+package TestApp::Controller::Subdir2::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;
--- /dev/null
+# 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();
+
+@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;
+}