line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Plack::Runner; |
2
|
1
|
|
|
1
|
|
57187
|
use strict; |
|
1
|
|
|
|
|
12
|
|
|
1
|
|
|
|
|
24
|
|
3
|
1
|
|
|
1
|
|
5
|
use warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
19
|
|
4
|
1
|
|
|
1
|
|
3
|
use Carp (); |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
11
|
|
5
|
1
|
|
|
1
|
|
369
|
use Plack::Util; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
23
|
|
6
|
1
|
|
|
1
|
|
389
|
use Try::Tiny; |
|
1
|
|
|
|
|
1888
|
|
|
1
|
|
|
|
|
1090
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
sub new { |
9
|
8
|
|
|
8
|
0
|
5393
|
my $class = shift; |
10
|
|
|
|
|
|
|
bless { |
11
|
|
|
|
|
|
|
env => $ENV{PLACK_ENV}, |
12
|
8
|
|
|
|
|
59
|
loader => 'Plack::Loader', |
13
|
|
|
|
|
|
|
includes => [], |
14
|
|
|
|
|
|
|
modules => [], |
15
|
|
|
|
|
|
|
default_middleware => 1, |
16
|
|
|
|
|
|
|
@_, |
17
|
|
|
|
|
|
|
}, $class; |
18
|
|
|
|
|
|
|
} |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
# delay the build process for reloader |
21
|
|
|
|
|
|
|
sub build(&;$) { |
22
|
0
|
|
|
0
|
0
|
0
|
my $block = shift; |
23
|
0
|
|
0
|
0
|
|
0
|
my $app = shift || sub { }; |
24
|
0
|
|
|
0
|
|
0
|
return sub { $block->($app->()) }; |
|
0
|
|
|
|
|
0
|
|
25
|
|
|
|
|
|
|
} |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
sub parse_options { |
28
|
8
|
|
|
8
|
0
|
30
|
my $self = shift; |
29
|
|
|
|
|
|
|
|
30
|
8
|
|
|
|
|
16
|
local @ARGV = @_; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
# From 'prove': Allow cuddling the paths with -I, -M and -e |
33
|
8
|
50
|
|
|
|
14
|
@ARGV = map { /^(-[IMe])(.+)/ ? ($1,$2) : $_ } @ARGV; |
|
24
|
|
|
|
|
56
|
|
34
|
|
|
|
|
|
|
|
35
|
8
|
|
|
|
|
13
|
my($host, $port, $socket, @listen); |
36
|
|
|
|
|
|
|
|
37
|
8
|
|
|
|
|
677
|
require Getopt::Long; |
38
|
8
|
|
|
|
|
9152
|
my $parser = Getopt::Long::Parser->new( |
39
|
|
|
|
|
|
|
config => [ "no_auto_abbrev", "no_ignore_case", "pass_through" ], |
40
|
|
|
|
|
|
|
); |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
$parser->getoptions( |
43
|
|
|
|
|
|
|
"a|app=s" => \$self->{app}, |
44
|
|
|
|
|
|
|
"o|host=s" => \$host, |
45
|
|
|
|
|
|
|
"p|port=i" => \$port, |
46
|
|
|
|
|
|
|
"s|server=s" => \$self->{server}, |
47
|
|
|
|
|
|
|
"S|socket=s" => \$socket, |
48
|
|
|
|
|
|
|
'l|listen=s@' => \@listen, |
49
|
|
|
|
|
|
|
'D|daemonize' => \$self->{daemonize}, |
50
|
|
|
|
|
|
|
"E|env=s" => \$self->{env}, |
51
|
|
|
|
|
|
|
"e=s" => \$self->{eval}, |
52
|
|
|
|
|
|
|
'I=s@' => $self->{includes}, |
53
|
|
|
|
|
|
|
'M=s@' => $self->{modules}, |
54
|
0
|
|
|
0
|
|
0
|
'r|reload' => sub { $self->{loader} = "Restarter" }, |
55
|
0
|
|
|
0
|
|
0
|
'R|Reload=s' => sub { $self->{loader} = "Restarter"; $self->loader->watch(split ",", $_[1]) }, |
|
0
|
|
|
|
|
0
|
|
56
|
|
|
|
|
|
|
'L|loader=s' => \$self->{loader}, |
57
|
|
|
|
|
|
|
"access-log=s" => \$self->{access_log}, |
58
|
|
|
|
|
|
|
"path=s" => \$self->{path}, |
59
|
|
|
|
|
|
|
"h|help" => \$self->{help}, |
60
|
|
|
|
|
|
|
"v|version" => \$self->{version}, |
61
|
|
|
|
|
|
|
"default-middleware!" => \$self->{default_middleware}, |
62
|
8
|
|
|
|
|
715
|
); |
63
|
|
|
|
|
|
|
|
64
|
8
|
|
|
|
|
9162
|
my(@options, @argv); |
65
|
8
|
|
|
|
|
22
|
while (defined(my $arg = shift @ARGV)) { |
66
|
5
|
100
|
|
|
|
17
|
if ($arg =~ s/^--?//) { |
67
|
4
|
|
|
|
|
10
|
my @v = split '=', $arg, 2; |
68
|
4
|
|
|
|
|
4
|
$v[0] =~ tr/-/_/; |
69
|
4
|
100
|
|
|
|
15
|
if (@v == 2) { |
|
|
50
|
|
|
|
|
|
70
|
2
|
|
|
|
|
6
|
push @options, @v; |
71
|
|
|
|
|
|
|
} elsif ($v[0] =~ s/^(disable|enable)_//) { |
72
|
2
|
|
|
|
|
7
|
push @options, $v[0], $1 eq 'enable'; |
73
|
|
|
|
|
|
|
} else { |
74
|
0
|
|
|
|
|
0
|
push @options, $v[0], shift @ARGV; |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
} else { |
77
|
1
|
|
|
|
|
4
|
push @argv, $arg; |
78
|
|
|
|
|
|
|
} |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
8
|
|
|
|
|
20
|
push @options, $self->mangle_host_port_socket($host, $port, $socket, @listen); |
82
|
8
|
100
|
|
|
|
19
|
push @options, daemonize => 1 if $self->{daemonize}; |
83
|
|
|
|
|
|
|
|
84
|
8
|
|
|
|
|
10
|
$self->{options} = \@options; |
85
|
8
|
|
|
|
|
35
|
$self->{argv} = \@argv; |
86
|
|
|
|
|
|
|
} |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
sub set_options { |
89
|
0
|
|
|
0
|
0
|
0
|
my $self = shift; |
90
|
0
|
|
|
|
|
0
|
push @{$self->{options}}, @_; |
|
0
|
|
|
|
|
0
|
|
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub mangle_host_port_socket { |
94
|
8
|
|
|
8
|
0
|
15
|
my($self, $host, $port, $socket, @listen) = @_; |
95
|
|
|
|
|
|
|
|
96
|
8
|
|
|
|
|
13
|
for my $listen (reverse @listen) { |
97
|
5
|
100
|
|
|
|
15
|
if ($listen =~ /:\d+$/) { |
98
|
3
|
|
|
|
|
7
|
($host, $port) = split /:/, $listen, 2; |
99
|
3
|
100
|
|
|
|
9
|
$host = undef if $host eq ''; |
100
|
|
|
|
|
|
|
} else { |
101
|
2
|
|
33
|
|
|
8
|
$socket ||= $listen; |
102
|
|
|
|
|
|
|
} |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
8
|
100
|
|
|
|
15
|
unless (@listen) { |
106
|
4
|
100
|
|
|
|
7
|
if ($socket) { |
107
|
1
|
|
|
|
|
2
|
@listen = ($socket); |
108
|
|
|
|
|
|
|
} else { |
109
|
3
|
|
100
|
|
|
11
|
$port ||= 5000; |
110
|
3
|
100
|
|
|
|
12
|
@listen = ($host ? "$host:$port" : ":$port"); |
111
|
|
|
|
|
|
|
} |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
8
|
|
|
|
|
31
|
return host => $host, port => $port, listen => \@listen, socket => $socket; |
115
|
|
|
|
|
|
|
} |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
sub version_cb { |
118
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
119
|
|
|
|
|
|
|
$self->{version_cb} || sub { |
120
|
0
|
|
|
0
|
|
|
require Plack; |
121
|
0
|
|
|
|
|
|
print "Plack $Plack::VERSION\n"; |
122
|
0
|
0
|
|
|
|
|
}; |
123
|
|
|
|
|
|
|
} |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
sub setup { |
126
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
127
|
|
|
|
|
|
|
|
128
|
0
|
0
|
|
|
|
|
if ($self->{help}) { |
129
|
0
|
|
|
|
|
|
require Pod::Usage; |
130
|
0
|
|
|
|
|
|
Pod::Usage::pod2usage(0); |
131
|
|
|
|
|
|
|
} |
132
|
|
|
|
|
|
|
|
133
|
0
|
0
|
|
|
|
|
if ($self->{version}) { |
134
|
0
|
|
|
|
|
|
$self->version_cb->(); |
135
|
0
|
|
|
|
|
|
exit; |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
0
|
0
|
|
|
|
|
if (@{$self->{includes}}) { |
|
0
|
|
|
|
|
|
|
139
|
0
|
|
|
|
|
|
require lib; |
140
|
0
|
|
|
|
|
|
lib->import(@{$self->{includes}}); |
|
0
|
|
|
|
|
|
|
141
|
|
|
|
|
|
|
} |
142
|
|
|
|
|
|
|
|
143
|
0
|
0
|
|
|
|
|
if ($self->{eval}) { |
144
|
0
|
|
|
|
|
|
push @{$self->{modules}}, 'Plack::Builder'; |
|
0
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
0
|
|
|
|
|
|
for (@{$self->{modules}}) { |
|
0
|
|
|
|
|
|
|
148
|
0
|
|
|
|
|
|
my($module, @import) = split /[=,]/; |
149
|
0
|
0
|
|
|
|
|
eval "require $module" or die $@; |
150
|
0
|
|
|
|
|
|
$module->import(@import); |
151
|
|
|
|
|
|
|
} |
152
|
|
|
|
|
|
|
} |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
sub locate_app { |
155
|
0
|
|
|
0
|
0
|
|
my($self, @args) = @_; |
156
|
|
|
|
|
|
|
|
157
|
0
|
|
0
|
|
|
|
my $psgi = $self->{app} || $args[0]; |
158
|
|
|
|
|
|
|
|
159
|
0
|
0
|
|
|
|
|
if (ref $psgi eq 'CODE') { |
160
|
0
|
|
|
0
|
|
|
return sub { $psgi }; |
|
0
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
|
163
|
0
|
0
|
|
|
|
|
if ($self->{eval}) { |
164
|
0
|
0
|
|
|
|
|
$self->loader->watch("lib") if -e "lib"; |
165
|
|
|
|
|
|
|
return build { |
166
|
1
|
|
|
1
|
|
7
|
no strict; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
20
|
|
167
|
1
|
|
|
1
|
|
3
|
no warnings; |
|
1
|
|
|
|
|
1
|
|
|
1
|
|
|
|
|
902
|
|
168
|
0
|
|
|
0
|
|
|
my $eval = "builder { $self->{eval};"; |
169
|
0
|
0
|
|
|
|
|
$eval .= "Plack::Util::load_psgi(\$psgi);" if $psgi; |
170
|
0
|
|
|
|
|
|
$eval .= "}"; |
171
|
0
|
0
|
|
|
|
|
eval $eval or die $@; |
172
|
0
|
|
|
|
|
|
}; |
173
|
|
|
|
|
|
|
} |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
0
|
|
|
|
$psgi ||= "app.psgi"; |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
require File::Basename; |
178
|
0
|
|
|
|
|
|
my $lib = File::Basename::dirname($psgi) . "/lib"; |
179
|
0
|
0
|
|
|
|
|
$self->loader->watch($lib) if -e $lib; |
180
|
0
|
|
|
|
|
|
$self->loader->watch($psgi); |
181
|
0
|
|
|
0
|
|
|
build { Plack::Util::load_psgi $psgi }; |
|
0
|
|
|
|
|
|
|
182
|
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
sub watch { |
185
|
0
|
|
|
0
|
0
|
|
my($self, @dir) = @_; |
186
|
|
|
|
|
|
|
|
187
|
0
|
|
|
|
|
|
push @{$self->{watch}}, @dir |
188
|
0
|
0
|
|
|
|
|
if $self->{loader} eq 'Restarter'; |
189
|
|
|
|
|
|
|
} |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
sub apply_middleware { |
192
|
0
|
|
|
0
|
0
|
|
my($self, $app, $class, @args) = @_; |
193
|
|
|
|
|
|
|
|
194
|
0
|
|
|
|
|
|
my $mw_class = Plack::Util::load_class($class, 'Plack::Middleware'); |
195
|
0
|
|
|
0
|
|
|
build { $mw_class->wrap($_[0], @args) } $app; |
|
0
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub prepare_devel { |
199
|
0
|
|
|
0
|
0
|
|
my($self, $app) = @_; |
200
|
|
|
|
|
|
|
|
201
|
0
|
0
|
|
|
|
|
if ($self->{default_middleware}) { |
202
|
0
|
|
|
|
|
|
$app = $self->apply_middleware($app, 'Lint'); |
203
|
0
|
|
|
|
|
|
$app = $self->apply_middleware($app, 'StackTrace'); |
204
|
0
|
0
|
0
|
|
|
|
if (!$ENV{GATEWAY_INTERFACE} and !$self->{access_log}) { |
205
|
0
|
|
|
|
|
|
$app = $self->apply_middleware($app, 'AccessLog'); |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
} |
208
|
|
|
|
|
|
|
|
209
|
0
|
|
|
|
|
|
push @{$self->{options}}, server_ready => sub { |
210
|
0
|
|
|
0
|
|
|
my($args) = @_; |
211
|
0
|
|
0
|
|
|
|
my $name = $args->{server_software} || ref($args); # $args is $server |
212
|
0
|
|
0
|
|
|
|
my $host = $args->{host} || 0; |
213
|
0
|
|
0
|
|
|
|
my $proto = $args->{proto} || 'http'; |
214
|
0
|
|
|
|
|
|
print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; |
215
|
0
|
|
|
|
|
|
}; |
216
|
|
|
|
|
|
|
|
217
|
0
|
|
|
|
|
|
$app; |
218
|
|
|
|
|
|
|
} |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
sub loader { |
221
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
222
|
0
|
|
0
|
|
|
|
$self->{_loader} ||= Plack::Util::load_class($self->{loader}, 'Plack::Loader')->new; |
223
|
|
|
|
|
|
|
} |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
sub load_server { |
226
|
0
|
|
|
0
|
0
|
|
my($self, $loader) = @_; |
227
|
|
|
|
|
|
|
|
228
|
0
|
0
|
|
|
|
|
if ($self->{server}) { |
229
|
0
|
|
|
|
|
|
return $loader->load($self->{server}, @{$self->{options}}); |
|
0
|
|
|
|
|
|
|
230
|
|
|
|
|
|
|
} else { |
231
|
0
|
|
|
|
|
|
return $loader->auto(@{$self->{options}}); |
|
0
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
sub run { |
236
|
0
|
|
|
0
|
0
|
|
my $self = shift; |
237
|
|
|
|
|
|
|
|
238
|
0
|
0
|
|
|
|
|
unless (ref $self) { |
239
|
0
|
|
|
|
|
|
$self = $self->new; |
240
|
0
|
|
|
|
|
|
$self->parse_options(@_); |
241
|
0
|
|
|
|
|
|
return $self->run; |
242
|
|
|
|
|
|
|
} |
243
|
|
|
|
|
|
|
|
244
|
0
|
0
|
|
|
|
|
unless ($self->{options}) { |
245
|
0
|
|
|
|
|
|
$self->parse_options(); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
0
|
0
|
|
|
|
|
my @args = @_ ? @_ : @{$self->{argv}}; |
|
0
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
|
250
|
0
|
|
|
|
|
|
$self->setup; |
251
|
|
|
|
|
|
|
|
252
|
0
|
|
|
|
|
|
my $app = $self->locate_app(@args); |
253
|
|
|
|
|
|
|
|
254
|
0
|
0
|
|
|
|
|
if ($self->{path}) { |
255
|
0
|
|
|
|
|
|
require Plack::App::URLMap; |
256
|
|
|
|
|
|
|
$app = build { |
257
|
0
|
|
|
0
|
|
|
my $urlmap = Plack::App::URLMap->new; |
258
|
0
|
|
|
|
|
|
$urlmap->mount($self->{path} => $_[0]); |
259
|
0
|
|
|
|
|
|
$urlmap->to_app; |
260
|
0
|
|
|
|
|
|
} $app; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
0
|
|
0
|
|
|
|
$ENV{PLACK_ENV} ||= $self->{env} || 'development'; |
|
|
|
0
|
|
|
|
|
264
|
0
|
0
|
|
|
|
|
if ($ENV{PLACK_ENV} eq 'development') { |
265
|
0
|
|
|
|
|
|
$app = $self->prepare_devel($app); |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
|
268
|
0
|
0
|
|
|
|
|
if ($self->{access_log}) { |
269
|
|
|
|
|
|
|
open my $logfh, ">>", $self->{access_log} |
270
|
0
|
0
|
|
|
|
|
or die "open($self->{access_log}): $!"; |
271
|
0
|
|
|
|
|
|
$logfh->autoflush(1); |
272
|
0
|
|
|
0
|
|
|
$app = $self->apply_middleware($app, 'AccessLog', logger => sub { $logfh->print( @_ ) }); |
|
0
|
|
|
|
|
|
|
273
|
|
|
|
|
|
|
} |
274
|
|
|
|
|
|
|
|
275
|
0
|
|
|
|
|
|
my $loader = $self->loader; |
276
|
0
|
|
|
|
|
|
$loader->preload_app($app); |
277
|
|
|
|
|
|
|
|
278
|
0
|
|
|
|
|
|
my $server = $self->load_server($loader); |
279
|
0
|
|
|
|
|
|
$loader->run($server); |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
1; |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
__END__ |