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 FindBin;
   8 use namespace::clean -except => 'meta';
   9
  10 has start_sub => (
  11     is       => 'ro',
  12     isa      => 'CodeRef',
  13     required => 1,
  14 );
  15
  16 has _watcher => (
  17     is  => 'rw',
  18     isa => 'File::ChangeNotify::Watcher',
  19 );
  20
  21 has _child => (
  22     is  => 'rw',
  23     isa => 'Int',
  24 );
  25
  26 sub BUILD {
  27     my $self = shift;
  28     my $p    = shift;
  29
  30     delete $p->{start_sub};
  31
  32     $p->{filter} ||= qr/(?:\/|^)(?!\.\#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
  33     $p->{directories} ||= abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) );
  34
  35     # We could make this lazily, but this lets us check that we
  36     # received valid arguments for the watcher up front.
  37     $self->_watcher( File::ChangeNotify->instantiate_watcher( %{$p} ) );
  38 }
  39
  40 sub run_and_watch {
  41     my $self = shift;
  42
  43     $self->_fork_and_start;
  44
  45     return unless $self->_child;
  46
  47     $self->_restart_on_changes;
  48 }
  49
  50 sub _fork_and_start {
  51     my $self = shift;
  52
  53     if ( my $pid = fork ) {
  54         $self->_child($pid);
  55     }
  56     else {
  57         $self->start_sub->();
  58     }
  59 }
  60
  61 sub _restart_on_changes {
  62     my $self = shift;
  63
  64     my @events = $self->_watcher->wait_for_events();
  65     $self->_handle_events(@events);
  66 }
  67
  68 sub _handle_events {
  69     my $self   = shift;
  70     my @events = @_;
  71
  72     print STDERR "\n";
  73     print STDERR "Saw changes to the following files:\n";
  74
  75     for my $event (@events) {
  76         my $path = $event->path();
  77         my $type = $event->type();
  78
  79         print STDERR " - $path ($type)\n";
  80     }
  81
  82     print STDERR "\n";
  83     print STDERR "Attempting to restart the server\n\n";
  84
  85     $self->_kill_child;
  86
  87     $self->_fork_and_start;
  88
  89     $self->_restart_on_changes;
  90 }
  91
  92 sub _kill_child {
  93     my $self = shift;
  94
  95     return unless $self->_child;
  96
  97     return unless kill 0, $self->_child;
  98
  99     local $SIG{CHLD} = 'IGNORE';
 100     unless ( kill 'INT', $self->_child ) {
 101         # The kill 0 thing does not work on Windows, but the restarter
 102         # seems to work fine on Windows with this hack.
 103         return if $^O eq 'MSWin32';
 104         die "Cannot send INT signal to ", $self->_child, ": $!";
 105     }
 106 }
 107
 108 sub DEMOLISH {
 109     my $self = shift;
 110
 111     $self->_kill_child;
 112 }
 113
 114 __PACKAGE__->meta->make_immutable;
 115
 116 1;
 117
 118 __END__
 119
 120 =head1 NAME
 121
 122 Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and restart the server
 123
 124 =head1 SYNOPSIS
 125
 126     my $restarter = Catalyst::Restarter->new(
 127         directories => '/path/to/MyApp',
 128         regex       => '\.yml$|\.yaml$|\.conf|\.pm$',
 129         start_sub => sub { ... }
 130     );
 131
 132     $restarter->run_and_watch;
 133
 134 =head1 DESCRIPTION
 135
 136 This class uses L<File::ChangeNotify> to watch one or more directories
 137 of files and restart the Catalyst server when any of those files
 138 changes.
 139
 140 =head1 METHODS
 141
 142 =head2 new ( start_sub => sub { ... }, ... )
 143
 144 This method creates a new restarter object.
 145
 146 The "start_sub" argument is required. This is a subroutine reference
 147 that can be used to start the Catalyst server.
 148
 149 =head2 run_and_watch
 150
 151 This method forks, starts the server in a child process, and then
 152 watched for changed files in the parent. When files change, it kills
 153 the child, forks again, and starts a new server.
 154
 155 =head1 SEE ALSO
 156
 157 L<Catalyst>, <File::ChangeNotify>
 158
 159 =head1 AUTHORS
 160
 161 Catalyst Contributors, see Catalyst.pm
 162
 163 =head1 COPYRIGHT
 164
 165 This program is free software, you can redistribute it and/or modify
 166 it under the same terms as Perl itself.
 167
 168 =cut