Catalyst::Restarter::Forking: clear watcher in child process
[catagits/Catalyst-Devel.git] / lib / Catalyst / Restarter.pm
index 6fe29f4..81295f1 100644 (file)
@@ -4,7 +4,9 @@ use Moose;
 
 use Cwd qw( abs_path );
 use File::ChangeNotify;
+use File::Spec;
 use FindBin;
+use Catalyst::Utils;
 use namespace::clean -except => 'meta';
 
 has start_sub => (
@@ -13,9 +15,21 @@ has start_sub => (
     required => 1,
 );
 
+has argv =>  (
+    is       => 'ro',
+    isa      => 'ArrayRef',
+    required => 1,
+);
+
 has _watcher => (
-    is  => 'rw',
-    isa => 'File::ChangeNotify::Watcher',
+    is      => 'rw',
+    isa     => 'File::ChangeNotify::Watcher',
+    clearer => '_clear_watcher',
+);
+
+has _filter => (
+    is      => 'rw',
+    isa     => 'RegexpRef',
 );
 
 has _child => (
@@ -23,14 +37,47 @@ has _child => (
     isa => 'Int',
 );
 
+sub pick_subclass {
+    my $class = shift;
+
+    my $subclass;
+    $subclass =
+        defined $ENV{CATALYST_RESTARTER}
+            ? $ENV{CATALYST_RESTARTER}
+            :  $^O eq 'MSWin32'
+            ? 'Win32'
+            : 'Forking';
+
+    $subclass = 'Catalyst::Restarter::' . $subclass;
+
+    Catalyst::Utils::ensure_class_loaded($subclass);
+
+    return $subclass;
+}
+
 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, '..' ) );
+    $p->{filter} ||= qr/(?:\/|^)(?![.#_]).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
+
+    my $app_root = abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) );
+
+    # Monitor application root dir
+    $p->{directories} ||= $app_root;
+
+    # exclude t/, root/ and hidden dirs
+    $p->{exclude} ||= [
+        File::Spec->catdir($app_root, 't'),
+        File::Spec->catdir($app_root, 'root'),
+        qr(/\.[^/]*/?$),    # match hidden dirs
+    ];
+
+    # keep filter regexp to make sure we don't restart on deleted
+    # files or directories where we can't check -d
+    $self->_filter( $p->{filter} );
 
     # We could make this lazily, but this lets us check that we
     # received valid arguments for the watcher up front.
@@ -47,61 +94,54 @@ sub run_and_watch {
     $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);
+    # We use this loop in order to avoid having _handle_events() call back
+    # into this method. We used to do that, and the end result was that stack
+    # traces became longer and longer with every restart. Using this loop, the
+    # portion of the stack trace that covers this code does not grow.
+    while (1) {
+        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";
-
+    my @files;
+    # Filter out any events which are the creation / deletion of directories
+    # so that creating an empty directory won't cause a restart
     for my $event (@events) {
         my $path = $event->path();
         my $type = $event->type();
-
-        print STDERR " - $path ($type)\n";
+        if ( (    ( $type ne 'delete' && -f $path )
+               || ( $type eq 'delete' )
+             )
+             && ( $path =~ $self->_filter )
+        ) {
+            push @files, { path => $path, type => $type };
+        }
     }
 
-    print STDERR "\n";
-    print STDERR "Attempting to restart the server\n\n";
+    if (@files) {
+        print STDERR "\n";
+        print STDERR "Saw changes to the following files:\n";
 
-    $self->_kill_child;
+        for my $f (@files) {
+            my $path = $f->{path};
+            my $type = $f->{type};
+            print STDERR " - $path ($type)\n";
+        }
 
-    $self->_fork_and_start;
+        print STDERR "\n";
+        print STDERR "Attempting to restart the server\n\n";
 
-    $self->_restart_on_changes;
-}
+        $self->_kill_child;
 
-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, ": $!";
+        $self->_fork_and_start;
     }
 }
 
@@ -123,7 +163,9 @@ Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and res
 
 =head1 SYNOPSIS
 
-    my $restarter = Catalyst::Restarter->new(
+    my $class = Catalyst::Restarter->pick_subclass;
+
+    my $restarter = $class->new(
         directories => '/path/to/MyApp',
         regex       => '\.yml$|\.yaml$|\.conf|\.pm$',
         start_sub => sub { ... }
@@ -133,15 +175,24 @@ Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and res
 
 =head1 DESCRIPTION
 
+This is the base class for all restarters, and it also provide
+functionality for picking an appropriate restarter subclass for a
+given platform.
+
 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 pick_subclass
+
+Returns the name of an appropriate subclass for the given platform.
+
 =head2 new ( start_sub => sub { ... }, ... )
 
-This method creates a new restarter object.
+This method creates a new restarter object, but should be called on a
+subclass, not this class.
 
 The "start_sub" argument is required. This is a subroutine reference
 that can be used to start the Catalyst server.
@@ -154,7 +205,7 @@ the child, forks again, and starts a new server.
 
 =head1 SEE ALSO
 
-L<Catalyst>, <File::ChangeNotify>
+L<Catalyst>, L<File::ChangeNotify>
 
 =head1 AUTHORS