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

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