X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FScript%2FServer.pm;h=983a995e42c0b721c286e3576caa713814a56801;hb=b007fcc611c8584b634e27a60ebfe5b6f518601a;hp=d587b4f6bdea3c788b3e2c0fdfe361943e974c17;hpb=07b56dc9ccb03a4fdd4cfe017cfc42359fe51529;p=catagits%2FCatalyst-Runtime.git

diff --git a/lib/Catalyst/Script/Server.pm b/lib/Catalyst/Script/Server.pm
index d587b4f..983a995 100644
--- a/lib/Catalyst/Script/Server.pm
+++ b/lib/Catalyst/Script/Server.pm
@@ -1,8 +1,7 @@
 package Catalyst::Script::Server;
 use Moose;
-use MooseX::Types::Common::Numeric qw/PositiveInt/;
-use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/;
 use Catalyst::Utils;
+use Class::Load qw(try_load_class load_class);
 use namespace::autoclean;
 
 with 'Catalyst::ScriptRole';
@@ -10,7 +9,7 @@ with 'Catalyst::ScriptRole';
 has debug => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'd',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
     documentation => q{Force debug mode},
 );
@@ -18,7 +17,7 @@ has debug => (
 has host => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'h',
-    isa           => Str,
+    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',
@@ -27,7 +26,7 @@ has host => (
 has fork => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'f',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
     default       => 0,
     documentation => 'Fork the server to be able to serve multiple requests at once',
@@ -36,8 +35,9 @@ has fork => (
 has port => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'p',
-    isa           => PositiveInt,
+    isa           => 'Int',
     is            => 'ro',
+    lazy          => 1,
     default       => sub {
         Catalyst::Utils::env_value(shift->application_name, 'port') || 3000
     },
@@ -46,39 +46,49 @@ has port => (
 
 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");
+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(
-    'MooseX::Daemonize::Pid::File' => '=s',
+    'Catalyst::Script::Server::Types::Pidfile' => '=s',
 );
 has pidfile => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'pid',
-    isa           => 'MooseX::Daemonize::Pid::File',
+    isa           => 'Catalyst::Script::Server::Types::Pidfile',
     is            => 'ro',
     documentation => 'Specify a pidfile',
     coerce        => 1,
     predicate     => '_has_pidfile',
 );
 
+# Override MooseX::Daemonize
+sub dont_close_all_files { 1 }
 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');
+        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;
+        ($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 keepalive => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'k',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
     default       => 0,
     documentation => 'Support keepalive',
@@ -87,7 +97,7 @@ has keepalive => (
 has background => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'bg',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
     default       => 0,
     documentation => 'Run in the background',
@@ -96,8 +106,9 @@ has background => (
 has restart => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'r',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
+    lazy          => 1,
     default       => sub {
         Catalyst::Utils::env_value(shift->application_name, 'reload') || 0;
     },
@@ -107,7 +118,7 @@ has restart => (
 has restart_directory => (
     traits        => [qw(Getopt)],
     cmd_aliases   => [ 'rdir', 'restartdirectory' ],
-    isa           => ArrayRef[Str],
+    isa           => 'ArrayRef[Str]',
     is            => 'ro',
     documentation => 'Restarter directory to watch',
     predicate     => '_has_restart_directory',
@@ -116,7 +127,7 @@ has restart_directory => (
 has restart_delay => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'rd',
-    isa           => Int,
+    isa           => 'Int',
     is            => 'ro',
     documentation => 'Set a restart delay',
     predicate     => '_has_restart_delay',
@@ -125,8 +136,8 @@ has restart_delay => (
 {
     use Moose::Util::TypeConstraints;
 
-    my $tc = subtype as RegexpRef;
-    coerce $tc, from Str, via { qr/$_/ };
+    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');
 
@@ -144,7 +155,7 @@ has restart_delay => (
 has follow_symlinks => (
     traits        => [qw(Getopt)],
     cmd_aliases   => 'sym',
-    isa           => Bool,
+    isa           => 'Bool',
     is            => 'ro',
     default       => 0,
     documentation => 'Follow symbolic links',
@@ -153,7 +164,7 @@ has follow_symlinks => (
 
 sub _plack_engine_name {
     my $self = shift;
-    return $self->fork ? 'Starman' : $self->keepalive ? 'Starman' : 'Standalone';
+    return $self->fork || $self->keepalive ? 'Starman' : 'Standalone';
 }
 
 sub _restarter_args {
@@ -174,7 +185,7 @@ sub _restarter_args {
 
 has restarter_class => (
     is => 'ro',
-    isa => Str,
+    isa => 'Str',
     lazy => 1,
     default => sub {
         my $self = shift;
@@ -191,6 +202,8 @@ sub run {
     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.
@@ -216,11 +229,14 @@ sub run {
 
             return 1 unless $self->is_daemon;
 
-            Class::MOP::load_class($self->application_name);
+            load_class($self->application_name);
 
             $self->daemon_detach;
         }
 
+        $self->pidfile->write
+            if $self->_has_pidfile;
+
         $self->_run_application;
     }
 
@@ -245,13 +261,13 @@ sub _plack_loader_args {
     );
 }
 
-sub _application_args {
-    my ($self) = shift;
+around _application_args => sub {
+    my ($orig, $self) = @_;
     return (
         $self->port,
         $self->host,
         {
-           argv => $self->ARGV,
+           %{ $self->$orig },
            map { $_ => $self->$_ } qw/
                 fork
                 keepalive
@@ -259,13 +275,14 @@ sub _application_args {
                 pidfile
                 keepalive
                 follow_symlinks
+                port
+                host
             /,
         },
     );
-}
+};
 
 __PACKAGE__->meta->make_immutable;
-
 1;
 
 =head1 NAME
@@ -307,6 +324,10 @@ Catalyst::Script::Server - Catalyst test server
 
 Run a Catalyst test server for this application.
 
+=head1 SEE ALSO
+
+L<Catalyst::ScriptRunner>
+
 =head1 AUTHORS
 
 Catalyst Contributors, see Catalyst.pm