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