local-lib5/lib/perl5/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 namespace::clean -except => 'meta';
  10
  11 has start_sub => (
  12     is       => 'ro',
  13     isa      => 'CodeRef',
  14     required => 1,
  15 );
  16
  17 has argv =>  (
  18     is       => 'ro',
  19     isa      => 'ArrayRef',
  20     required => 1,
  21 );
  22
  23 has _watcher => (
  24     is  => 'rw',
  25     isa => 'File::ChangeNotify::Watcher',
  26 );
  27
  28 has _child => (
  29     is  => 'rw',
  30     isa => 'Int',
  31 );
  32
  33 sub pick_subclass {
  34     my $class = shift;
  35
  36     my $subclass;
  37     $subclass =
  38         defined $ENV{CATALYST_RESTARTER}
  39             ? $ENV{CATALYST_RESTARTER}
  40             :  $^O eq 'MSWin32'
  41             ? 'Win32'
  42             : 'Forking';
  43
  44     $subclass = 'Catalyst::Restarter::' . $subclass;
  45
  46     eval "use $subclass";
  47     die $@ if $@;
  48
  49     return $subclass;
  50 }
  51
  52 sub BUILD {
  53     my $self = shift;
  54     my $p    = shift;
  55
  56     delete $p->{start_sub};
  57
  58     $p->{filter} ||= qr/(?:\/|^)(?![.#_]).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/;
  59
  60     my $app_root = abs_path( File::Spec->catdir( $FindBin::Bin, '..' ) );
  61
  62     # Monitor application root dir
  63     $p->{directories} ||= $app_root;
  64
  65     # exclude t/, root/ and hidden dirs
  66     $p->{exclude} ||= [
  67         File::Spec->catdir($app_root, 't'),
  68         File::Spec->catdir($app_root, 'root'),
  69         qr(/\.[^/]*/?$),    # match hidden dirs
  70     ];
  71
  72     # We could make this lazily, but this lets us check that we
  73     # received valid arguments for the watcher up front.
  74     $self->_watcher( File::ChangeNotify->instantiate_watcher( %{$p} ) );
  75 }
  76
  77 sub run_and_watch {
  78     my $self = shift;
  79
  80     $self->_fork_and_start;
  81
  82     return unless $self->_child;
  83
  84     $self->_restart_on_changes;
  85 }
  86
  87 sub _restart_on_changes {
  88     my $self = shift;
  89
  90     # We use this loop in order to avoid having _handle_events() call back
  91     # into this method. We used to do that, and the end result was that stack
  92     # traces became longer and longer with every restart. Using this loop, the
  93     # portion of the stack trace that covers this code does not grow.
  94     while (1) {
  95         my @events = $self->_watcher->wait_for_events();
  96         $self->_handle_events(@events);
  97     }
  98 }
  99
 100 sub _handle_events {
 101     my $self   = shift;
 102     my @events = @_;
 103
 104     print STDERR "\n";
 105     print STDERR "Saw changes to the following files:\n";
 106
 107     for my $event (@events) {
 108         my $path = $event->path();
 109         my $type = $event->type();
 110
 111         print STDERR " - $path ($type)\n";
 112     }
 113
 114     print STDERR "\n";
 115     print STDERR "Attempting to restart the server\n\n";
 116
 117     $self->_kill_child;
 118
 119     $self->_fork_and_start;
 120 }
 121
 122 sub DEMOLISH {
 123     my $self = shift;
 124
 125     $self->_kill_child;
 126 }
 127
 128 __PACKAGE__->meta->make_immutable;
 129
 130 1;
 131
 132 __END__
 133
 134 =head1 NAME
 135
 136 Catalyst::Restarter - Uses File::ChangeNotify to check for changed files and restart the server
 137
 138 =head1 SYNOPSIS
 139
 140     my $class = Catalyst::Restarter->pick_subclass;
 141
 142     my $restarter = $class->new(
 143         directories => '/path/to/MyApp',
 144         regex       => '\.yml$|\.yaml$|\.conf|\.pm$',
 145         start_sub => sub { ... }
 146     );
 147
 148     $restarter->run_and_watch;
 149
 150 =head1 DESCRIPTION
 151
 152 This is the base class for all restarters, and it also provide
 153 functionality for picking an appropriate restarter subclass for a
 154 given platform.
 155
 156 This class uses L<File::ChangeNotify> to watch one or more directories
 157 of files and restart the Catalyst server when any of those files
 158 changes.
 159
 160 =head1 METHODS
 161
 162 =head2 pick_subclass
 163
 164 Returns the name of an appropriate subclass for the given platform.
 165
 166 =head2 new ( start_sub => sub { ... }, ... )
 167
 168 This method creates a new restarter object, but should be called on a
 169 subclass, not this class.
 170
 171 The "start_sub" argument is required. This is a subroutine reference
 172 that can be used to start the Catalyst server.
 173
 174 =head2 run_and_watch
 175
 176 This method forks, starts the server in a child process, and then
 177 watched for changed files in the parent. When files change, it kills
 178 the child, forks again, and starts a new server.
 179
 180 =head1 SEE ALSO
 181
 182 L<Catalyst>, <File::ChangeNotify>
 183
 184 =head1 AUTHORS
 185
 186 Catalyst Contributors, see Catalyst.pm
 187
 188 =head1 COPYRIGHT
 189
 190 This program is free software, you can redistribute it and/or modify
 191 it under the same terms as Perl itself.
 192
 193 =cut