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) { # A little paranoia here - Moose::Meta::Role has neither of these methods.
 145                 my $is_immutable = $meta->can('is_immutable');
 146                 my $make_mutable = $meta->can('make_mutable');
 147                 $meta->$make_mutable() if $is_immutable && $make_mutable && $meta->$is_immutable();
 148                 eval { # Do not explode the watcher process if this fails.
 149                     my $superclasses = $meta->can('superclasses');
 150                     $meta->$superclasses('Moose::Object') if $superclasses;
 151                 };
 152             }
 153         });
 154     }
 155
 156     local $Catalyst::__AM_RESTARTING = 1; # Hack to avoid C3 fail
 157     delete $INC{$file}; # Remove from %INC so it will reload
 158     local $SIG{__WARN__} = sub { };
 159
 160     open my $olderr, '>&STDERR';
 161     open STDERR, '>', File::Spec->devnull;
 162     eval "require '$file'";
 163     open STDERR, '>&', $olderr;
 164
 165     B::Hooks::OP::Check::StashChange::unregister($id) if $id;
 166
 167     return ($@) ? $@ : 0;
 168 }
 169
 170 1;
 171 __END__
 172
 173 =head1 NAME
 174
 175 Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application
 176 files
 177
 178 =head1 SYNOPSIS
 179
 180     my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
 181         directory => '/path/to/MyApp',
 182         regex     => '\.yml$|\.yaml$|\.conf|\.pm$',
 183         delay     => 1,
 184     );
 185
 186     while (1) {
 187         my @changed_files = $watcher->watch();
 188     }
 189
 190 =head1 DESCRIPTION
 191
 192 This class monitors a directory of files for changes made to any file
 193 matching a regular expression.  It correctly handles new files added to the
 194 application as well as files that are deleted.
 195
 196 =head1 METHODS
 197
 198 =head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
 199
 200 Creates a new Watcher object.
 201
 202 =head2 watch
 203
 204 Returns a list of files that have been added, deleted, or changed since the
 205 last time watch was called.
 206
 207 =head2 DETECT_PACKAGE_COMPILATION
 208
 209 Returns true if L<B::Hooks::OP::Check::StashChange> is installed and
 210 can be used to detect when files are compiled. This is used internally
 211 to make the L<Moose> metaclass of any class being reloaded immutable.
 212
 213 If L<B::Hooks::OP::Check::StashChange> is not installed, then the
 214 restarter makes all application components immutable. This covers the
 215 simple case, but is less useful if you're using Moose in components
 216 outside Catalyst's namespaces, but inside your application directory.
 217
 218 =head1 SEE ALSO
 219
 220 L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
 221
 222 =head1 AUTHORS
 223
 224 Catalyst Contributors, see Catalyst.pm
 225
 226 =head1 THANKS
 227
 228 Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
 229
 230 =head1 COPYRIGHT
 231
 232 This program is free software, you can redistribute it and/or modify it under
 233 the same terms as Perl itself.
 234
 235 =cut