line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Net::Async::UWSGI::Server::Connection; |
2
|
|
|
|
|
|
|
$Net::Async::UWSGI::Server::Connection::VERSION = '0.006'; |
3
|
2
|
|
|
2
|
|
8
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
63
|
|
4
|
2
|
|
|
2
|
|
7
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
65
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
8
|
use parent qw(IO::Async::Stream); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
12
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
=head1 NAME |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
Net::Async::UWSGI::Server::Connection - represents an incoming connection to a server |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 VERSION |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
version 0.006 |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=head1 DESCRIPTION |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
=cut |
19
|
|
|
|
|
|
|
|
20
|
2
|
|
|
2
|
|
32500
|
use JSON::MaybeXS; |
|
2
|
|
|
|
|
8764
|
|
|
2
|
|
|
|
|
114
|
|
21
|
|
|
|
|
|
|
|
22
|
2
|
|
|
2
|
|
980
|
use URI::QueryParam; |
|
2
|
|
|
|
|
1174
|
|
|
2
|
|
|
|
|
64
|
|
23
|
2
|
|
|
2
|
|
977
|
use IO::Async::Timer::Countdown; |
|
2
|
|
|
|
|
3087
|
|
|
2
|
|
|
|
|
70
|
|
24
|
|
|
|
|
|
|
|
25
|
2
|
|
|
2
|
|
11
|
use Encode qw(encode); |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
92
|
|
26
|
2
|
|
|
2
|
|
1025
|
use Protocol::UWSGI qw(:server); |
|
2
|
|
|
|
|
10919
|
|
|
2
|
|
|
|
|
300
|
|
27
|
2
|
|
|
2
|
|
14
|
use List::UtilsBy qw(bundle_by); |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
163
|
|
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
=head2 CONTENT_TYPE_HANDLER |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=cut |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
our %CONTENT_TYPE_HANDLER = ( |
34
|
|
|
|
|
|
|
'application/javascript' => 'json', |
35
|
|
|
|
|
|
|
); |
36
|
|
|
|
|
|
|
|
37
|
2
|
|
|
2
|
|
10
|
use constant USE_HTTP_RESPONSE => 0; |
|
2
|
|
|
|
|
2
|
|
|
2
|
|
|
|
|
2781
|
|
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head1 METHODS |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=cut |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=head2 configure |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
Applies configuration parameters. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=over 4 |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
=item * bus - the event bus |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=item * on_request - callback when we get an incoming request |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=back |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=cut |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
sub configure { |
58
|
0
|
|
|
0
|
1
|
|
my ($self, %args) = @_; |
59
|
0
|
|
|
|
|
|
for(qw(bus on_request default_content_handler)) { |
60
|
0
|
0
|
|
|
|
|
$self->{$_} = delete $args{$_} if exists $args{$_}; |
61
|
|
|
|
|
|
|
} |
62
|
0
|
|
|
|
|
|
$self->SUPER::configure(%args); |
63
|
|
|
|
|
|
|
} |
64
|
|
|
|
|
|
|
|
65
|
0
|
|
|
0
|
0
|
|
sub default_content_handler { shift->{default_content_handler} } |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
=head2 json |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
Accessor for the current JSON state |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=cut |
72
|
|
|
|
|
|
|
|
73
|
0
|
|
0
|
0
|
1
|
|
sub json { shift->{json} ||= JSON::MaybeXS->new(utf8 => 1) } |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
=head2 on_read |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
Base read handler for incoming traffic. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
Attempts to delegate to L as soon as we get the UWSGI |
80
|
|
|
|
|
|
|
frame. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
=cut |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub on_read { |
85
|
0
|
|
|
0
|
1
|
|
my ( $self, $buffref, $eof ) = @_; |
86
|
0
|
0
|
|
|
|
|
if(my $pkt = extract_frame($buffref)) { |
|
|
0
|
|
|
|
|
|
87
|
0
|
|
|
|
|
|
$self->{env} = $pkt; |
88
|
|
|
|
|
|
|
# We have a request, start processing |
89
|
0
|
|
|
|
|
|
return $self->can('dispatch_request'); |
90
|
|
|
|
|
|
|
} elsif($eof) { |
91
|
|
|
|
|
|
|
# EOF before a valid request? Bail out immediately |
92
|
0
|
|
|
|
|
|
$self->cancel; |
93
|
|
|
|
|
|
|
} |
94
|
0
|
|
|
|
|
|
return 0; |
95
|
|
|
|
|
|
|
} |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
=head2 cancel |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
Cancels any request in progress. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
If there's still a connection to the client, |
102
|
|
|
|
|
|
|
they'll receive a 500 response. |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
It's far more likely that the client has gone |
105
|
|
|
|
|
|
|
away, in which case there's no response to send. |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
=cut |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
sub cancel { |
110
|
0
|
|
|
0
|
1
|
|
my ($self) = @_; |
111
|
0
|
0
|
|
|
|
|
$self->response->cancel unless $self->response->is_ready |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head2 env |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
Accessor for the UWSGI environment. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=cut |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
0
|
1
|
|
sub env { shift->{env} } |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
=head2 response |
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
Resolves when the response is complete. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=cut |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
sub response { |
129
|
0
|
|
0
|
0
|
1
|
|
$_[0]->{response} ||= $_[0]->loop->new_future; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head2 dispatch_request |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
At this point we have a request including headers, |
135
|
|
|
|
|
|
|
and we should know whether there's a body involved |
136
|
|
|
|
|
|
|
somewhere. |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=cut |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
sub dispatch_request { |
141
|
0
|
|
|
0
|
1
|
|
my ($self, $buffref, $eof) = @_; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# Plain GET request? We might be able to bail out here |
144
|
0
|
0
|
|
|
|
|
return $self->finish_request unless $self->has_body; |
145
|
|
|
|
|
|
|
|
146
|
0
|
|
|
|
|
|
my $env = $self->env; |
147
|
0
|
|
0
|
|
|
|
my $handler = $self->default_content_handler || 'raw'; |
148
|
0
|
0
|
|
|
|
|
if(my $type = $env->{CONTENT_TYPE}) { |
149
|
0
|
0
|
|
|
|
|
$handler = $CONTENT_TYPE_HANDLER{$type} if exists $CONTENT_TYPE_HANDLER{$type}; |
150
|
|
|
|
|
|
|
} |
151
|
0
|
|
|
|
|
|
$handler = 'content_handler_' . $handler; |
152
|
0
|
|
|
|
|
|
$self->{input_handler} = $self->${\"curry::weak::$handler"}; |
|
0
|
|
|
|
|
|
|
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
# Try to read N bytes if we have content length. Most UWSGI implementations seem |
155
|
|
|
|
|
|
|
# to set this. |
156
|
0
|
0
|
|
|
|
|
if(exists $env->{CONTENT_LENGTH}) { |
157
|
0
|
|
|
|
|
|
$self->{remaining} = $env->{CONTENT_LENGTH}; |
158
|
0
|
|
|
|
|
|
return $self->can('read_to_length'); |
159
|
|
|
|
|
|
|
} |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
# Streaming might be nice, but nginx has no support for this |
162
|
0
|
0
|
0
|
|
|
|
if(exists $env->{HTTP_TRANSFER_ENCODING} && $env->{HTTP_TRANSFER_ENCODING} eq 'chunked') { |
163
|
0
|
|
|
|
|
|
return $self->can('read_chunked'); |
164
|
|
|
|
|
|
|
} |
165
|
0
|
|
|
|
|
|
die "no idea how to handle this, missing length and not chunked"; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub finish_request { |
169
|
0
|
|
|
0
|
0
|
|
my ($self) = @_; |
170
|
0
|
0
|
|
|
|
|
$self->{request_body} = $self->{input_handler}->() |
171
|
|
|
|
|
|
|
if $self->has_body; |
172
|
|
|
|
|
|
|
$self->{completion} = $self->{on_request}->($self) |
173
|
|
|
|
|
|
|
->then($self->curry::write_response) |
174
|
|
|
|
|
|
|
->on_fail(sub { |
175
|
0
|
|
|
0
|
|
|
$self->debug_printf("Failed while attempting to handle request: %s (%s)", @_); |
176
|
0
|
|
|
|
|
|
})->on_ready($self->curry::close_now); |
177
|
|
|
|
|
|
|
return sub { |
178
|
0
|
|
|
0
|
|
|
my ($self, $buffref, $eof) = @_; |
179
|
0
|
0
|
0
|
|
|
|
$self->{completion}->cancel if $eof && !$self->{completion}->is_ready; |
180
|
0
|
|
|
|
|
|
0 |
181
|
|
|
|
|
|
|
} |
182
|
0
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
|
|
184
|
|
|
|
|
|
|
{ |
185
|
|
|
|
|
|
|
my %methods_with_body = ( |
186
|
|
|
|
|
|
|
PUT => 1, |
187
|
|
|
|
|
|
|
POST => 1, |
188
|
|
|
|
|
|
|
PROPPATCH => 1, |
189
|
|
|
|
|
|
|
); |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head2 has_body |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
Returns true if we're expecting a request body |
194
|
|
|
|
|
|
|
for the current request method. |
195
|
|
|
|
|
|
|
|
196
|
|
|
|
|
|
|
=cut |
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
sub has_body { |
199
|
0
|
|
|
0
|
1
|
|
my ($self, $env) = @_; |
200
|
0
|
0
|
|
|
|
|
return 1 if $methods_with_body{$self->env->{REQUEST_METHOD}}; |
201
|
0
|
|
|
|
|
|
return 0; |
202
|
|
|
|
|
|
|
} |
203
|
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
=head2 read_chunked |
206
|
|
|
|
|
|
|
|
207
|
|
|
|
|
|
|
Read handler for chunked data. Unlikely to be used by any real implementations. |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
=cut |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
sub read_chunked { |
212
|
0
|
|
|
0
|
1
|
|
my ($self, $buffref, $eof) = @_; |
213
|
0
|
|
|
|
|
|
$self->debug_printf("Body read: $self, $buffref, $eof: [%s]", $$buffref); |
214
|
0
|
0
|
|
|
|
|
if(defined $self->{chunk_remaining}) { |
215
|
0
|
|
|
|
|
|
my $data = substr $$buffref, 0, $self->{chunk_remaining}, ''; |
216
|
0
|
|
|
|
|
|
$self->{chunk_remaining} -= length $data; |
217
|
0
|
|
|
|
|
|
$self->debug_printf("Had %d bytes, %d left in chunk", length($data), $self->{chunk_remaining}); |
218
|
0
|
|
|
|
|
|
$self->{input_handler}->($data); |
219
|
0
|
0
|
|
|
|
|
return 0 if $self->{chunk_remaining}; |
220
|
0
|
|
|
|
|
|
$self->debug_printf("Look for next chunk"); |
221
|
0
|
|
|
|
|
|
delete $self->{chunk_remaining}; |
222
|
0
|
|
|
|
|
|
return 1; |
223
|
|
|
|
|
|
|
} else { |
224
|
0
|
0
|
|
|
|
|
return 0 if -1 == (my $size_len = index($$buffref, "\x0D\x0A")); |
225
|
0
|
|
|
|
|
|
$self->{chunk_remaining} = hex substr $$buffref, 0, $size_len, ''; |
226
|
0
|
|
|
|
|
|
substr $$buffref, 0, 2, ''; |
227
|
0
|
|
|
|
|
|
$self->debug_printf("Have %d bytes in this chunk", $self->{chunk_remaining}); |
228
|
0
|
0
|
|
|
|
|
return 1 if $self->{chunk_remaining}; |
229
|
0
|
|
|
|
|
|
$self->debug_printf("End of chunked data, looking for trailing headers"); |
230
|
0
|
|
|
|
|
|
return $self->can('on_trailing_header'); |
231
|
|
|
|
|
|
|
} |
232
|
|
|
|
|
|
|
} |
233
|
|
|
|
|
|
|
|
234
|
|
|
|
|
|
|
=head2 on_trailing_header |
235
|
|
|
|
|
|
|
|
236
|
|
|
|
|
|
|
Deal with trailing headers. Not yet implemented. |
237
|
|
|
|
|
|
|
|
238
|
|
|
|
|
|
|
=cut |
239
|
|
|
|
|
|
|
|
240
|
|
|
|
|
|
|
sub on_trailing_header { |
241
|
0
|
|
|
0
|
1
|
|
my ($self, $buffref, $eof) = @_; |
242
|
|
|
|
|
|
|
# FIXME not yet implemented |
243
|
0
|
|
|
|
|
|
$$buffref = ''; |
244
|
0
|
|
|
|
|
|
return $self->finish_request; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
=head2 read_to_length |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
Read up to the expected fixed length of data. |
250
|
|
|
|
|
|
|
|
251
|
|
|
|
|
|
|
=cut |
252
|
|
|
|
|
|
|
|
253
|
|
|
|
|
|
|
sub read_to_length { |
254
|
0
|
|
|
0
|
1
|
|
my ($self, $buffref, $eof) = @_; |
255
|
0
|
|
|
|
|
|
$self->{remaining} -= length $$buffref; |
256
|
0
|
|
|
|
|
|
$self->debug_printf("Body read: $self, $buffref, $eof: %s with %d remaining", $$buffref, $self->{remaining}); |
257
|
0
|
|
|
|
|
|
$self->{input_handler}->($$buffref); |
258
|
0
|
|
|
|
|
|
$$buffref = ''; |
259
|
0
|
0
|
|
|
|
|
return $self->finish_request unless $self->{remaining}; |
260
|
0
|
|
|
|
|
|
return 0; |
261
|
|
|
|
|
|
|
} |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=head2 request_body |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
Accessor for the request body, available to the L callback. |
266
|
|
|
|
|
|
|
|
267
|
|
|
|
|
|
|
=cut |
268
|
|
|
|
|
|
|
|
269
|
0
|
|
|
0
|
1
|
|
sub request_body { shift->{request_body} } |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
sub content_handler_raw { |
272
|
0
|
|
|
0
|
0
|
|
my ($self, $data) = @_; |
273
|
0
|
0
|
|
|
|
|
if(defined $data) { |
274
|
0
|
|
|
|
|
|
$self->{data} .= $data; |
275
|
|
|
|
|
|
|
} else { |
276
|
0
|
|
|
|
|
|
return $self->{data} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
} |
279
|
|
|
|
|
|
|
|
280
|
|
|
|
|
|
|
=head2 content_handler_json |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
Handle JSON content. |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
=cut |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub content_handler_json { |
287
|
0
|
|
|
0
|
1
|
|
my ($self, $data) = @_; |
288
|
0
|
0
|
|
|
|
|
if(defined $data) { |
289
|
|
|
|
|
|
|
eval { |
290
|
0
|
|
|
|
|
|
$self->json->incr_parse($data); |
291
|
0
|
|
|
|
|
|
1 |
292
|
0
|
0
|
|
|
|
|
} or do { |
293
|
0
|
|
|
|
|
|
$self->debug_printf("Invalid JSON received: %s", $@); |
294
|
|
|
|
|
|
|
}; |
295
|
|
|
|
|
|
|
} else { |
296
|
|
|
|
|
|
|
return eval { |
297
|
0
|
|
|
|
|
|
$self->json->incr_parse |
298
|
0
|
|
0
|
|
|
|
} // do { |
299
|
0
|
|
|
|
|
|
$self->debug_printf("Invalid JSON from incr_parse: %s", $@); |
300
|
|
|
|
|
|
|
} |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
my %status = ( |
305
|
|
|
|
|
|
|
100 => 'Continue', |
306
|
|
|
|
|
|
|
101 => 'Switching protocols', |
307
|
|
|
|
|
|
|
102 => 'Processing', |
308
|
|
|
|
|
|
|
200 => 'OK', |
309
|
|
|
|
|
|
|
201 => 'Created', |
310
|
|
|
|
|
|
|
202 => 'Accepted', |
311
|
|
|
|
|
|
|
203 => 'Non-authoritative information', |
312
|
|
|
|
|
|
|
204 => 'No content', |
313
|
|
|
|
|
|
|
205 => 'Reset content', |
314
|
|
|
|
|
|
|
206 => 'Partial content', |
315
|
|
|
|
|
|
|
207 => 'Multi-status', |
316
|
|
|
|
|
|
|
208 => 'Already reported', |
317
|
|
|
|
|
|
|
226 => 'IM used', |
318
|
|
|
|
|
|
|
300 => 'Multiple choices', |
319
|
|
|
|
|
|
|
301 => 'Moved permanently', |
320
|
|
|
|
|
|
|
302 => 'Found', |
321
|
|
|
|
|
|
|
303 => 'See other', |
322
|
|
|
|
|
|
|
304 => 'Not modified', |
323
|
|
|
|
|
|
|
305 => 'Use proxy', |
324
|
|
|
|
|
|
|
307 => 'Temporary redirect', |
325
|
|
|
|
|
|
|
308 => 'Permanent redirect', |
326
|
|
|
|
|
|
|
400 => 'Bad request', |
327
|
|
|
|
|
|
|
401 => 'Unauthorised', |
328
|
|
|
|
|
|
|
402 => 'Payment required', |
329
|
|
|
|
|
|
|
403 => 'Forbidden', |
330
|
|
|
|
|
|
|
404 => 'Not found', |
331
|
|
|
|
|
|
|
405 => 'Method not allowed', |
332
|
|
|
|
|
|
|
500 => 'Internal server error', |
333
|
|
|
|
|
|
|
); |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
sub write_response { |
336
|
0
|
|
|
0
|
0
|
|
my ($self, $code, $hdr, $body) = @_; |
337
|
0
|
0
|
|
|
|
|
my $type = ref($body) ? 'text/javascript' : 'text/plain'; |
338
|
0
|
0
|
|
|
|
|
my $content = ref($body) ? encode_json($body) : encode( |
339
|
|
|
|
|
|
|
'UTF-8' => $body |
340
|
|
|
|
|
|
|
); |
341
|
0
|
|
0
|
|
|
|
$hdr ||= []; |
342
|
0
|
|
|
|
|
|
if(USE_HTTP_RESPONSE) { |
343
|
|
|
|
|
|
|
return $self->write( |
344
|
|
|
|
|
|
|
'HTTP/1.1 ' . HTTP::Response->new( |
345
|
|
|
|
|
|
|
$code => ($status{$code} // 'Unknown'), [ |
346
|
|
|
|
|
|
|
'Content-Type' => $type, |
347
|
|
|
|
|
|
|
'Content-Length' => length $content, |
348
|
|
|
|
|
|
|
@$hdr |
349
|
|
|
|
|
|
|
], |
350
|
|
|
|
|
|
|
$content |
351
|
|
|
|
|
|
|
)->as_string("\x0D\x0A") |
352
|
|
|
|
|
|
|
) |
353
|
|
|
|
|
|
|
} else { |
354
|
|
|
|
|
|
|
return $self->write( |
355
|
|
|
|
|
|
|
join "\015\012", ( |
356
|
|
|
|
|
|
|
'HTTP/1.1 ' . $code . ' ' . ($status{$code} // 'Unknown'), |
357
|
|
|
|
|
|
|
'Content-Type: ' . $type, |
358
|
|
|
|
|
|
|
'Content-Length: ' . length($content), |
359
|
0
|
|
0
|
0
|
|
|
(bundle_by { join ': ', @_ } 2, @$hdr), |
|
0
|
|
|
|
|
|
|
360
|
|
|
|
|
|
|
'', |
361
|
|
|
|
|
|
|
$content |
362
|
|
|
|
|
|
|
) |
363
|
|
|
|
|
|
|
) |
364
|
|
|
|
|
|
|
} |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
|
367
|
|
|
|
|
|
|
1; |
368
|
|
|
|
|
|
|
|
369
|
|
|
|
|
|
|
__END__ |