Updated catalyst.pl
[catagits/Catalyst-Runtime.git] / lib / Catalyst / Engine / HTTP / Restarter / Watcher.pm
CommitLineData
65586a18 1package Catalyst::Engine::HTTP::Restarter::Watcher;
2
3use strict;
4use warnings;
5use base 'Class::Accessor::Fast';
6use File::Find;
7use File::Modified;
8use File::Spec;
9use Time::HiRes qw/sleep/;
10
11__PACKAGE__->mk_accessors( qw/delay
12 directory
13 modified
14 regex
15 watch_list/ );
16
17sub 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
29sub _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
43sub 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
96sub _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
124sub _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
1381;
139__END__
140
141=head1 NAME
142
143Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application
144files
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
160This class monitors a directory of files for changes made to any file
161matching a regular expression. It correctly handles new files added to the
162application as well as files that are deleted.
163
164=head1 METHODS
165
166=head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
167
168Creates a new Watcher object.
169
170=head2 watch
171
172Returns a list of files that have been added, deleted, or changed since the
173last time watch was called.
174
175=head1 SEE ALSO
176
177L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
178
179=head1 AUTHORS
180
181Sebastian Riedel, <sri@cpan.org>
182
183Andy Grundman, <andy@hybridized.org>
184
185=head1 THANKS
186
187Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
188
189=head1 COPYRIGHT
190
191This program is free software, you can redistribute it and/or modify it under
192the same terms as Perl itself.
193
194=cut