+++ /dev/null
-package Catalyst::Engine::HTTP::Restarter;
-use Moose;
-use Moose::Util qw/find_meta/;
-use namespace::clean -except => 'meta';
-
-extends 'Catalyst::Engine::HTTP';
-
-use Catalyst::Engine::HTTP::Restarter::Watcher;
-
-around run => sub {
- my $orig = shift;
- my ( $self, $class, $port, $host, $options ) = @_;
-
- $options ||= {};
-
- # Setup restarter
- unless ( my $restarter = fork ) {
-
- # Prepare
- close STDIN;
- close STDOUT;
-
- # Avoid "Setting config after setup" error restarting MyApp.pm
- $class->setup_finished(0);
- # Best effort if we can't trap compiles..
- $self->_make_components_mutable($class)
- if !Catalyst::Engine::HTTP::Restarter::Watcher::DETECT_PACKAGE_COMPILATION;
-
- my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
- directory => (
- $options->{restart_directory} ||
- File::Spec->catdir( $FindBin::Bin, '..' )
- ),
- follow_symlinks => $options->{follow_symlinks},
- regex => $options->{restart_regex},
- delay => $options->{restart_delay},
- );
-
- $host ||= '127.0.0.1';
- while (1) {
-
- # poll for changed files
- my @changed_files = $watcher->watch();
-
- # check if our parent process has died
- exit if $^O ne 'MSWin32' and getppid == 1;
-
- # Restart if any files have changed
- if (@changed_files) {
- my $files = join ', ', @changed_files;
- print STDERR qq/File(s) "$files" modified, restarting\n\n/;
-
- require IO::Socket::INET;
- require HTTP::Headers;
- require HTTP::Request;
-
- my $client = IO::Socket::INET->new(
- PeerAddr => $host,
- PeerPort => $port
- )
- or die "Can't create client socket (is server running?): ",
- $!;
-
- # build the Kill request
- my $req =
- HTTP::Request->new( 'RESTART', '/',
- HTTP::Headers->new( 'Connection' => 'close' ) );
- $req->protocol('HTTP/1.0');
-
- $client->send( $req->as_string )
- or die "Can't send restart instruction: ", $!;
- $client->close();
- exit;
- }
- }
- }
-
- return $self->$orig( $class, $port, $host, $options );
-};
-
-# Naive way of trying to avoid Moose blowing up when you re-require components
-# which have been made immutable.
-sub _make_components_mutable {
- my ($self, $class) = @_;
-
- my @metas = grep { defined($_) }
- map { find_meta($_) }
- ($class, map { blessed($_) }
- values %{ $class->components });
-
- foreach my $meta (@metas) {
- # Paranoia unneeded, all component metaclasses should have immutable
- $meta->make_mutable if $meta->is_immutable;
- }
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Catalyst::Engine::HTTP::Restarter - Catalyst Auto-Restarting HTTP Engine
-
-=head1 SYNOPSIS
-
- script/myapp_server.pl -restart
-
-=head1 DESCRIPTION
-
-The Restarter engine will monitor files in your application for changes
-and restart the server when any changes are detected.
-
-=head1 METHODS
-
-=head2 run
-
-=head1 SEE ALSO
-
-L<Catalyst>, L<Catalyst::Engine::HTTP>, L<Catalyst::Engine::CGI>,
-L<Catalyst::Engine>.
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 THANKS
-
-Many parts are ripped out of C<HTTP::Server::Simple> 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
+++ /dev/null
-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<B::Hooks::OP::Check::StashChange> is installed and
-can be used to detect when files are compiled. This is used internally
-to make the L<Moose> metaclass of any class being reloaded immutable.
-
-If L<B::Hooks::OP::Check::StashChange> 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<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
-
-=head1 AUTHORS
-
-Catalyst Contributors, see Catalyst.pm
-
-=head1 THANKS
-
-Many parts are ripped out of C<HTTP::Server::Simple> 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
projects / catagits/Catalyst-Runtime.git / commitdiff