X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP%2FRestarter%2FWatcher.pm;fp=lib%2FCatalyst%2FEngine%2FHTTP%2FRestarter%2FWatcher.pm;h=0000000000000000000000000000000000000000;hb=371c6f1a20aa6e41a85958eaab9fc4faacf9ceab;hp=8890646ead541370ccc212e38e9bcbba8fa4dbf2;hpb=4ffa3785756fc4df4b834f936f1f3acfcf7116f0;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm b/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm deleted file mode 100644 index 8890646..0000000 --- a/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm +++ /dev/null @@ -1,230 +0,0 @@ -package Catalyst::Engine::HTTP::Restarter::Watcher; - -use Moose; -with 'MooseX::Emulate::Class::Accessor::Fast'; - -use File::Find; -use File::Modified; -use File::Spec; -use Time::HiRes qw/sleep/; -use Moose::Util qw/find_meta/; -use namespace::clean -except => 'meta'; - -BEGIN { - # If we can detect stash changes, then we do magic - # to make their metaclass mutable (if they have one) - # so that restarting works as expected. - eval { require B::Hooks::OP::Check::StashChange; }; - *DETECT_PACKAGE_COMPILATION = $@ - ? sub () { 0 } - : sub () { 1 } -} - -has delay => (is => 'rw'); -has regex => (is => 'rw'); -has modified => (is => 'rw', builder => '_build_modified', lazy => 1); -has directory => (is => 'rw'); -has watch_list => (is => 'rw', builder => '_build_watch_list', lazy => 1); -has follow_symlinks => (is => 'rw'); - -sub _build_watch_list { - my ($self) = @_; - return $self->_index_directory; -} - -sub _build_modified { - my ($self) = @_; - return File::Modified->new( - method => 'mtime', - files => [ keys %{ $self->watch_list } ], - ); -} - -sub watch { - my $self = shift; - - my @changes; - my @changed_files; - - my $delay = ( defined $self->delay ) ? $self->delay : 1; - - sleep $delay if $delay > 0; - - eval { @changes = $self->modified->changed }; - if ($@) { - - # File::Modified will die if a file is deleted. - my ($deleted_file) = $@ =~ /stat '(.+)'/; - push @changed_files, $deleted_file || 'unknown file'; - } - - if (@changes) { - - # update all mtime information - $self->modified->update; - - # check if any files were changed - @changed_files = grep { -f $_ } @changes; - - # Check if only directories were changed. This means - # a new file was created. - unless (@changed_files) { - - # re-index to find new files - my $new_watch = $self->_index_directory; - - # look through the new list for new files - my $old_watch = $self->watch_list; - @changed_files = grep { !defined $old_watch->{$_} } - keys %{$new_watch}; - - return unless @changed_files; - } - - # Test modified pm's - for my $file (@changed_files) { - next unless $file =~ /\.pm$/; - if ( my $error = $self->_test($file) ) { - print STDERR qq/File "$file" modified, not restarting\n\n/; - print STDERR '*' x 80, "\n"; - print STDERR $error; - print STDERR '*' x 80, "\n"; - return; - } - } - } - - return @changed_files; -} - -sub _index_directory { - my $self = shift; - - my $dir = $self->directory; - die "No directory specified" if !$dir or ref($dir) && !@{$dir}; - - my $regex = $self->regex || '\.pm$'; - my %list; - - finddepth( - { - wanted => sub { - my $file = File::Spec->rel2abs($File::Find::name); - return unless $file =~ /$regex/; - return unless -f $file; - $file =~ s{/script/..}{}; - $list{$file} = 1; - - # also watch the directory for changes - my $cur_dir = File::Spec->rel2abs($File::Find::dir); - $cur_dir =~ s{/script/..}{}; - $list{$cur_dir} = 1; - }, - follow_fast => $self->follow_symlinks ? 1 : 0, - no_chdir => 1 - }, - ref $dir eq 'ARRAY' ? @{$dir} : $dir - ); - return \%list; -} - -sub _test { - my ( $self, $file ) = @_; - - my $id; - if (DETECT_PACKAGE_COMPILATION) { - $id = B::Hooks::OP::Check::StashChange::register(sub { - my ($new, $old) = @_; - my $meta = find_meta($new); - if ($meta) { # A little paranoia here - Moose::Meta::Role has neither of these methods. - my $is_immutable = $meta->can('is_immutable'); - my $make_mutable = $meta->can('make_mutable'); - $meta->$make_mutable() if $is_immutable && $make_mutable && $meta->$is_immutable(); - eval { # Do not explode the watcher process if this fails. - my $superclasses = $meta->can('superclasses'); - $meta->$superclasses('Moose::Object') if $superclasses; - }; - } - }); - } - - local $Catalyst::__AM_RESTARTING = 1; # Hack to avoid C3 fail - delete $INC{$file}; # Remove from %INC so it will reload - local $SIG{__WARN__} = sub { }; - - open my $olderr, '>&STDERR'; - open STDERR, '>', File::Spec->devnull; - eval "require '$file'"; - open STDERR, '>&', $olderr; - - B::Hooks::OP::Check::StashChange::unregister($id) if $id; - - return ($@) ? $@ : 0; -} - -1; -__END__ - -=head1 NAME - -Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application -files - -=head1 SYNOPSIS - - my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new( - directory => '/path/to/MyApp', - regex => '\.yml$|\.yaml$|\.conf|\.pm$', - delay => 1, - ); - - while (1) { - my @changed_files = $watcher->watch(); - } - -=head1 DESCRIPTION - -This class monitors a directory of files for changes made to any file -matching a regular expression. It correctly handles new files added to the -application as well as files that are deleted. - -=head1 METHODS - -=head2 new ( directory => $path [, regex => $regex, delay => $delay ] ) - -Creates a new Watcher object. - -=head2 watch - -Returns a list of files that have been added, deleted, or changed since the -last time watch was called. - -=head2 DETECT_PACKAGE_COMPILATION - -Returns true if L is installed and -can be used to detect when files are compiled. This is used internally -to make the L metaclass of any class being reloaded immutable. - -If L is not installed, then the -restarter makes all application components immutable. This covers the -simple case, but is less useful if you're using Moose in components -outside Catalyst's namespaces, but inside your application directory. - -=head1 SEE ALSO - -L, L, L - -=head1 AUTHORS - -Catalyst Contributors, see Catalyst.pm - -=head1 THANKS - -Many parts are ripped out of C by Jesse Vincent. - -=head1 COPYRIGHT - -This library is free software. You can redistribute it and/or modify it under -the same terms as Perl itself. - -=cut