lib/Catalyst/Restarter.pm

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