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;
# A very very simple HTTP server that initializes a CGI environment
sub run {
- my ( $self, $class, $port, $host, $fork ) = @_;
+ my ( $self, $class, $port, $host, $options ) = @_;
our $GOT_HUP;
local $GOT_HUP = 0;
local $SIG{HUP} = sub { $GOT_HUP = 1; };
- local $SIG{CHLD} = 'IGNORE';
+ # Setup restarter
+ my $restarter;
+ if ( $options->{restart} ) {
+ my $parent = $$;
+ unless ( $restarter = fork ) {
+
+ # Index parent directory
+ my $dir = File::Spec->catdir( $FindBin::Bin, '..' );
+
+ my $regex = $options->{restart_regex};
+ my $one = _index( $dir, $regex );
+ while (1) {
+ sleep $options->{restart_delay};
+ my $two = _index( $dir, $regex );
+ if ( my $file = _compare_index( $one, $two ) ) {
+ print STDERR qq/File "$file" modified, restarting\n/;
+ kill( 1, $parent );
+ $one = $two;
+ }
+ }
+ }
+ }
# Handle requests
while ( accept( Remote, HTTPDaemon ) ) {
# Fork
- if ($fork) { next if $pid = fork }
+ if ( $options->{fork} ) { next if $pid = fork }
close HTTPDaemon if defined $pid;
close Remote;
}
close HTTPDaemon;
+
exec {$0}( ( ( -x $0 ) ? () : ($^X) ), $0, @ARGV ) if $GOT_HUP;
}
+sub _compare_index {
+ my ( $one, $two ) = @_;
+ my %clone = %$two;
+ while ( my ( $key, $val ) = each %$one ) {
+ return $key if ( !$clone{$key} || ( $clone{$key} ne $val ) );
+ delete $clone{$key};
+ }
+ if ( keys %clone ) {
+ return join ' ', keys %clone;
+ }
+ return 0;
+}
+
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;
+}
+
=back
=head1 SEE ALSO
use lib "$FindBin::Bin/../lib";
use [% name %];
-my $fork = 0;
-my $help = 0;
-my $host = undef;
-my $port = 3000;
+my $fork = 0;
+my $help = 0;
+my $host = undef;
+my $port = 3000;
+my $restart = 0;
+my $restart_delay = 1;
+my $restart_regex = '\.yml$|\.yaml$|\.pm$';
GetOptions(
- 'fork' => \$fork,
- 'help|?' => \$help,
- 'host=s' => \$host,
- 'port=s' => \$port
+ 'fork' => \$fork,
+ 'help|?' => \$help,
+ 'host=s' => \$host,
+ 'port=s' => \$port,
+ 'restart|r' => \$restart,
+ 'restartdelay|rd=s' => \$restart_delay,
+ 'restartregex|rr=s' => \$restart_regex
);
pod2usage(1) if $help;
-[% name %]->run( $port, $host, $fork );
+[% name %]->run( $port, $host, {
+ 'fork' => $fork,
+ restart => $restart,
+ restart_delay => $restart_delay,
+ restart_regex => qr/$restart_regex/
+} );
1;
[% appprefix %]_server.pl [options]
Options:
- -f -fork handle each request in a new process
- -? -help display this help and exits
- -host host (defaults to all)
- -p -port port (defaults to 3000)
+ -f -fork handle each request in a new process
+ (defaults to false)
+ -? -help display this help and exits
+ -host host (defaults to all)
+ -p -port port (defaults to 3000)
+ -r -restart restart when files got modified
+ (defaults to false)
+ -rd -restartdelay delay between file checks
+ -rr -restartregex regex match files that trigger
+ a restart when modified
+ (defaults to '\.yml$|\.yaml$|\.pm$')
See also:
perldoc Catalyst::Manual