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 Catalyst::Engine::HTTP;
  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{
  25     -d --debug force debug mode
  26     }
  27
  28 );
  29
  30 has help => (
  31     traits => [qw(Getopt)],
  32     cmd_aliases => 'h',
  33     isa => 'Bool',
  34     is => 'ro',
  35     documentation => qq{
  36     -h --help display this help and exits
  37     },
  38 );
  39
  40 has host => (
  41     isa => 'Str',
  42     is => 'ro',
  43     ,
  44     default =>  "localhost"
  45 );
  46
  47 has fork => (
  48     traits => [qw(Getopt)],
  49     cmd_aliases => 'f',
  50     isa => 'Bool',
  51     is => 'ro',
  52
  53 );
  54
  55 has listen => (
  56     traits => [qw(Getopt)],
  57     cmd_aliases => 'l',
  58     isa => 'Int',
  59     is => 'ro',
  60     ,
  61     default => "3000"
  62 );
  63
  64 has pidfile => (
  65     traits => [qw(Getopt)],
  66     cmd_aliases => 'pid',
  67     isa => 'Str',
  68     is => 'ro',
  69
  70 );
  71
  72 has keepalive => (
  73     traits => [qw(Getopt)],
  74     cmd_aliases => 'k',
  75     isa => 'Bool',
  76     is => 'ro',
  77     ,
  78
  79 );
  80
  81 has background => (
  82     traits => [qw(Getopt)],
  83     cmd_aliases => 'bg',
  84     isa => 'Bool',
  85     is => 'ro',
  86 );
  87
  88
  89 has _app => (
  90     reader   => 'app',
  91     init_arg => 'app',
  92     traits => [qw(NoGetopt)],
  93     isa => 'Str',
  94     is => 'ro',
  95 );
  96
  97 has restart => (
  98     traits => [qw(Getopt)],
  99     cmd_aliases => 'r',
 100     isa => 'Bool',
 101     is => 'ro',
 102
 103 );
 104
 105 has restart_directory => (
 106     traits => [qw(Getopt)],
 107     cmd_aliases => 'rdir',
 108     isa => 'ArrayRef[Str]',
 109     is  => 'ro',
 110     predicate => '_has_restart_directory',
 111 );
 112
 113 has restart_delay => (
 114     traits => [qw(Getopt)],
 115     cmd_aliases => 'rdel',
 116     isa => 'Int',
 117     is => 'ro',
 118     predicate => '_has_restart_delay',
 119 );
 120
 121 has restart_regex => (
 122     traits => [qw(Getopt)],
 123     cmd_aliases => 'rxp',
 124     isa => 'Str',
 125     is => 'ro',
 126     predicate => '_has_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
 136 );
 137
 138 sub usage {
 139     my ($self) = shift;
 140
 141     return pod2usage();
 142
 143 }
 144
 145 my @argv = @ARGV;
 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