Hacking the server script
Tomas Doran [Mon, 18 Jul 2011 22:13:51 +0000 (23:13 +0100)]
TODO
lib/Catalyst/Script/Server.pm

diff --git a/TODO b/TODO
index c131e71..302bf1a 100644 (file)
--- a/TODO
+++ b/TODO
@@ -45,11 +45,9 @@ Although --pidfile is supported --pid seems to be preferred, and if we are bothe
 
 ##### myapp_web_server.pl
 
---fork, this gets passed and Plack doesn’t complain, but it doesn’t fork.  Maybe we could just detect this switch and complain about it (say you should use plackup and Starman, for example?)
+--pidfile handling is shiit. MooseX::Daemonize will blow up really nastilly if not installed..
 
---keepalive, passed, no complaint but doesn’t really seem to do anything.
-
---pidfile, --background, these also seem to do nothing.
+ --background seem to does nothing.
 
 ###  Nice to have
 
index 0f55d86..700ba55 100644 (file)
@@ -5,8 +5,6 @@ use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/;
 use Catalyst::Utils;
 use namespace::autoclean;
 
-sub _plack_engine_name { 'Standalone' }
-
 with 'Catalyst::ScriptRole';
 
 has debug => (
@@ -46,14 +44,32 @@ 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;
+}
+
 has keepalive => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'k',
@@ -130,6 +146,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;