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