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