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