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