File Coverage

blib/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm
Criterion Covered Total %
statement 21 84 25.0
branch 0 22 0.0
condition 0 6 0.0
subroutine 7 14 50.0
pod 2 2 100.0
total 30 128 23.4


line stmt bran cond sub pod time code
1             package Catalyst::Engine::HTTP::Restarter::Watcher;
2              
3 1     1   15 use strict;
  1         25  
  1         16  
4 1     1   17 use warnings;
  1         10  
  1         16  
5 1     1   15 use base 'Class::Accessor::Fast';
  1         9  
  1         15  
6 1     1   15 use File::Find;
  1         9  
  1         22  
7 1     1   38 use File::Modified;
  1         10  
  1         19  
8 1     1   18 use File::Spec;
  1         10  
  1         20  
9 1     1   15 use Time::HiRes qw/sleep/;
  1         9  
  1         18  
10              
11             __PACKAGE__->mk_accessors(
12                 qw/delay
13             directory
14             modified
15             regex
16             watch_list/
17             );
18              
19             sub new {
20 0     0 1       my ( $class, %args ) = @_;
21              
22 0               my $self = {%args};
23              
24 0               bless $self, $class;
25              
26 0               $self->_init;
27              
28 0               return $self;
29             }
30              
31             sub _init {
32 0     0         my $self = shift;
33              
34 0               my $watch_list = $self->_index_directory;
35 0               $self->watch_list($watch_list);
36              
37 0               $self->modified(
38                     File::Modified->new(
39                         method => 'mtime',
40 0                       files => [ keys %{$watch_list} ],
41                     )
42                 );
43             }
44              
45             sub watch {
46 0     0 1       my $self = shift;
47              
48 0               my @changes;
49 0               my @changed_files;
50                 
51 0 0             my $delay = ( defined $self->delay ) ? $self->delay : 1;
52              
53 0 0             sleep $delay if $delay > 0;
54              
55 0               eval { @changes = $self->modified->changed };
  0            
56 0 0             if ($@) {
57              
58             # File::Modified will die if a file is deleted.
59 0                   my ($deleted_file) = $@ =~ /stat '(.+)'/;
60 0   0               push @changed_files, $deleted_file || 'unknown file';
61                 }
62              
63 0 0             if (@changes) {
64              
65             # update all mtime information
66 0                   $self->modified->update;
67              
68             # check if any files were changed
69 0                   @changed_files = grep { -f $_ } @changes;
  0            
70              
71             # Check if only directories were changed. This means
72             # a new file was created.
73 0 0                 unless (@changed_files) {
74              
75             # re-index to find new files
76 0                       my $new_watch = $self->_index_directory;
77              
78             # look through the new list for new files
79 0                       my $old_watch = $self->watch_list;
80 0                       @changed_files = grep { !defined $old_watch->{$_} }
  0            
81 0                         keys %{$new_watch};
82              
83 0 0                     return unless @changed_files;
84                     }
85              
86             # Test modified pm's
87 0                   for my $file (@changed_files) {
88 0 0                     next unless $file =~ /\.pm$/;
89 0 0                     if ( my $error = $self->_test($file) ) {
90 0                           print STDERR qq/File "$file" modified, not restarting\n\n/;
91 0                           print STDERR '*' x 80, "\n";
92 0                           print STDERR $error;
93 0                           print STDERR '*' x 80, "\n";
94 0                           return;
95                         }
96                     }
97                 }
98              
99 0               return @changed_files;
100             }
101              
102             sub _index_directory {
103 0     0         my $self = shift;
104              
105 0   0           my $dir = $self->directory || die "No directory specified";
106 0   0           my $regex = $self->regex || '\.pm$';
107 0               my %list;
108              
109                 finddepth(
110                     {
111                         wanted => sub {
112 0     0                     my $file = File::Spec->rel2abs($File::Find::name);
113 0 0                         return unless $file =~ /$regex/;
114 0 0                         return unless -f $file;
115 0                           $file =~ s{/script/..}{};
116 0                           $list{$file} = 1;
117              
118             # also watch the directory for changes
119 0                           my $cur_dir = File::Spec->rel2abs($File::Find::dir);
120 0                           $cur_dir =~ s{/script/..}{};
121 0                           $list{$cur_dir} = 1;
122                         },
123 0                       no_chdir => 1
124                     },
125                     $dir
126                 );
127 0               return \%list;
128             }
129              
130             sub _test {
131 0     0         my ( $self, $file ) = @_;
132              
133 0               delete $INC{$file};
134 0     0         local $SIG{__WARN__} = sub { };
  0            
135              
136 0               open my $olderr, '>&STDERR';
137 0               open STDERR, '>', File::Spec->devnull;
138 0               eval "require '$file'";
139 0               open STDERR, '>&', $olderr;
140              
141 0 0             return ($@) ? $@ : 0;
142             }
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             );
159            
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
201