1 | package Mojo::Transaction::HTTP;
|
---|
2 | use Mojo::Base 'Mojo::Transaction';
|
---|
3 |
|
---|
4 | has 'previous';
|
---|
5 |
|
---|
6 | sub client_read {
|
---|
7 | my ($self, $chunk) = @_;
|
---|
8 |
|
---|
9 | # Skip body for HEAD request
|
---|
10 | my $res = $self->res;
|
---|
11 | $res->content->skip_body(1) if uc $self->req->method eq 'HEAD';
|
---|
12 | return unless $res->parse($chunk)->is_finished;
|
---|
13 |
|
---|
14 | # Unexpected 1xx response
|
---|
15 | return $self->completed if !$res->is_info || $res->headers->upgrade;
|
---|
16 | $self->res($res->new)->emit(unexpected => $res);
|
---|
17 | return unless length(my $leftovers = $res->content->leftovers);
|
---|
18 | $self->client_read($leftovers);
|
---|
19 | }
|
---|
20 |
|
---|
21 | sub client_write { shift->_write(0) }
|
---|
22 |
|
---|
23 | sub is_empty { !!(uc $_[0]->req->method eq 'HEAD' || $_[0]->res->is_empty) }
|
---|
24 |
|
---|
25 | sub keep_alive {
|
---|
26 | my $self = shift;
|
---|
27 |
|
---|
28 | # Close
|
---|
29 | my $req = $self->req;
|
---|
30 | my $res = $self->res;
|
---|
31 | my $req_conn = lc($req->headers->connection // '');
|
---|
32 | my $res_conn = lc($res->headers->connection // '');
|
---|
33 | return undef if $req_conn eq 'close' || $res_conn eq 'close';
|
---|
34 |
|
---|
35 | # Keep-alive is optional for 1.0
|
---|
36 | return $res_conn eq 'keep-alive' if $res->version eq '1.0';
|
---|
37 | return $req_conn eq 'keep-alive' if $req->version eq '1.0';
|
---|
38 |
|
---|
39 | # Keep-alive is the default for 1.1
|
---|
40 | return 1;
|
---|
41 | }
|
---|
42 |
|
---|
43 | sub redirects {
|
---|
44 | my $previous = shift;
|
---|
45 | my @redirects;
|
---|
46 | unshift @redirects, $previous while $previous = $previous->previous;
|
---|
47 | return \@redirects;
|
---|
48 | }
|
---|
49 |
|
---|
50 | sub resume { ++$_[0]{writing} and return $_[0]->emit('resume') }
|
---|
51 |
|
---|
52 | sub server_read {
|
---|
53 | my ($self, $chunk) = @_;
|
---|
54 |
|
---|
55 | # Parse request
|
---|
56 | my $req = $self->req;
|
---|
57 | $req->parse($chunk) unless $req->error;
|
---|
58 |
|
---|
59 | # Generate response
|
---|
60 | $self->emit('request') if $req->is_finished && !$self->{handled}++;
|
---|
61 | }
|
---|
62 |
|
---|
63 | sub server_write { shift->_write(1) }
|
---|
64 |
|
---|
65 | sub _body {
|
---|
66 | my ($self, $msg, $finish) = @_;
|
---|
67 |
|
---|
68 | # Prepare body chunk
|
---|
69 | my $buffer = $msg->get_body_chunk($self->{offset});
|
---|
70 | my $written = defined $buffer ? length $buffer : 0;
|
---|
71 | $self->{write} = $msg->content->is_dynamic ? 1 : ($self->{write} - $written);
|
---|
72 | $self->{offset} += $written;
|
---|
73 |
|
---|
74 | # Delayed
|
---|
75 | $self->{writing} = 0 unless defined $buffer;
|
---|
76 |
|
---|
77 | # Finished
|
---|
78 | $finish ? $self->completed : ($self->{writing} = 0)
|
---|
79 | if $self->{write} <= 0 || defined $buffer && !length $buffer;
|
---|
80 |
|
---|
81 | return $buffer // '';
|
---|
82 | }
|
---|
83 |
|
---|
84 | sub _headers {
|
---|
85 | my ($self, $msg, $head) = @_;
|
---|
86 |
|
---|
87 | # Prepare header chunk
|
---|
88 | my $buffer = $msg->get_header_chunk($self->{offset});
|
---|
89 | my $written = defined $buffer ? length $buffer : 0;
|
---|
90 | $self->{write} -= $written;
|
---|
91 | $self->{offset} += $written;
|
---|
92 |
|
---|
93 | # Switch to body
|
---|
94 | if ($self->{write} <= 0) {
|
---|
95 | @$self{qw(http_state offset)} = ('body', 0);
|
---|
96 |
|
---|
97 | # Response without body
|
---|
98 | if ($head && $self->is_empty) { $self->completed->{http_state} = 'empty' }
|
---|
99 |
|
---|
100 | # Body
|
---|
101 | else { $self->{write} = $msg->content->is_dynamic ? 1 : $msg->body_size }
|
---|
102 | }
|
---|
103 |
|
---|
104 | return $buffer;
|
---|
105 | }
|
---|
106 |
|
---|
107 | sub _start_line {
|
---|
108 | my ($self, $msg) = @_;
|
---|
109 |
|
---|
110 | # Prepare start-line chunk
|
---|
111 | my $buffer = $msg->get_start_line_chunk($self->{offset});
|
---|
112 | my $written = defined $buffer ? length $buffer : 0;
|
---|
113 | $self->{write} -= $written;
|
---|
114 | $self->{offset} += $written;
|
---|
115 |
|
---|
116 | # Switch to headers
|
---|
117 | @$self{qw(http_state write offset)} = ('headers', $msg->header_size, 0)
|
---|
118 | if $self->{write} <= 0;
|
---|
119 |
|
---|
120 | return $buffer;
|
---|
121 | }
|
---|
122 |
|
---|
123 | sub _write {
|
---|
124 | my ($self, $server) = @_;
|
---|
125 |
|
---|
126 | # Client starts writing right away
|
---|
127 | return '' unless $server ? $self->{writing} : ($self->{writing} //= 1);
|
---|
128 |
|
---|
129 | # Nothing written yet
|
---|
130 | $self->{$_} ||= 0 for qw(offset write);
|
---|
131 | my $msg = $server ? $self->res : $self->req;
|
---|
132 | @$self{qw(http_state write)} = ('start_line', $msg->start_line_size)
|
---|
133 | unless $self->{http_state};
|
---|
134 |
|
---|
135 | # Start-line
|
---|
136 | my $chunk = '';
|
---|
137 | $chunk .= $self->_start_line($msg) if $self->{http_state} eq 'start_line';
|
---|
138 |
|
---|
139 | # Headers
|
---|
140 | $chunk .= $self->_headers($msg, $server) if $self->{http_state} eq 'headers';
|
---|
141 |
|
---|
142 | # Body
|
---|
143 | $chunk .= $self->_body($msg, $server) if $self->{http_state} eq 'body';
|
---|
144 |
|
---|
145 | return $chunk;
|
---|
146 | }
|
---|
147 |
|
---|
148 | 1;
|
---|
149 |
|
---|
150 | =encoding utf8
|
---|
151 |
|
---|
152 | =head1 NAME
|
---|
153 |
|
---|
154 | Mojo::Transaction::HTTP - HTTP transaction
|
---|
155 |
|
---|
156 | =head1 SYNOPSIS
|
---|
157 |
|
---|
158 | use Mojo::Transaction::HTTP;
|
---|
159 |
|
---|
160 | # Client
|
---|
161 | my $tx = Mojo::Transaction::HTTP->new;
|
---|
162 | $tx->req->method('GET');
|
---|
163 | $tx->req->url->parse('http://example.com');
|
---|
164 | $tx->req->headers->accept('application/json');
|
---|
165 | say $tx->res->code;
|
---|
166 | say $tx->res->headers->content_type;
|
---|
167 | say $tx->res->body;
|
---|
168 | say $tx->remote_address;
|
---|
169 |
|
---|
170 | # Server
|
---|
171 | my $tx = Mojo::Transaction::HTTP->new;
|
---|
172 | say $tx->req->method;
|
---|
173 | say $tx->req->url->to_abs;
|
---|
174 | say $tx->req->headers->accept;
|
---|
175 | say $tx->remote_address;
|
---|
176 | $tx->res->code(200);
|
---|
177 | $tx->res->headers->content_type('text/plain');
|
---|
178 | $tx->res->body('Hello World!');
|
---|
179 |
|
---|
180 | =head1 DESCRIPTION
|
---|
181 |
|
---|
182 | L<Mojo::Transaction::HTTP> is a container for HTTP transactions, based on
|
---|
183 | L<RFC 7230|http://tools.ietf.org/html/rfc7230> and
|
---|
184 | L<RFC 7231|http://tools.ietf.org/html/rfc7231>.
|
---|
185 |
|
---|
186 | =head1 EVENTS
|
---|
187 |
|
---|
188 | L<Mojo::Transaction::HTTP> inherits all events from L<Mojo::Transaction> and
|
---|
189 | can emit the following new ones.
|
---|
190 |
|
---|
191 | =head2 request
|
---|
192 |
|
---|
193 | $tx->on(request => sub {
|
---|
194 | my $tx = shift;
|
---|
195 | ...
|
---|
196 | });
|
---|
197 |
|
---|
198 | Emitted when a request is ready and needs to be handled.
|
---|
199 |
|
---|
200 | $tx->on(request => sub {
|
---|
201 | my $tx = shift;
|
---|
202 | $tx->res->headers->header('X-Bender' => 'Bite my shiny metal ass!');
|
---|
203 | });
|
---|
204 |
|
---|
205 | =head2 resume
|
---|
206 |
|
---|
207 | $tx->on(resume => sub {
|
---|
208 | my $tx = shift;
|
---|
209 | ...
|
---|
210 | });
|
---|
211 |
|
---|
212 | Emitted when transaction is resumed.
|
---|
213 |
|
---|
214 | =head2 unexpected
|
---|
215 |
|
---|
216 | $tx->on(unexpected => sub {
|
---|
217 | my ($tx, $res) = @_;
|
---|
218 | ...
|
---|
219 | });
|
---|
220 |
|
---|
221 | Emitted for unexpected C<1xx> responses that will be ignored.
|
---|
222 |
|
---|
223 | $tx->on(unexpected => sub {
|
---|
224 | my $tx = shift;
|
---|
225 | $tx->res->on(finish => sub { say 'Follow-up response is finished.' });
|
---|
226 | });
|
---|
227 |
|
---|
228 | =head1 ATTRIBUTES
|
---|
229 |
|
---|
230 | L<Mojo::Transaction::HTTP> inherits all attributes from L<Mojo::Transaction>
|
---|
231 | and implements the following new ones.
|
---|
232 |
|
---|
233 | =head2 previous
|
---|
234 |
|
---|
235 | my $previous = $tx->previous;
|
---|
236 | $tx = $tx->previous(Mojo::Transaction::HTTP->new);
|
---|
237 |
|
---|
238 | Previous transaction that triggered this follow-up transaction, usually a
|
---|
239 | L<Mojo::Transaction::HTTP> object.
|
---|
240 |
|
---|
241 | # Paths of previous requests
|
---|
242 | say $tx->previous->previous->req->url->path;
|
---|
243 | say $tx->previous->req->url->path;
|
---|
244 |
|
---|
245 | =head1 METHODS
|
---|
246 |
|
---|
247 | L<Mojo::Transaction::HTTP> inherits all methods from L<Mojo::Transaction> and
|
---|
248 | implements the following new ones.
|
---|
249 |
|
---|
250 | =head2 client_read
|
---|
251 |
|
---|
252 | $tx->client_read($bytes);
|
---|
253 |
|
---|
254 | Read data client-side, used to implement user agents such as L<Mojo::UserAgent>.
|
---|
255 |
|
---|
256 | =head2 client_write
|
---|
257 |
|
---|
258 | my $bytes = $tx->client_write;
|
---|
259 |
|
---|
260 | Write data client-side, used to implement user agents such as
|
---|
261 | L<Mojo::UserAgent>.
|
---|
262 |
|
---|
263 | =head2 is_empty
|
---|
264 |
|
---|
265 | my $bool = $tx->is_empty;
|
---|
266 |
|
---|
267 | Check transaction for C<HEAD> request and C<1xx>, C<204> or C<304> response.
|
---|
268 |
|
---|
269 | =head2 keep_alive
|
---|
270 |
|
---|
271 | my $bool = $tx->keep_alive;
|
---|
272 |
|
---|
273 | Check if connection can be kept alive.
|
---|
274 |
|
---|
275 | =head2 redirects
|
---|
276 |
|
---|
277 | my $redirects = $tx->redirects;
|
---|
278 |
|
---|
279 | Return an array reference with all previous transactions that preceded this
|
---|
280 | follow-up transaction.
|
---|
281 |
|
---|
282 | # Paths of all previous requests
|
---|
283 | say $_->req->url->path for @{$tx->redirects};
|
---|
284 |
|
---|
285 | =head2 resume
|
---|
286 |
|
---|
287 | $tx = $tx->resume;
|
---|
288 |
|
---|
289 | Resume transaction.
|
---|
290 |
|
---|
291 | =head2 server_read
|
---|
292 |
|
---|
293 | $tx->server_read($bytes);
|
---|
294 |
|
---|
295 | Read data server-side, used to implement web servers such as
|
---|
296 | L<Mojo::Server::Daemon>.
|
---|
297 |
|
---|
298 | =head2 server_write
|
---|
299 |
|
---|
300 | my $bytes = $tx->server_write;
|
---|
301 |
|
---|
302 | Write data server-side, used to implement web servers such as
|
---|
303 | L<Mojo::Server::Daemon>.
|
---|
304 |
|
---|
305 | =head1 SEE ALSO
|
---|
306 |
|
---|
307 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
308 |
|
---|
309 | =cut
|
---|