requires 'Catalyst::Plugin::ConfigLoader';
requires 'Class::Accessor::Fast';
requires 'Config::General'; # as of 1.07, we use .conf and not .yaml
+requires 'File::ChangeNotify';
requires 'File::Copy::Recursive';
requires 'Module::Install' => '0.64';
requires 'parent'; # as of 1.04
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{sleep_interval} = $check_interval
+ if defined $check_interval;
+ $args{filter} = 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 File::ChangeNotify;
+use namespace::clean -except => 'meta';
+
+has restart_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->{restart_sub};
+
+ $p->{filter} ||= qr/(?:\/|^)(?!\.\#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
+
+ # 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->restart_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 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 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;
+}
projects / catagits/Catalyst-Devel.git / commitdiff