X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FScript%2FServer.pm;h=1848e4a7e61ec9e7ced60db8d7c983a9c72e8965;hp=619177d1b538f0a19d4eeea9223772d0059b8e62;hb=35b3434762d426e0cd5e04eb735291f8ca7ea08e;hpb=abee32cb2343c5ce0eb3fc92d403d6d535a66e0f diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm index 619177d..1848e4a 100644 --- a/lib/Catalyst/Script/Server.pm +++ b/lib/Catalyst/Script/Server.pm @@ -1,249 +1,313 @@ package Catalyst::Script::Server; - -BEGIN { - $ENV{CATALYST_ENGINE} ||= 'HTTP'; - $ENV{CATALYST_SCRIPT_GEN} = 31; - require Catalyst::Engine::HTTP; -} - -use FindBin qw/$Bin/; -use lib "$Bin/../lib"; -use Pod::Usage; use Moose; -use Catalyst::Restarter; -#use Catalyst::Engine::HTTP; +use Catalyst::Utils; +use Class::Load qw(try_load_class load_class); use namespace::autoclean; -with 'MooseX::Getopt'; +with 'Catalyst::ScriptRole'; has debug => ( - traits => [qw(Getopt)], - cmd_aliases => 'd', - isa => 'Bool', - is => 'ro', - documentation => qq{ - -d --debug force debug mode - } - -); - -has help => ( - traits => [qw(Getopt)], - cmd_aliases => 'h', - isa => 'Bool', - is => 'ro', - documentation => qq{ - -h --help display this help and exits - }, + traits => [qw(Getopt)], + cmd_aliases => 'd', + isa => 'Bool', + is => 'ro', + documentation => q{Force debug mode}, ); has host => ( - isa => 'Str', - is => 'ro', - , - default => "localhost" + traits => [qw(Getopt)], + cmd_aliases => 'h', + isa => 'Str', + is => 'ro', + # N.B. undef (the default) means we bind on all interfaces on the host. + documentation => 'Specify a hostname or IP on this host for the server to bind to', ); has fork => ( - traits => [qw(Getopt)], - cmd_aliases => 'f', - isa => 'Bool', - is => 'ro', - + traits => [qw(Getopt)], + cmd_aliases => 'f', + isa => 'Bool', + is => 'ro', + default => 0, + documentation => 'Fork the server to be able to serve multiple requests at once', ); -has listen => ( - traits => [qw(Getopt)], - cmd_aliases => 'l', - isa => 'Int', - is => 'ro', - , - default => "3000" +has port => ( + traits => [qw(Getopt)], + cmd_aliases => 'p', + isa => 'Int', + is => 'ro', + default => sub { + Catalyst::Utils::env_value(shift->application_name, 'port') || 3000 + }, + documentation => 'Specify a different listening port (to the default port 3000)', ); +use Moose::Util::TypeConstraints; +class_type 'MooseX::Daemonize::Pid::File'; +subtype 'Catalyst::Script::Server::Types::Pidfile', + as 'MooseX::Daemonize::Pid::File'; + +coerce 'Catalyst::Script::Server::Types::Pidfile', from 'Str', via { + my ($success, $error) = try_load_class("MooseX::Daemonize::Pid::File"); + warn("Could not load MooseX::Daemonize::Pid::File, needed for --pid option: $error\n"), + exit 1 if not $success; + MooseX::Daemonize::Pid::File->new( file => $_ ); +}; +MooseX::Getopt::OptionTypeMap->add_option_type_to_map( + 'Catalyst::Script::Server::Types::Pidfile' => '=s', +); has pidfile => ( - traits => [qw(Getopt)], - cmd_aliases => 'pid', - isa => 'Str', - is => 'ro', - + traits => [qw(Getopt)], + cmd_aliases => 'pid', + isa => 'Catalyst::Script::Server::Types::Pidfile', + is => 'ro', + documentation => 'Specify a pidfile', + coerce => 1, + predicate => '_has_pidfile', ); -has keepalive => ( - traits => [qw(Getopt)], - cmd_aliases => 'k', - isa => 'Bool', - is => 'ro', - , +# Override MooseX::Daemonize +sub dont_close_all_files { 1 } +sub BUILD { + my $self = shift; -); + if ($self->background) { + # FIXME - This is evil. Should we just add MX::Daemonize to the deps? + my ($success, $error) = try_load_class("MooseX::Daemonize::Core"); + warn("MooseX::Daemonize is needed for the --background option: $error\n"), + exit 1 if not $success; + my ($success, $error) = try_load_class("POSIX"); + warn("$error\n"), exit 1 if not $success; + MooseX::Daemonize::Core->meta->apply($self); + POSIX::close($_) foreach (0..2); + } +} -has background => ( - traits => [qw(Getopt)], - cmd_aliases => 'bg', - isa => 'Bool', - is => 'ro', +has keepalive => ( + traits => [qw(Getopt)], + cmd_aliases => 'k', + isa => 'Bool', + is => 'ro', + default => 0, + documentation => 'Support keepalive', ); - -has _app => ( - reader => 'app', - init_arg => 'app', - traits => [qw(NoGetopt)], - isa => 'Str', - is => 'ro', +has background => ( + traits => [qw(Getopt)], + cmd_aliases => 'bg', + isa => 'Bool', + is => 'ro', + default => 0, + documentation => 'Run in the background', ); has restart => ( - traits => [qw(Getopt)], - cmd_aliases => 'r', - isa => 'Bool', - is => 'ro', - + traits => [qw(Getopt)], + cmd_aliases => 'r', + isa => 'Bool', + is => 'ro', + default => sub { + Catalyst::Utils::env_value(shift->application_name, 'reload') || 0; + }, + documentation => 'use Catalyst::Restarter to detect code changes and restart the application', ); has restart_directory => ( - traits => [qw(Getopt)], - cmd_aliases => 'rdir', - isa => 'ArrayRef[Str]', - is => 'ro', - predicate => '_has_restart_directory', + traits => [qw(Getopt)], + cmd_aliases => [ 'rdir', 'restartdirectory' ], + isa => 'ArrayRef[Str]', + is => 'ro', + documentation => 'Restarter directory to watch', + predicate => '_has_restart_directory', ); has restart_delay => ( - traits => [qw(Getopt)], - cmd_aliases => 'rdel', - isa => 'Int', - is => 'ro', - predicate => '_has_restart_delay', + traits => [qw(Getopt)], + cmd_aliases => 'rd', + isa => 'Int', + is => 'ro', + documentation => 'Set a restart delay', + predicate => '_has_restart_delay', ); -has restart_regex => ( - traits => [qw(Getopt)], - cmd_aliases => 'rxp', - isa => 'Str', - is => 'ro', - predicate => '_has_restart_regex', -); +{ + use Moose::Util::TypeConstraints; -has follow_symlinks => ( - traits => [qw(Getopt)], - cmd_aliases => 'sym', - isa => 'Bool', - is => 'ro', - predicate => '_has_follow_symlinks', + my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as 'RegexpRef'; + coerce $tc, from 'Str', via { qr/$_/ }; -); + MooseX::Getopt::OptionTypeMap->add_option_type_to_map($tc => '=s'); -sub usage { - my ($self) = shift; + has restart_regex => ( + traits => [qw(Getopt)], + cmd_aliases => 'rr', + isa => $tc, + coerce => 1, + is => 'ro', + documentation => 'Restart regex', + predicate => '_has_restart_regex', + ); +} - return pod2usage(); +has follow_symlinks => ( + traits => [qw(Getopt)], + cmd_aliases => 'sym', + isa => 'Bool', + is => 'ro', + default => 0, + documentation => 'Follow symbolic links', + predicate => '_has_follow_symlinks', +); +sub _plack_engine_name { + my $self = shift; + return $self->fork || $self->keepalive ? 'Starman' : 'Standalone'; } -my @argv = @ARGV; - -sub run { +sub _restarter_args { my $self = shift; - $self->usage if $self->help; + return ( + argv => $self->ARGV, + start_sub => sub { $self->_run_application }, + ($self->_has_follow_symlinks ? (follow_symlinks => $self->follow_symlinks) : ()), + ($self->_has_restart_delay ? (sleep_interval => $self->restart_delay) : ()), + ($self->_has_restart_directory ? (directories => $self->restart_directory) : ()), + ($self->_has_restart_regex ? (filter => $self->restart_regex) : ()), + ), + ( + map { $_ => $self->$_ } qw(application_name host port debug pidfile fork background keepalive) + ); +} - if ( $self->debug ) { - $ENV{CATALYST_DEBUG} = 1; +has restarter_class => ( + is => 'ro', + isa => 'Str', + lazy => 1, + default => sub { + my $self = shift; + Catalyst::Utils::env_value($self->application_name, 'RESTARTER') || 'Catalyst::Restarter'; } +); - # If we load this here, then in the case of a restarter, it does not - # need to be reloaded for each restart. - require Catalyst; +sub run { + my $self = shift; - # If this isn't done, then the Catalyst::Devel tests for the restarter - # fail. - $| = 1 if $ENV{HARNESS_ACTIVE}; + local $ENV{CATALYST_DEBUG} = 1 + if $self->debug; if ( $self->restart ) { die "Cannot run in the background and also watch for changed files.\n" if $self->background; + die "Cannot write out a pid file and fork for the restarter.\n" + if $self->_has_pidfile; + + # If we load this here, then in the case of a restarter, it does not + # need to be reloaded for each restart. + require Catalyst; - require Catalyst::Restarter; + # If this isn't done, then the Catalyst::Devel tests for the restarter + # fail. + $| = 1 if $ENV{HARNESS_ACTIVE}; - my $subclass = Catalyst::Restarter->pick_subclass; + Catalyst::Utils::ensure_class_loaded($self->restarter_class); - my %args; - $args{follow_symlinks} = $self->follow_symlinks - if $self->_has_follow_symlinks; - $args{directories} = $self->restart_directory - if $self->_has_restart_directory; - $args{sleep_interval} = $self->restart_delay - if $self->_has_restart_delay; - $args{filter} = qr/$self->restart_regex/ - if $self->_has_restart_regex; + my $subclass = $self->restarter_class->pick_subclass; my $restarter = $subclass->new( - %args, - start_sub => sub { $self->_run }, - argv => $self->ARGV, + $self->_restarter_args() ); $restarter->run_and_watch; } else { - $self->_run; + if ($self->background) { + $self->daemon_fork; + + return 1 unless $self->is_daemon; + + load_class($self->application_name); + + $self->daemon_detach; + } + + $self->pidfile->write + if $self->_has_pidfile; + + $self->_run_application; } } -sub _run { +sub _plack_loader_args { my ($self) = shift; - - my $app = $self->app; - Class::MOP::load_class($app); - - $app->run( - $self->listen, $self->host, - { - 'fork' => $self->fork, - keepalive => $self->keepalive, - background => $self->background, - pidfile => $self->pidfile, - keepalive => $self->keepalive, - follow_symlinks => $self->follow_symlinks, - } + return ( + port => $self->port, + host => $self->host, + keepalive => $self->keepalive ? 100 : 1, + server_ready => sub { + my ($args) = @_; + + my $name = $args->{server_software} || ref($args); # $args is $server + my $host = $args->{host} || 0; + my $proto = $args->{proto} || 'http'; + + print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; + }, ); } +around _application_args => sub { + my ($orig, $self) = @_; + return ( + $self->port, + $self->host, + { + %{ $self->$orig }, + map { $_ => $self->$_ } qw/ + fork + keepalive + background + pidfile + keepalive + follow_symlinks + port + host + /, + }, + ); +}; -no Moose; __PACKAGE__->meta->make_immutable; - 1; =head1 NAME -[% appprefix %]_server.pl - Catalyst Testserver +Catalyst::Script::Server - Catalyst test server =head1 SYNOPSIS -[% appprefix %]_server.pl [options] + myapp_server.pl [options] Options: -d --debug force debug mode -f --fork handle each request in a new process (defaults to false) - -h --help display this help and exits - --host host (defaults to all) + --help display this help and exits + -h --host host (defaults to all) -p --port port (defaults to 3000) -k --keepalive enable keep-alive connections -r --restart restart when files get modified (defaults to false) - --rd --restartdelay delay between file checks + --rd --restart_delay delay between file checks (ignored if you have Linux::Inotify2 installed) - --rr --restartregex regex match files that trigger + --rr --restart_regex regex match files that trigger a restart when modified (defaults to '\.yml$|\.yaml$|\.conf|\.pm$') - --rdir --restartdirectory the directory to search for - modified files, can be set mulitple times + --rdir --restart_directory the directory to search for + modified files, can be set multiple times (defaults to '[SCRIPT_DIR]/..') --sym --follow_symlinks follow symlinks in search directories (defaults to false. this is a no-op on Win32) @@ -256,7 +320,11 @@ __PACKAGE__->meta->make_immutable; =head1 DESCRIPTION -Run a Catalyst Testserver for this application. +Run a Catalyst test server for this application. + +=head1 SEE ALSO + +L =head1 AUTHORS