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