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