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