X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FEngine%2FHTTP.pm;h=8f08b8f926e3d968de3061e3c1402424aacc4216;hp=de1681b96d6b73394f9309788582d006af844bc0;hb=65586a18685daa023a1a623cf228943e4a4f830d;hpb=4c980e7668ca115edb52d7ec19a8d769fc73532c diff --git a/lib/Catalyst/Engine/HTTP.pm b/lib/Catalyst/Engine/HTTP.pm index de1681b..8f08b8f 100644 --- a/lib/Catalyst/Engine/HTTP.pm +++ b/lib/Catalyst/Engine/HTTP.pm @@ -3,9 +3,6 @@ package Catalyst::Engine::HTTP; 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; @@ -112,55 +109,6 @@ sub run { 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/"$files" modified, restarting\n\n/; - kill( 1, $parent ); - exit; - } - } - } - } our $GOT_HUP; local $GOT_HUP = 0; @@ -282,20 +230,6 @@ sub run { } } -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 ) = @_; @@ -311,69 +245,6 @@ sub _get_line { return $line; } -# The list of files/directories we check for modification -our $file_index; - -sub _index { - my ( $dir, $regex ) = @_; - - if ( ref $file_index ) { - # don't run a File::Find, but just check file/dir mod times - my %index = %{$file_index}; - foreach my $file ( keys %index ) { - if ( my @stat = stat $file ) { - $index{$file} = $stat[9]; - } - else { - delete $index{$file}; - } - } - return \%index; - } - else { - # first time, run a File::Find to locate files and dirs to watch - my $index = {}; - finddepth( - { - wanted => sub { - my $file = File::Spec->rel2abs($File::Find::name); - $file =~ s{/script/..}{}; - return unless $file =~ /$regex/; - return unless -f $file; - $index->{$file} = ( stat $file )[9]; - - # also watch the directory the file is in - my $cur_dir = File::Spec->rel2abs($File::Find::dir); - $cur_dir =~ s{/script/..}{}; - unless ( $index->{$cur_dir} ) { - $index->{$cur_dir} = ( stat $cur_dir )[9]; - } - }, - no_chdir => 1 - }, - $dir - ); - $file_index = $index; - return $file_index; - } -} - -sub _test { - my $file = shift; - delete $INC{$file}; - - # if the file has been deleted, don't try to test it - return 0 unless -f $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