Commit | Line | Data |
65586a18 |
1 | package Catalyst::Engine::HTTP::Restarter::Watcher; |
2 | |
7fa2c9c1 |
3 | use Moose; |
10954d1d |
4 | with 'MooseX::Emulate::Class::Accessor::Fast'; |
531f1ab6 |
5 | |
65586a18 |
6 | use File::Find; |
7 | use File::Modified; |
8 | use File::Spec; |
9 | use Time::HiRes qw/sleep/; |
65b708a6 |
10 | use Moose::Util qw/find_meta/; |
11 | use namespace::clean -except => 'meta'; |
12 | |
13 | BEGIN { |
14 | # If we can detect stash changes, then we do magic |
15 | # to make their metaclass mutable (if they have one) |
16 | # so that restarting works as expected. |
17 | eval { require B::Hooks::OP::Check::StashChange; }; |
18 | *DETECT_PACKAGE_COMPILATION = $@ |
19 | ? sub () { 0 } |
20 | : sub () { 1 } |
21 | } |
65586a18 |
22 | |
7fa2c9c1 |
23 | has delay => (is => 'rw'); |
24 | has regex => (is => 'rw'); |
932d28e8 |
25 | has modified => (is => 'rw', builder => '_build_modified', lazy => 1); |
7fa2c9c1 |
26 | has directory => (is => 'rw'); |
932d28e8 |
27 | has watch_list => (is => 'rw', builder => '_build_watch_list', lazy => 1); |
f7174b10 |
28 | has follow_symlinks => (is => 'rw'); |
65586a18 |
29 | |
932d28e8 |
30 | sub _build_watch_list { |
31 | my ($self) = @_; |
32 | return $self->_index_directory; |
65586a18 |
33 | } |
34 | |
932d28e8 |
35 | sub _build_modified { |
36 | my ($self) = @_; |
37 | return File::Modified->new( |
38 | method => 'mtime', |
39 | files => [ keys %{ $self->watch_list } ], |
65586a18 |
40 | ); |
41 | } |
42 | |
43 | sub watch { |
44 | my $self = shift; |
b5ecfcf0 |
45 | |
65586a18 |
46 | my @changes; |
47 | my @changed_files; |
ac5c933b |
48 | |
951572c0 |
49 | my $delay = ( defined $self->delay ) ? $self->delay : 1; |
b5ecfcf0 |
50 | |
951572c0 |
51 | sleep $delay if $delay > 0; |
b5ecfcf0 |
52 | |
65586a18 |
53 | eval { @changes = $self->modified->changed }; |
b5ecfcf0 |
54 | if ($@) { |
55 | |
65586a18 |
56 | # File::Modified will die if a file is deleted. |
57 | my ($deleted_file) = $@ =~ /stat '(.+)'/; |
58 | push @changed_files, $deleted_file || 'unknown file'; |
59 | } |
b5ecfcf0 |
60 | |
61 | if (@changes) { |
62 | |
65586a18 |
63 | # update all mtime information |
64 | $self->modified->update; |
b5ecfcf0 |
65 | |
65586a18 |
66 | # check if any files were changed |
67 | @changed_files = grep { -f $_ } @changes; |
b5ecfcf0 |
68 | |
65586a18 |
69 | # Check if only directories were changed. This means |
70 | # a new file was created. |
b5ecfcf0 |
71 | unless (@changed_files) { |
72 | |
65586a18 |
73 | # re-index to find new files |
74 | my $new_watch = $self->_index_directory; |
b5ecfcf0 |
75 | |
65586a18 |
76 | # look through the new list for new files |
77 | my $old_watch = $self->watch_list; |
b5ecfcf0 |
78 | @changed_files = grep { !defined $old_watch->{$_} } |
79 | keys %{$new_watch}; |
80 | |
65586a18 |
81 | return unless @changed_files; |
82 | } |
83 | |
84 | # Test modified pm's |
b5ecfcf0 |
85 | for my $file (@changed_files) { |
65586a18 |
86 | next unless $file =~ /\.pm$/; |
87 | if ( my $error = $self->_test($file) ) { |
b5ecfcf0 |
88 | print STDERR qq/File "$file" modified, not restarting\n\n/; |
65586a18 |
89 | print STDERR '*' x 80, "\n"; |
90 | print STDERR $error; |
91 | print STDERR '*' x 80, "\n"; |
92 | return; |
93 | } |
94 | } |
95 | } |
b5ecfcf0 |
96 | |
65586a18 |
97 | return @changed_files; |
98 | } |
99 | |
100 | sub _index_directory { |
101 | my $self = shift; |
b5ecfcf0 |
102 | |
9c71d51d |
103 | my $dir = $self->directory; |
104 | die "No directory specified" if !$dir or ref($dir) && !@{$dir}; |
105 | |
b5ecfcf0 |
106 | my $regex = $self->regex || '\.pm$'; |
65586a18 |
107 | my %list; |
b5ecfcf0 |
108 | |
65586a18 |
109 | finddepth( |
110 | { |
111 | wanted => sub { |
112 | my $file = File::Spec->rel2abs($File::Find::name); |
113 | return unless $file =~ /$regex/; |
114 | return unless -f $file; |
115 | $file =~ s{/script/..}{}; |
116 | $list{$file} = 1; |
b5ecfcf0 |
117 | |
65586a18 |
118 | # also watch the directory for changes |
119 | my $cur_dir = File::Spec->rel2abs($File::Find::dir); |
b5ecfcf0 |
120 | $cur_dir =~ s{/script/..}{}; |
65586a18 |
121 | $list{$cur_dir} = 1; |
122 | }, |
9c71d51d |
123 | follow_fast => $self->follow_symlinks ? 1 : 0, |
65586a18 |
124 | no_chdir => 1 |
125 | }, |
9c71d51d |
126 | ref $dir eq 'ARRAY' ? @{$dir} : $dir |
65586a18 |
127 | ); |
128 | return \%list; |
129 | } |
130 | |
131 | sub _test { |
132 | my ( $self, $file ) = @_; |
b5ecfcf0 |
133 | |
65b708a6 |
134 | my $id; |
135 | if (DETECT_PACKAGE_COMPILATION) { |
136 | $id = B::Hooks::OP::Check::StashChange::register(sub { |
137 | my ($new, $old) = @_; |
138 | my $meta = find_meta($new); |
2bab21f6 |
139 | if ($meta) { # A little paranoia here - Moose::Meta::Role has neither of these methods. |
140 | my $is_immutable = $meta->can('is_immutable'); |
141 | my $make_mutable = $meta->can('make_mutable'); |
142 | $meta->$make_mutable() if $is_immutable && $make_mutable && $meta->$is_immutable(); |
16b7c476 |
143 | eval { # Do not explode the watcher process if this fails. |
144 | my $superclasses = $meta->can('superclasses'); |
145 | $meta->$superclasses('Moose::Object') if $superclasses; |
146 | }; |
65b708a6 |
147 | } |
148 | }); |
149 | } |
150 | |
16b7c476 |
151 | local $Catalyst::__AM_RESTARTING = 1; # Hack to avoid C3 fail |
65b708a6 |
152 | delete $INC{$file}; # Remove from %INC so it will reload |
65586a18 |
153 | local $SIG{__WARN__} = sub { }; |
b5ecfcf0 |
154 | |
65586a18 |
155 | open my $olderr, '>&STDERR'; |
156 | open STDERR, '>', File::Spec->devnull; |
157 | eval "require '$file'"; |
158 | open STDERR, '>&', $olderr; |
b5ecfcf0 |
159 | |
65b708a6 |
160 | B::Hooks::OP::Check::StashChange::unregister($id) if $id; |
161 | |
65586a18 |
162 | return ($@) ? $@ : 0; |
b5ecfcf0 |
163 | } |
65586a18 |
164 | |
165 | 1; |
166 | __END__ |
167 | |
168 | =head1 NAME |
169 | |
170 | Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application |
171 | files |
172 | |
173 | =head1 SYNOPSIS |
174 | |
175 | my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new( |
176 | directory => '/path/to/MyApp', |
2f381252 |
177 | regex => '\.yml$|\.yaml$|\.conf|\.pm$', |
65586a18 |
178 | delay => 1, |
179 | ); |
ac5c933b |
180 | |
65586a18 |
181 | while (1) { |
182 | my @changed_files = $watcher->watch(); |
183 | } |
184 | |
185 | =head1 DESCRIPTION |
186 | |
187 | This class monitors a directory of files for changes made to any file |
188 | matching a regular expression. It correctly handles new files added to the |
189 | application as well as files that are deleted. |
190 | |
191 | =head1 METHODS |
192 | |
193 | =head2 new ( directory => $path [, regex => $regex, delay => $delay ] ) |
194 | |
195 | Creates a new Watcher object. |
196 | |
197 | =head2 watch |
198 | |
199 | Returns a list of files that have been added, deleted, or changed since the |
200 | last time watch was called. |
201 | |
c03163b8 |
202 | =head2 DETECT_PACKAGE_COMPILATION |
203 | |
204 | Returns true if L<B::Hooks::OP::Check::StashChange> is installed and |
205 | can be used to detect when files are compiled. This is used internally |
206 | to make the L<Moose> metaclass of any class being reloaded immutable. |
207 | |
208 | If L<B::Hooks::OP::Check::StashChange> is not installed, then the |
209 | restarter makes all application components immutable. This covers the |
210 | simple case, but is less useful if you're using Moose in components |
211 | outside Catalyst's namespaces, but inside your application directory. |
212 | |
65586a18 |
213 | =head1 SEE ALSO |
214 | |
215 | L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified> |
216 | |
217 | =head1 AUTHORS |
218 | |
2f381252 |
219 | Catalyst Contributors, see Catalyst.pm |
65586a18 |
220 | |
221 | =head1 THANKS |
222 | |
223 | Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent. |
224 | |
225 | =head1 COPYRIGHT |
226 | |
227 | This program is free software, you can redistribute it and/or modify it under |
228 | the same terms as Perl itself. |
229 | |
230 | =cut |