lib/Catalyst/Script/Server.pm

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