Commit | Line | Data |
65586a18 |
1 | package Catalyst::Engine::HTTP::Restarter::Watcher; |
2 | |
7fa2c9c1 |
3 | use Moose; |
65586a18 |
4 | use File::Find; |
5 | use File::Modified; |
6 | use File::Spec; |
7 | use Time::HiRes qw/sleep/; |
8 | |
7fa2c9c1 |
9 | has delay => (is => 'rw'); |
10 | has regex => (is => 'rw'); |
11 | has modified => (is => 'rw'); |
12 | has directory => (is => 'rw'); |
13 | has watch_list => (is => 'rw'); |
14 | has follow_simlinks => (is => 'rw'); |
65586a18 |
15 | |
16 | sub new { |
17 | my ( $class, %args ) = @_; |
b5ecfcf0 |
18 | |
19 | my $self = {%args}; |
20 | |
65586a18 |
21 | bless $self, $class; |
b5ecfcf0 |
22 | |
65586a18 |
23 | $self->_init; |
b5ecfcf0 |
24 | |
65586a18 |
25 | return $self; |
26 | } |
27 | |
28 | sub _init { |
29 | my $self = shift; |
b5ecfcf0 |
30 | |
65586a18 |
31 | my $watch_list = $self->_index_directory; |
b5ecfcf0 |
32 | $self->watch_list($watch_list); |
33 | |
65586a18 |
34 | $self->modified( |
35 | File::Modified->new( |
36 | method => 'mtime', |
37 | files => [ keys %{$watch_list} ], |
38 | ) |
39 | ); |
40 | } |
41 | |
42 | sub watch { |
43 | my $self = shift; |
b5ecfcf0 |
44 | |
65586a18 |
45 | my @changes; |
46 | my @changed_files; |
ac5c933b |
47 | |
951572c0 |
48 | my $delay = ( defined $self->delay ) ? $self->delay : 1; |
b5ecfcf0 |
49 | |
951572c0 |
50 | sleep $delay if $delay > 0; |
b5ecfcf0 |
51 | |
65586a18 |
52 | eval { @changes = $self->modified->changed }; |
b5ecfcf0 |
53 | if ($@) { |
54 | |
65586a18 |
55 | # File::Modified will die if a file is deleted. |
56 | my ($deleted_file) = $@ =~ /stat '(.+)'/; |
57 | push @changed_files, $deleted_file || 'unknown file'; |
58 | } |
b5ecfcf0 |
59 | |
60 | if (@changes) { |
61 | |
65586a18 |
62 | # update all mtime information |
63 | $self->modified->update; |
b5ecfcf0 |
64 | |
65586a18 |
65 | # check if any files were changed |
66 | @changed_files = grep { -f $_ } @changes; |
b5ecfcf0 |
67 | |
65586a18 |
68 | # Check if only directories were changed. This means |
69 | # a new file was created. |
b5ecfcf0 |
70 | unless (@changed_files) { |
71 | |
65586a18 |
72 | # re-index to find new files |
73 | my $new_watch = $self->_index_directory; |
b5ecfcf0 |
74 | |
65586a18 |
75 | # look through the new list for new files |
76 | my $old_watch = $self->watch_list; |
b5ecfcf0 |
77 | @changed_files = grep { !defined $old_watch->{$_} } |
78 | keys %{$new_watch}; |
79 | |
65586a18 |
80 | return unless @changed_files; |
81 | } |
82 | |
83 | # Test modified pm's |
b5ecfcf0 |
84 | for my $file (@changed_files) { |
65586a18 |
85 | next unless $file =~ /\.pm$/; |
86 | if ( my $error = $self->_test($file) ) { |
b5ecfcf0 |
87 | print STDERR qq/File "$file" modified, not restarting\n\n/; |
65586a18 |
88 | print STDERR '*' x 80, "\n"; |
89 | print STDERR $error; |
90 | print STDERR '*' x 80, "\n"; |
91 | return; |
92 | } |
93 | } |
94 | } |
b5ecfcf0 |
95 | |
65586a18 |
96 | return @changed_files; |
97 | } |
98 | |
99 | sub _index_directory { |
100 | my $self = shift; |
b5ecfcf0 |
101 | |
9c71d51d |
102 | my $dir = $self->directory; |
103 | die "No directory specified" if !$dir or ref($dir) && !@{$dir}; |
104 | |
b5ecfcf0 |
105 | my $regex = $self->regex || '\.pm$'; |
65586a18 |
106 | my %list; |
b5ecfcf0 |
107 | |
65586a18 |
108 | finddepth( |
109 | { |
110 | wanted => sub { |
111 | my $file = File::Spec->rel2abs($File::Find::name); |
112 | return unless $file =~ /$regex/; |
113 | return unless -f $file; |
114 | $file =~ s{/script/..}{}; |
115 | $list{$file} = 1; |
b5ecfcf0 |
116 | |
65586a18 |
117 | # also watch the directory for changes |
118 | my $cur_dir = File::Spec->rel2abs($File::Find::dir); |
b5ecfcf0 |
119 | $cur_dir =~ s{/script/..}{}; |
65586a18 |
120 | $list{$cur_dir} = 1; |
121 | }, |
9c71d51d |
122 | follow_fast => $self->follow_symlinks ? 1 : 0, |
65586a18 |
123 | no_chdir => 1 |
124 | }, |
9c71d51d |
125 | ref $dir eq 'ARRAY' ? @{$dir} : $dir |
65586a18 |
126 | ); |
127 | return \%list; |
128 | } |
129 | |
130 | sub _test { |
131 | my ( $self, $file ) = @_; |
b5ecfcf0 |
132 | |
65586a18 |
133 | delete $INC{$file}; |
134 | local $SIG{__WARN__} = sub { }; |
b5ecfcf0 |
135 | |
65586a18 |
136 | open my $olderr, '>&STDERR'; |
137 | open STDERR, '>', File::Spec->devnull; |
138 | eval "require '$file'"; |
139 | open STDERR, '>&', $olderr; |
b5ecfcf0 |
140 | |
65586a18 |
141 | return ($@) ? $@ : 0; |
b5ecfcf0 |
142 | } |
65586a18 |
143 | |
144 | 1; |
145 | __END__ |
146 | |
147 | =head1 NAME |
148 | |
149 | Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application |
150 | files |
151 | |
152 | =head1 SYNOPSIS |
153 | |
154 | my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new( |
155 | directory => '/path/to/MyApp', |
156 | regex => '\.yml$|\.yaml$|\.pm$', |
157 | delay => 1, |
158 | ); |
ac5c933b |
159 | |
65586a18 |
160 | while (1) { |
161 | my @changed_files = $watcher->watch(); |
162 | } |
163 | |
164 | =head1 DESCRIPTION |
165 | |
166 | This class monitors a directory of files for changes made to any file |
167 | matching a regular expression. It correctly handles new files added to the |
168 | application as well as files that are deleted. |
169 | |
170 | =head1 METHODS |
171 | |
172 | =head2 new ( directory => $path [, regex => $regex, delay => $delay ] ) |
173 | |
174 | Creates a new Watcher object. |
175 | |
176 | =head2 watch |
177 | |
178 | Returns a list of files that have been added, deleted, or changed since the |
179 | last time watch was called. |
180 | |
181 | =head1 SEE ALSO |
182 | |
183 | L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified> |
184 | |
185 | =head1 AUTHORS |
186 | |
187 | Sebastian Riedel, <sri@cpan.org> |
188 | |
189 | Andy Grundman, <andy@hybridized.org> |
190 | |
191 | =head1 THANKS |
192 | |
193 | Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent. |
194 | |
195 | =head1 COPYRIGHT |
196 | |
197 | This program is free software, you can redistribute it and/or modify it under |
198 | the same terms as Perl itself. |
199 | |
200 | =cut |