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             }
 149         });
 150     }
 151
 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