lib/Catalyst/Script/Server.pm

   1 package Catalyst::Script::Server;
   2
   3 BEGIN {
   4     $ENV{CATALYST_ENGINE} ||= 'HTTP';
   5     $ENV{CATALYST_SCRIPT_GEN} = 31;
   6     require Catalyst::Engine::HTTP;
   7 }
   8
   9 use FindBin qw/$Bin/;
  10 use lib "$Bin/../lib";
  11 use Pod::Usage;
  12 use Moose;
  13 use Catalyst::Restarter;
  14 use MooseX::Types::Moose qw/Str Bool Int/;
  15 use namespace::autoclean;
  16
  17 with 'MooseX::Getopt';
  18
  19 has debug => (
  20     traits => [qw(Getopt)],
  21     cmd_aliases => 'd',
  22     isa => 'Bool',
  23     is => 'ro',
  24     documentation => qq{ force debug mode }
  25
  26 );
  27
  28 has help => (
  29     traits => [qw(Getopt)],
  30     cmd_aliases => 'h',
  31     isa => 'Bool',
  32     is => 'ro',
  33     documentation => qq{ display this help and exits },
  34 );
  35
  36 has host => (
  37     isa => 'Str',
  38     is => 'ro',
  39     default =>  "localhost",
  40     documentation => qq{ specify a host for the server to run on }
  41 );
  42
  43 has fork => (
  44     traits => [qw(Getopt)],
  45     cmd_aliases => 'f',
  46     isa => 'Bool',
  47     is => 'ro',
  48     documentation => qq{ fork the server }
  49 );
  50
  51 has listen => (
  52     traits => [qw(Getopt)],
  53     cmd_aliases => 'l',
  54     isa => 'Int',
  55     is => 'ro',
  56     default => "3000",
  57     documentation => qq{ specify a different listening port }
  58 );
  59
  60 has pidfile => (
  61     traits => [qw(Getopt)],
  62     cmd_aliases => 'pid',
  63     isa => 'Str',
  64     is => 'ro',
  65     documentation => qq{ specify a pidfile }
  66 );
  67
  68 has keepalive => (
  69     traits => [qw(Getopt)],
  70     cmd_aliases => 'k',
  71     isa => 'Bool',
  72     is => 'ro',
  73     documentation => qq{ server keepalive },
  74
  75 );
  76
  77 has background => (
  78     traits => [qw(Getopt)],
  79     cmd_aliases => 'bg',
  80     isa => 'Bool',
  81     is => 'ro',
  82     documentation => qq{ run in the background }
  83 );
  84
  85
  86 has _app => (
  87     reader   => 'app',
  88     init_arg => 'app',
  89     traits => [qw(NoGetopt)],
  90     isa => 'Str',
  91     is => 'ro',
  92 );
  93
  94 has restart => (
  95     traits => [qw(Getopt)],
  96     cmd_aliases => 'r',
  97     isa => 'Bool',
  98     is => 'ro',
  99     documentation => qq{ use Catalyst::Restarter to detect code changes }
 100 );
 101
 102 has restart_directory => (
 103     traits => [qw(Getopt)],
 104     cmd_aliases => 'rdir',
 105     isa => 'ArrayRef[Str]',
 106     is  => 'ro',
 107     predicate => '_has_restart_directory',
 108     documentation => qq{ restarter directory to watch }
 109 );
 110
 111 has restart_delay => (
 112     traits => [qw(Getopt)],
 113     cmd_aliases => 'rdel',
 114     isa => 'Int',
 115     is => 'ro',
 116     predicate => '_has_restart_delay',
 117     documentation => qq{ set a restart delay }
 118 );
 119
 120 has restart_regex => (
 121     traits => [qw(Getopt)],
 122     cmd_aliases => 'rxp',
 123     isa => 'Str',
 124     is => 'ro',
 125     predicate => '_has_restart_regex',
 126     documentation => qq{ restart regex }
 127 );
 128
 129 has follow_symlinks => (
 130     traits => [qw(Getopt)],
 131     cmd_aliases => 'sym',
 132     isa => 'Bool',
 133     is => 'ro',
 134     predicate => '_has_follow_symlinks',
 135     documentation => qq{ follow symbolic links }
 136
 137 );
 138
 139 sub usage {
 140     my ($self) = shift;
 141
 142     return pod2usage();
 143
 144 }
 145
 146
 147 sub run {
 148     my ($self) = shift;
 149
 150     $self->usage if $self->help;
 151
 152     if ( $self->debug ) {
 153         $ENV{CATALYST_DEBUG} = 1;
 154     }
 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     if ( $self->restart ) {
 165         die "Cannot run in the background and also watch for changed files.\n"
 166             if $self->background;
 167
 168         require Catalyst::Restarter;
 169
 170         my $subclass = Catalyst::Restarter->pick_subclass;
 171
 172         my %args;
 173         $args{follow_symlinks} = $self->follow_symlinks
 174             if $self->_has_follow_symlinks;
 175         $args{directories}     = $self->restart_directory
 176             if $self->_has_restart_directory;
 177         $args{sleep_interval}  = $self->restart_delay
 178             if $self->_has_restart_delay;
 179         $args{filter} = qr/$self->restart_regex/
 180             if $self->_has_restart_regex;
 181
 182         my $restarter = $subclass->new(
 183             %args,
 184             start_sub => sub { $self->_run },
 185             argv      => \$self->ARGV,
 186         );
 187
 188         $restarter->run_and_watch;
 189     }
 190     else {
 191         $self->_run;
 192     }
 193
 194
 195 }
 196
 197 sub _run {
 198     my ($self) = shift;
 199
 200     my $app = $self->app;
 201     Class::MOP::load_class($app);
 202
 203     $app->run(
 204         $self->listen, $self->host,
 205         {
 206            'fork'            => $self->fork,
 207            keepalive         => $self->keepalive,
 208            background        => $self->background,
 209            pidfile           => $self->pidfile,
 210            keepalive         => $self->keepalive,
 211            follow_symlinks   => $self->follow_symlinks,
 212         }
 213     );
 214 }
 215
 216
 217 no Moose;
 218 __PACKAGE__->meta->make_immutable;
 219
 220 1;
 221
 222 =head1 NAME
 223
 224 [% appprefix %]_server.pl - Catalyst Testserver
 225
 226 =head1 SYNOPSIS
 227
 228 [% appprefix %]_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    -h     --help           display this help and exits
 235           --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   --restartdelay  delay between file checks
 241                       (ignored if you have Linux::Inotify2 installed)
 242    --rr   --restartregex  regex match files that trigger
 243                       a restart when modified
 244                       (defaults to '\.yml$|\.yaml$|\.conf|\.pm$')
 245    --rdir --restartdirectory  the directory to search for
 246                       modified files, can be set mulitple 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 Testserver 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