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' && $path =~ $self->_filter ) )
 121         {
 122             push @files, { path => $path, type => $type };
 123         }
 124     }
 125
 126     if (@files) {
 127         print STDERR "\n";
 128         print STDERR "Saw changes to the following files:\n";
 129
 130         for my $f (@files) {
 131             my $path = $f->{path};
 132             my $type = $f->{type};
 133             print STDERR " - $path ($type)\n";
 134         }
 135
 136         print STDERR "\n";
 137         print STDERR "Attempting to restart the server\n\n";
 138
 139         $self->_kill_child;
 140
 141         $self->_fork_and_start;
 142     }
 143 }
 144
 145 sub DEMOLISH {
 146     my $self = shift;
 147
 148     $self->_kill_child;
 149 }
 150
 151 __PACKAGE__->meta->make_immutable;
 152
 153 1;
 154
 155 __END__
 156
 157 =head1 NAME
 158
 159 Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and restart the server
 160
 161 =head1 SYNOPSIS
 162
 163     my $class = Catalyst::Restarter->pick_subclass;
 164
 165     my $restarter = $class->new(
 166         directories => '/path/to/MyApp',
 167         regex       => '\.yml$|\.yaml$|\.conf|\.pm$',
 168         start_sub => sub { ... }
 169     );
 170
 171     $restarter->run_and_watch;
 172
 173 =head1 DESCRIPTION
 174
 175 This is the base class for all restarters, and it also provide
 176 functionality for picking an appropriate restarter subclass for a
 177 given platform.
 178
 179 This class uses L<File::ChangeNotify> to watch one or more directories
 180 of files and restart the Catalyst server when any of those files
 181 changes.
 182
 183 =head1 METHODS
 184
 185 =head2 pick_subclass
 186
 187 Returns the name of an appropriate subclass for the given platform.
 188
 189 =head2 new ( start_sub => sub { ... }, ... )
 190
 191 This method creates a new restarter object, but should be called on a
 192 subclass, not this class.
 193
 194 The "start_sub" argument is required. This is a subroutine reference
 195 that can be used to start the Catalyst server.
 196
 197 =head2 run_and_watch
 198
 199 This method forks, starts the server in a child process, and then
 200 watched for changed files in the parent. When files change, it kills
 201 the child, forks again, and starts a new server.
 202
 203 =head1 SEE ALSO
 204
 205 L<Catalyst>, L<File::ChangeNotify>
 206
 207 =head1 AUTHORS
 208
 209 Catalyst Contributors, see Catalyst.pm
 210
 211 =head1 COPYRIGHT
 212
 213 This program is free software, you can redistribute it and/or modify
 214 it under the same terms as Perl itself.
 215
 216 =cut