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