lib/Catalyst/Restarter.pm

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