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