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