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 =head2 DETECT_PACKAGE_COMPILATION
 201
 202 Returns true if L<B::Hooks::OP::Check::StashChange> is installed and
 203 can be used to detect when files are compiled. This is used internally
 204 to make the L<Moose> metaclass of any class being reloaded immutable.
 205
 206 If L<B::Hooks::OP::Check::StashChange> is not installed, then the
 207 restarter makes all application components immutable. This covers the
 208 simple case, but is less useful if you're using Moose in components
 209 outside Catalyst's namespaces, but inside your application directory.
 210
 211 =head1 SEE ALSO
 212
 213 L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
 214
 215 =head1 AUTHORS
 216
 217 Catalyst Contributors, see Catalyst.pm
 218
 219 =head1 THANKS
 220
 221 Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
 222
 223 =head1 COPYRIGHT
 224
 225 This program is free software, you can redistribute it and/or modify it under
 226 the same terms as Perl itself.
 227
 228 =cut