lib/Catalyst/Restarter.pm

   1 package Catalyst::Restarter;
   2
   3 use Moose;
   4
   5 use Cwd qw( abs_path );
   6 use File::ChangeNotify;
   7 use File::Spec;
   8 use FindBin;
   9 use Catalyst::Utils;
  10 use namespace::clean -except => 'meta';
  11
  12 has start_sub => (
  13     is       => 'ro',
  14     isa      => 'CodeRef',
  15     required => 1,
  16 );
  17
  18 has argv =>  (
  19     is       => 'ro',
  20     isa      => 'ArrayRef',
  21     required => 1,
  22 );
  23
  24 has _watcher => (
  25     is  => 'rw',
  26     isa => 'File::ChangeNotify::Watcher',
  27 );
  28
  29 has _filter => (
  30     is      => 'rw',
  31     isa     => 'RegexpRef',
  32 );
  33
  34 has _child => (
  35     is  => 'rw',
  36     isa => 'Int',
  37 );
  38
  39 sub pick_subclass {
  40     my $class = shift;
  41
  42     my $subclass;
  43     $subclass =
  44         defined $ENV{CATALYST_RESTARTER}
  45             ? $ENV{CATALYST_RESTARTER}
  46             :  $^O eq 'MSWin32'
  47             ? 'Win32'
  48             : 'Forking';
  49
  50     $subclass = 'Catalyst::Restarter::' . $subclass;
  51
  52     Catalyst::Utils::ensure_class_loaded($subclass);
  53
  54     return $subclass;
  55 }
  56
  57 sub BUILD {
  58     my $self = shift;
  59     my $p    = shift;
  60
  61     delete $p->{start_sub};
  62
  63     $p->{filter} ||= qr/(?:\/|^)(?![.#_]).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
  64
  65     my $app_root = abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) );
  66
  67     # Monitor application root dir
  68     $p->{directories} ||= $app_root;
  69
  70     # exclude t/, root/ and hidden dirs
  71     $p->{exclude} ||= [
  72         File::Spec->catdir($app_root, 't'),
  73         File::Spec->catdir($app_root, 'root'),
  74         qr(/\.[^/]*/?$),    # match hidden dirs
  75     ];
  76
  77     # keep filter regexp to make sure we don't restart on deleted
  78     # files or directories where we can't check -d
  79     $self->_filter( $p->{filter} );
  80
  81     # We could make this lazily, but this lets us check that we
  82     # received valid arguments for the watcher up front.
  83     $self->_watcher( File::ChangeNotify->instantiate_watcher( %{$p} ) );
  84 }
  85
  86 sub run_and_watch {
  87     my $self = shift;
  88
  89     $self->_fork_and_start;
  90
  91     return unless $self->_child;
  92
  93     $self->_restart_on_changes;
  94 }
  95
  96 sub _restart_on_changes {
  97     my $self = shift;
  98
  99     # We use this loop in order to avoid having _handle_events() call back
 100     # into this method. We used to do that, and the end result was that stack
 101     # traces became longer and longer with every restart. Using this loop, the
 102     # portion of the stack trace that covers this code does not grow.
 103     while (1) {
 104         my @events = $self->_watcher->wait_for_events();
 105         $self->_handle_events(@events);
 106     }
 107 }
 108
 109 sub _handle_events {
 110     my $self   = shift;
 111     my @events = @_;
 112
 113     my @files;
 114     # Filter out any events which are the creation / deletion of directories
 115     # so that creating an empty directory won't cause a restart
 116     for my $event (@events) {
 117         my $path = $event->path();
 118         my $type = $event->type();
 119         if ( (    ( $type ne 'delete' && -f $path )
 120                || ( $type eq 'delete' )
 121              )
 122              && ( $path =~ $self->_filter )
 123         ) {
 124             push @files, { path => $path, type => $type };
 125         }
 126     }
 127
 128     if (@files) {
 129         print STDERR "\n";
 130         print STDERR "Saw changes to the following files:\n";
 131
 132         for my $f (@files) {
 133             my $path = $f->{path};
 134             my $type = $f->{type};
 135             print STDERR " - $path ($type)\n";
 136         }
 137
 138         print STDERR "\n";
 139         print STDERR "Attempting to restart the server\n\n";
 140
 141         $self->_kill_child;
 142
 143         $self->_fork_and_start;
 144     }
 145 }
 146
 147 sub DEMOLISH {
 148     my $self = shift;
 149
 150     $self->_kill_child;
 151 }
 152
 153 __PACKAGE__->meta->make_immutable;
 154
 155 1;
 156
 157 __END__
 158
 159 =head1 NAME
 160
 161 Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and restart the server
 162
 163 =head1 SYNOPSIS
 164
 165     my $class = Catalyst::Restarter->pick_subclass;
 166
 167     my $restarter = $class->new(
 168         directories => '/path/to/MyApp',
 169         regex       => '\.yml$|\.yaml$|\.conf|\.pm$',
 170         start_sub => sub { ... }
 171     );
 172
 173     $restarter->run_and_watch;
 174
 175 =head1 DESCRIPTION
 176
 177 This is the base class for all restarters, and it also provide
 178 functionality for picking an appropriate restarter subclass for a
 179 given platform.
 180
 181 This class uses L<File::ChangeNotify> to watch one or more directories
 182 of files and restart the Catalyst server when any of those files
 183 changes.
 184
 185 =head1 METHODS
 186
 187 =head2 pick_subclass
 188
 189 Returns the name of an appropriate subclass for the given platform.
 190
 191 =head2 new ( start_sub => sub { ... }, ... )
 192
 193 This method creates a new restarter object, but should be called on a
 194 subclass, not this class.
 195
 196 The "start_sub" argument is required. This is a subroutine reference
 197 that can be used to start the Catalyst server.
 198
 199 =head2 run_and_watch
 200
 201 This method forks, starts the server in a child process, and then
 202 watched for changed files in the parent. When files change, it kills
 203 the child, forks again, and starts a new server.
 204
 205 =head1 SEE ALSO
 206
 207 L<Catalyst>, L<File::ChangeNotify>
 208
 209 =head1 AUTHORS
 210
 211 Catalyst Contributors, see Catalyst.pm
 212
 213 =head1 COPYRIGHT
 214
 215 This program is free software, you can redistribute it and/or modify
 216 it under the same terms as Perl itself.
 217
 218 =cut