lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm

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