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