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