lib/Catalyst/Restarter.pm

   1 package Catalyst::Restarter;
   2
   3 use Moose;
   4
   5 use Catalyst::Watcher;
   6 use File::Spec;
   7 use FindBin;
   8 use namespace::clean -except => 'meta';
   9
  10 has restart_sub => (
  11     is       => 'ro',
  12     isa      => 'CodeRef',
  13     required => 1,
  14 );
  15
  16 has _watcher => (
  17     is  => 'rw',
  18     isa => 'Catalyst::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->{restart_sub};
  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( Catalyst::Watcher->new( %{$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->restart_sub->();
  55     }
  56 }
  57
  58 sub _restart_on_changes {
  59     my $self = shift;
  60
  61     my $watcher = $self->_watcher;
  62
  63     while (1) {
  64         my @files = $watcher->find_changed_files
  65             or next;
  66
  67         print STDERR "\n";
  68         print STDERR "Saw changes to the following files:\n";
  69         print STDERR " - $_->{file} ($_->{status})\n" for @files;
  70         print STDERR "\n";
  71         print STDERR "Attempting to restart the server\n\n";
  72
  73         $self->_kill_child;
  74
  75         $self->_fork_and_start;
  76
  77         return unless $self->_child;
  78     }
  79 }
  80
  81 sub _kill_child {
  82     my $self = shift;
  83
  84     return unless $self->_child;
  85
  86     return unless kill 0, $self->_child;
  87
  88     local $SIG{CHLD} = 'IGNORE';
  89     unless ( kill 'INT', $self->_child ) {
  90         # The kill 0 thing does not work on Windows, but the restarter
  91         # seems to work fine on Windows with this hack.
  92         return if $^O eq 'MSWin32';
  93         die "Cannot send INT signal to ", $self->_child, ": $!";
  94     }
  95 }
  96
  97 sub DEMOLISH {
  98     my $self = shift;
  99
 100     $self->_kill_child;
 101 }
 102
 103 __PACKAGE__->meta->make_immutable;
 104
 105 1;
 106
 107 __END__
 108
 109 =head1 NAME
 110
 111 Catalyst::Restarter - Uses Catalyst::Watcher to check for changed files and restart the server
 112
 113 =head1 SYNOPSIS
 114
 115     my $watcher = Catalyst::Watcher->new(
 116         directory => '/path/to/MyApp',
 117         regex     => '\.yml$|\.yaml$|\.conf|\.pm$',
 118         interval  => 3,
 119     );
 120
 121     while (1) {
 122         my @changed_files = $watcher->watch();
 123     }
 124
 125 =head1 DESCRIPTION
 126
 127 This class monitors a directory of files for changes made to any file
 128 matching a regular expression. It correctly handles new files added to the
 129 application as well as files that are deleted.
 130
 131 =head1 METHODS
 132
 133 =head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
 134
 135 Creates a new Watcher object.
 136
 137 =head2 find_changed_files
 138
 139 Returns a list of files that have been added, deleted, or changed
 140 since the last time watch was called. Each element returned is a hash
 141 reference with two keys. The C<file> key contains the filename, and
 142 the C<status> key contains one of "modified", "added", or "deleted".
 143
 144 =head1 SEE ALSO
 145
 146 L<Catalyst>, L<Catalyst::Restarter>, <File::Modified>
 147
 148 =head1 AUTHORS
 149
 150 Catalyst Contributors, see Catalyst.pm
 151
 152 =head1 COPYRIGHT
 153
 154 This program is free software, you can redistribute it and/or modify
 155 it under the same terms as Perl itself.
 156
 157 =cut