lib/Catalyst/Script/Server.pm

   1 package Catalyst::Script::Server;
   2 use Moose;
   3 use MooseX::Types::Common::Numeric qw/PositiveInt/;
   4 use MooseX::Types::Moose qw/ArrayRef Str Bool Int RegexpRef/;
   5 use Catalyst::Utils;
   6 use Try::Tiny;
   7 use namespace::autoclean;
   8
   9 with 'Catalyst::ScriptRole';
  10
  11 has debug => (
  12     traits        => [qw(Getopt)],
  13     cmd_aliases   => 'd',
  14     isa           => Bool,
  15     is            => 'ro',
  16     documentation => q{Force debug mode},
  17 );
  18
  19 has host => (
  20     traits        => [qw(Getopt)],
  21     cmd_aliases   => 'h',
  22     isa           => Str,
  23     is            => 'ro',
  24     # N.B. undef (the default) means we bind on all interfaces on the host.
  25     documentation => 'Specify a hostname or IP on this host for the server to bind to',
  26 );
  27
  28 has fork => (
  29     traits        => [qw(Getopt)],
  30     cmd_aliases   => 'f',
  31     isa           => Bool,
  32     is            => 'ro',
  33     default       => 0,
  34     documentation => 'Fork the server to be able to serve multiple requests at once',
  35 );
  36
  37 has port => (
  38     traits        => [qw(Getopt)],
  39     cmd_aliases   => 'p',
  40     isa           => PositiveInt,
  41     is            => 'ro',
  42     default       => sub {
  43         Catalyst::Utils::env_value(shift->application_name, 'port') || 3000
  44     },
  45     documentation => 'Specify a different listening port (to the default port 3000)',
  46 );
  47
  48 use Moose::Util::TypeConstraints;
  49 class_type 'MooseX::Daemonize::Pid::File';
  50 subtype 'Catalyst::Script::Server::Types::Pidfile',
  51     as 'MooseX::Daemonize::Pid::File';
  52
  53 coerce 'Catalyst::Script::Server::Types::Pidfile', from Str, via {
  54     try { Class::MOP::load_class("MooseX::Daemonize::Pid::File") }
  55     catch {
  56         warn("Could not load MooseX::Daemonize::Pid::File, needed for --pid option\n");
  57         exit 1;
  58     };
  59     MooseX::Daemonize::Pid::File->new( file => $_ );
  60 };
  61 MooseX::Getopt::OptionTypeMap->add_option_type_to_map(
  62     'Catalyst::Script::Server::Types::Pidfile' => '=s',
  63 );
  64 has pidfile => (
  65     traits        => [qw(Getopt)],
  66     cmd_aliases   => 'pid',
  67     isa           => 'Catalyst::Script::Server::Types::Pidfile',
  68     is            => 'ro',
  69     documentation => 'Specify a pidfile',
  70     coerce        => 1,
  71     predicate     => '_has_pidfile',
  72 );
  73
  74 # Override MooseX::Daemonize
  75 sub dont_close_all_files { 1 }
  76 sub BUILD {
  77     my $self = shift;
  78
  79     if ($self->background) {
  80         # FIXME - This is evil. Should we just add MX::Daemonize to the deps?
  81         try { Class::MOP::load_class('MooseX::Daemonize::Core'); Class::MOP::load_class('POSIX') }
  82         catch {
  83             warn("MooseX::Daemonize is needed for the --background option\n");
  84             exit 1;
  85         };
  86         MooseX::Daemonize::Core->meta->apply($self);
  87         POSIX::close($_) foreach (0..2);
  88     }
  89 }
  90
  91 has keepalive => (
  92     traits        => [qw(Getopt)],
  93     cmd_aliases   => 'k',
  94     isa           => Bool,
  95     is            => 'ro',
  96     default       => 0,
  97     documentation => 'Support keepalive',
  98 );
  99
 100 has background => (
 101     traits        => [qw(Getopt)],
 102     cmd_aliases   => 'bg',
 103     isa           => Bool,
 104     is            => 'ro',
 105     default       => 0,
 106     documentation => 'Run in the background',
 107 );
 108
 109 has restart => (
 110     traits        => [qw(Getopt)],
 111     cmd_aliases   => 'r',
 112     isa           => Bool,
 113     is            => 'ro',
 114     default       => sub {
 115         Catalyst::Utils::env_value(shift->application_name, 'reload') || 0;
 116     },
 117     documentation => 'use Catalyst::Restarter to detect code changes and restart the application',
 118 );
 119
 120 has restart_directory => (
 121     traits        => [qw(Getopt)],
 122     cmd_aliases   => [ 'rdir', 'restartdirectory' ],
 123     isa           => ArrayRef[Str],
 124     is            => 'ro',
 125     documentation => 'Restarter directory to watch',
 126     predicate     => '_has_restart_directory',
 127 );
 128
 129 has restart_delay => (
 130     traits        => [qw(Getopt)],
 131     cmd_aliases   => 'rd',
 132     isa           => Int,
 133     is            => 'ro',
 134     documentation => 'Set a restart delay',
 135     predicate     => '_has_restart_delay',
 136 );
 137
 138 {
 139     use Moose::Util::TypeConstraints;
 140
 141     my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as RegexpRef;
 142     coerce $tc, from Str, via { qr/$_/ };
 143
 144     MooseX::Getopt::OptionTypeMap->add_option_type_to_map($tc => '=s');
 145
 146     has restart_regex => (
 147         traits        => [qw(Getopt)],
 148         cmd_aliases   => 'rr',
 149         isa           => $tc,
 150         coerce        => 1,
 151         is            => 'ro',
 152         documentation => 'Restart regex',
 153         predicate     => '_has_restart_regex',
 154     );
 155 }
 156
 157 has follow_symlinks => (
 158     traits        => [qw(Getopt)],
 159     cmd_aliases   => 'sym',
 160     isa           => Bool,
 161     is            => 'ro',
 162     default       => 0,
 163     documentation => 'Follow symbolic links',
 164     predicate     => '_has_follow_symlinks',
 165 );
 166
 167 sub _plack_engine_name {
 168     my $self = shift;
 169     return $self->fork || $self->keepalive ? 'Starman' : 'Standalone';
 170 }
 171
 172 sub _restarter_args {
 173     my $self = shift;
 174
 175     return (
 176         argv => $self->ARGV,
 177         start_sub => sub { $self->_run_application },
 178         ($self->_has_follow_symlinks   ? (follow_symlinks => $self->follow_symlinks)   : ()),
 179         ($self->_has_restart_delay     ? (sleep_interval  => $self->restart_delay)     : ()),
 180         ($self->_has_restart_directory ? (directories     => $self->restart_directory) : ()),
 181         ($self->_has_restart_regex     ? (filter          => $self->restart_regex)     : ()),
 182     ),
 183     (
 184         map { $_ => $self->$_ } qw(application_name host port debug pidfile fork background keepalive)
 185     );
 186 }
 187
 188 has restarter_class => (
 189     is => 'ro',
 190     isa => Str,
 191     lazy => 1,
 192     default => sub {
 193         my $self = shift;
 194         Catalyst::Utils::env_value($self->application_name, 'RESTARTER') || 'Catalyst::Restarter';
 195     }
 196 );
 197
 198 sub run {
 199     my $self = shift;
 200
 201     local $ENV{CATALYST_DEBUG} = 1
 202         if $self->debug;
 203
 204     if ( $self->restart ) {
 205         die "Cannot run in the background and also watch for changed files.\n"
 206             if $self->background;
 207         die "Cannot write out a pid file and fork for the restarter.\n"
 208             if $self->_has_pidfile;
 209
 210         # If we load this here, then in the case of a restarter, it does not
 211         # need to be reloaded for each restart.
 212         require Catalyst;
 213
 214         # If this isn't done, then the Catalyst::Devel tests for the restarter
 215         # fail.
 216         $| = 1 if $ENV{HARNESS_ACTIVE};
 217
 218         Catalyst::Utils::ensure_class_loaded($self->restarter_class);
 219
 220         my $subclass = $self->restarter_class->pick_subclass;
 221
 222         my $restarter = $subclass->new(
 223             $self->_restarter_args()
 224         );
 225
 226         $restarter->run_and_watch;
 227     }
 228     else {
 229         if ($self->background) {
 230             $self->daemon_fork;
 231
 232             return 1 unless $self->is_daemon;
 233
 234             Class::MOP::load_class($self->application_name);
 235
 236             $self->daemon_detach;
 237         }
 238
 239         $self->pidfile->write
 240             if $self->_has_pidfile;
 241
 242         $self->_run_application;
 243     }
 244
 245
 246 }
 247
 248 sub _plack_loader_args {
 249     my ($self) = shift;
 250     return (
 251         port => $self->port,
 252         host => $self->host,
 253         keepalive => $self->keepalive ? 100 : 1,
 254         server_ready => sub {
 255             my ($args) = @_;
 256
 257             my $name  = $args->{server_software} || ref($args); # $args is $server
 258             my $host  = $args->{host} || 0;
 259             my $proto = $args->{proto} || 'http';
 260
 261             print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n";
 262         },
 263     );
 264 }
 265
 266 around _application_args => sub {
 267     my ($orig, $self) = @_;
 268     return (
 269         $self->port,
 270         $self->host,
 271         {
 272            %{ $self->$orig },
 273            map { $_ => $self->$_ } qw/
 274                 fork
 275                 keepalive
 276                 background
 277                 pidfile
 278                 keepalive
 279                 follow_symlinks
 280                 port
 281                 host
 282             /,
 283         },
 284     );
 285 };
 286
 287 __PACKAGE__->meta->make_immutable;
 288 1;
 289
 290 =head1 NAME
 291
 292 Catalyst::Script::Server - Catalyst test server
 293
 294 =head1 SYNOPSIS
 295
 296  myapp_server.pl [options]
 297
 298  Options:
 299    -d     --debug          force debug mode
 300    -f     --fork           handle each request in a new process
 301                       (defaults to false)
 302           --help           display this help and exits
 303    -h     --host           host (defaults to all)
 304    -p     --port           port (defaults to 3000)
 305    -k     --keepalive      enable keep-alive connections
 306    -r     --restart        restart when files get modified
 307                        (defaults to false)
 308    --rd   --restart_delay  delay between file checks
 309                       (ignored if you have Linux::Inotify2 installed)
 310    --rr   --restart_regex  regex match files that trigger
 311                       a restart when modified
 312                       (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
 313    --rdir --restart_directory  the directory to search for
 314                       modified files, can be set multiple times
 315                       (defaults to '[SCRIPT_DIR]/..')
 316    --sym  --follow_symlinks   follow symlinks in search directories
 317                       (defaults to false. this is a no-op on Win32)
 318    --bg   --background        run the process in the background
 319    --pid  --pidfile           specify filename for pid file
 320
 321  See also:
 322    perldoc Catalyst::Manual
 323    perldoc Catalyst::Manual::Intro
 324
 325 =head1 DESCRIPTION
 326
 327 Run a Catalyst test server for this application.
 328
 329 =head1 SEE ALSO
 330
 331 L<Catalyst::ScriptRunner>
 332
 333 =head1 AUTHORS
 334
 335 Catalyst Contributors, see Catalyst.pm
 336
 337 =head1 COPYRIGHT
 338
 339 This library is free software. You can redistribute it and/or modify
 340 it under the same terms as Perl itself.
 341
 342 =cut