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

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