'Class::Data::Inheritable' => 0,
'Class::Inspector' => 0,
'CGI::Cookie' => 0,
+ 'File::Modified' => 0,
'HTML::Entities' => 0,
'HTTP::Body' => 0.03,
'HTTP::Headers' => 1.59,
'Template' => 0,
'Text::ASCIITable' => 0.17,
'Test::MockObject' => 0,
+ 'Time::HiRes' => 0,
'Tree::Simple' => 0,
'Tree::Simple::Visitor::FindByPath' => 0,
'URI' => 1.35,
use strict;
use base 'Catalyst::Engine::CGI';
use Errno 'EWOULDBLOCK';
-use FindBin;
-use File::Find;
-use File::Spec;
use HTTP::Status;
use NEXT;
use Socket;
my ( $self, $class, $port, $host, $options ) = @_;
$options ||= {};
-
- # Setup restarter
- my $restarter;
- if ( $options->{restart} ) {
- my $parent = $$;
- unless ( $restarter = fork ) {
-
- # Prepare
- close STDIN;
- close STDOUT;
-
- # Index parent directory
- my $dir = File::Spec->catdir( $FindBin::Bin, '..' );
-
- my $regex = $options->{restart_regex};
- my $one = _index( $dir, $regex );
- RESTART: while (1) {
- sleep $options->{restart_delay} || 1;
-
- # check if our parent has died
- exit if ( getppid == 1 );
-
- my $two = _index( $dir, $regex );
- my $changes = _compare_index( $one, $two );
- if (@$changes) {
- $one = $two;
-
- # Test modified pm's
- for my $file (@$changes) {
- next unless $file =~ /\.pm$/;
- if ( my $error = _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";
- next RESTART;
- }
- }
-
- # Restart
- my $files = join ', ', @$changes;
- print STDERR qq/File(s) "$files" modified, restarting\n\n/;
- kill( 1, $parent );
- exit;
- }
- }
- }
- }
our $GOT_HUP;
local $GOT_HUP = 0;
}
}
-sub _compare_index {
- my ( $one, $two ) = @_;
- my %clone = %$two;
- my @changes;
- while ( my ( $key, $val ) = each %$one ) {
- if ( !$clone{$key} || ( $clone{$key} ne $val ) ) {
- push @changes, $key;
- }
- delete $clone{$key};
- }
- for my $key ( keys %clone ) { push @changes, $key }
- return \@changes;
-}
-
sub _get_line {
my ( $self, $handle ) = @_;
return $line;
}
-sub _index {
- my ( $dir, $regex ) = @_;
- my %index;
- finddepth(
- {
- wanted => sub {
- my $file = File::Spec->rel2abs($File::Find::name);
- return unless $file =~ /$regex/;
- return unless -f $file;
- my $time = ( stat $file )[9];
- $index{$file} = $time;
- },
- no_chdir => 1
- },
- $dir
- );
- return \%index;
-}
-
-sub _test {
- my $file = shift;
- delete $INC{$file};
- local $SIG{__WARN__} = sub { };
- open my $olderr, '>&STDERR';
- open STDERR, '>', File::Spec->devnull;
- eval "require '$file'";
- open STDERR, '>&', $olderr;
- return $@ if $@;
- return 0;
-}
-
=back
=head1 SEE ALSO
--- /dev/null
+package Catalyst::Engine::HTTP::Restarter;
+
+use strict;
+use warnings;
+use base 'Catalyst::Engine::HTTP';
+use Catalyst::Engine::HTTP::Restarter::Watcher;
+use NEXT;
+
+sub run {
+ my ( $self, $class, $port, $host, $options ) = @_;
+
+ $options ||= {};
+
+ # Setup restarter
+ my $restarter;
+ my $parent = $$;
+
+ unless ( $restarter = fork ) {
+
+ # Prepare
+ close STDIN;
+ close STDOUT;
+
+ my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
+ directory => File::Spec->catdir( $FindBin::Bin, '..' ),
+ regex => $options->{restart_regex},
+ delay => $options->{restart_delay},
+ );
+
+ while (1) {
+ # poll for changed files
+ my @changed_files = $watcher->watch();
+
+ # check if our parent process has died
+ exit if ( 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/;
+ kill( 1, $parent );
+ exit;
+ }
+ }
+ }
+
+ return $self->NEXT::run( $class, $port, $host, $options );
+}
+
+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
+
+=over 4
+
+=item run
+
+=back
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine::HTTP>, L<Catalyst::Engine::CGI>,
+L<Catalyst::Engine>.
+
+=head1 AUTHORS
+
+Sebastian Riedel, <sri@cpan.org>
+
+Dan Kubb, <dan.kubb-cpan@onautopilot.com>
+
+Andy Grundman, <andy@hybridized.org>
+
+=head1 THANKS
+
+Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
+
+=head1 COPYRIGHT
+
+This program 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 strict;
+use warnings;
+use base 'Class::Accessor::Fast';
+use File::Find;
+use File::Modified;
+use File::Spec;
+use Time::HiRes qw/sleep/;
+
+__PACKAGE__->mk_accessors( qw/delay
+ directory
+ modified
+ regex
+ watch_list/ );
+
+sub new {
+ my ( $class, %args ) = @_;
+
+ my $self = { %args };
+
+ bless $self, $class;
+
+ $self->_init;
+
+ return $self;
+}
+
+sub _init {
+ my $self = shift;
+
+ my $watch_list = $self->_index_directory;
+ $self->watch_list( $watch_list );
+
+ $self->modified(
+ File::Modified->new(
+ method => 'mtime',
+ files => [ keys %{$watch_list} ],
+ )
+ );
+}
+
+sub watch {
+ my $self = shift;
+
+ my @changes;
+ my @changed_files;
+
+ sleep $self->delay || 1;
+
+ 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";
+ 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;
+ },
+ no_chdir => 1
+ },
+ $dir
+ );
+ return \%list;
+}
+
+sub _test {
+ my ( $self, $file ) = @_;
+
+ delete $INC{$file};
+ local $SIG{__WARN__} = sub { };
+
+ open my $olderr, '>&STDERR';
+ open STDERR, '>', File::Spec->devnull;
+ eval "require '$file'";
+ open STDERR, '>&', $olderr;
+
+ 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$|\.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.
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
+
+=head1 AUTHORS
+
+Sebastian Riedel, <sri@cpan.org>
+
+Andy Grundman, <andy@hybridized.org>
+
+=head1 THANKS
+
+Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
use Pod::Usage;
use FindBin;
use lib "$FindBin::Bin/../lib";
-use [% name %];
my $fork = 0;
my $help = 0;
pod2usage(1) if $help;
+if ( $restart ) {
+ $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
+}
+
+require [% name %];
+
[% name %]->run( $port, $host, {
argv => \@argv,
'fork' => $fork,
projects / catagits/Catalyst-Runtime.git / commitdiff