lib/Catalyst/Script/Server.pm

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