Fix background option

[catagits/Catalyst-Runtime.git] / lib / Catalyst / Script / Server.pm

diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm
index 7d11111..d587b4f 100644 (file)
--- a/lib/Catalyst/Script/Server.pm
+++ b/lib/Catalyst/Script/Server.pm
@@ -1,10 +1,4 @@
 package Catalyst::Script::Server;
-
-BEGIN {
-    $ENV{CATALYST_ENGINE} ||= 'HTTP';
-    require Catalyst::Engine::HTTP;
-}
-
 use Moose;
 use MooseX::Types::Common::Numeric qw/PositiveInt/;
 use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/;
@@ -50,14 +44,37 @@ has port => (
     documentation => 'Specify a different listening port (to the default port 3000)',
 );
 
+use Moose::Util::TypeConstraints;
+class_type 'MooseX::Daemonize::Pid::File';
+subtype 'MyStr', as Str, where { 1 }; # FIXME - Fuck ugly!
+coerce 'MooseX::Daemonize::Pid::File', from 'MyStr', via {
+    Class::MOP::load_class("MooseX::Daemonize::Pid::File");
+    MooseX::Daemonize::Pid::File->new( file => $_ );
+};
+MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
+    'MooseX::Daemonize::Pid::File' => '=s',
+);
 has pidfile => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'pid',
-    isa           => Str,
+    isa           => 'MooseX::Daemonize::Pid::File',
     is            => 'ro',
     documentation => 'Specify a pidfile',
+    coerce        => 1,
+    predicate     => '_has_pidfile',
 );
 
+sub BUILD {
+    my $self = shift;
+    $self->pidfile->write
+        if $self->_has_pidfile;
+    if ($self->background) {
+        # FIXME - This is evil. Should we just add MX::Daemonize to the deps?
+        Class::MOP::load_class('MooseX::Daemonize::Core');
+        MooseX::Daemonize::Core->meta->apply($self);
+    }
+}
+
 has keepalive => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'k',
@@ -134,6 +151,11 @@ has follow_symlinks => (
     predicate     => '_has_follow_symlinks',
 );
 
+sub _plack_engine_name {
+    my $self = shift;
+    return $self->fork ? 'Starman' : $self->keepalive ? 'Starman' : 'Standalone';
+}
+
 sub _restarter_args {
     my $self = shift;
 
@@ -144,6 +166,9 @@ sub _restarter_args {
         ($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)
     );
 }
 
@@ -175,7 +200,7 @@ sub run {
         # fail.
         $| = 1 if $ENV{HARNESS_ACTIVE};
 
-        Catalyst::Utils::load_class($self->restarter_class);
+        Catalyst::Utils::ensure_class_loaded($self->restarter_class);
 
         my $subclass = $self->restarter_class->pick_subclass;
 
@@ -186,12 +211,40 @@ sub run {
         $restarter->run_and_watch;
     }
     else {
+        if ($self->background) {
+            $self->daemon_fork;
+
+            return 1 unless $self->is_daemon;
+
+            Class::MOP::load_class($self->application_name);
+
+            $self->daemon_detach;
+        }
+
         $self->_run_application;
     }
 
 
 }
 
+sub _plack_loader_args {
+    my ($self) = shift;
+    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";
+        },
+    );
+}
+
 sub _application_args {
     my ($self) = shift;
     return (