1 contributor
package Mojo::Transaction::HTTP;
use Mojo::Base 'Mojo::Transaction';
use Mojo::Transaction::WebSocket;
has 'previous';
sub client_read {
my ($self, $chunk) = @_;
# Skip body for HEAD request
my $res = $self->res;
$res->content->skip_body(1) if uc $self->req->method eq 'HEAD';
return unless $res->parse($chunk)->is_finished;
# Unexpected 1xx response
return $self->{state} = 'finished'
if !$res->is_status_class(100) || $res->headers->upgrade;
$self->res($res->new)->emit(unexpected => $res);
return unless length(my $leftovers = $res->content->leftovers);
$self->client_read($leftovers);
}
sub client_write { shift->_write(0) }
sub is_empty { !!(uc $_[0]->req->method eq 'HEAD' || $_[0]->res->is_empty) }
sub keep_alive {
my $self = shift;
# Close
my $req = $self->req;
my $res = $self->res;
my $req_conn = lc($req->headers->connection // '');
my $res_conn = lc($res->headers->connection // '');
return undef if $req_conn eq 'close' || $res_conn eq 'close';
# Keep-alive
return 1 if $req_conn eq 'keep-alive' || $res_conn eq 'keep-alive';
# No keep-alive for 1.0
return !($req->version eq '1.0' || $res->version eq '1.0');
}
sub redirects {
my $previous = shift;
my @redirects;
unshift @redirects, $previous while $previous = $previous->previous;
return \@redirects;
}
sub server_read {
my ($self, $chunk) = @_;
# Parse request
my $req = $self->req;
$req->parse($chunk) unless $req->error;
$self->{state} ||= 'read';
# Generate response
return unless $req->is_finished && !$self->{handled}++;
$self->emit(upgrade => Mojo::Transaction::WebSocket->new(handshake => $self))
if lc($req->headers->upgrade // '') eq 'websocket';
$self->emit('request');
}
sub server_write { shift->_write(1) }
sub _body {
my ($self, $msg, $finish) = @_;
# Prepare body chunk
my $buffer = $msg->get_body_chunk($self->{offset});
my $written = defined $buffer ? length $buffer : 0;
$self->{write} = $msg->content->is_dynamic ? 1 : ($self->{write} - $written);
$self->{offset} = $self->{offset} + $written;
if (defined $buffer) { delete $self->{delay} }
# Delayed
else {
if (delete $self->{delay}) { $self->{state} = 'paused' }
else { $self->{delay} = 1 }
}
# Finished
$self->{state} = $finish ? 'finished' : 'read'
if $self->{write} <= 0 || (defined $buffer && !length $buffer);
return defined $buffer ? $buffer : '';
}
sub _headers {
my ($self, $msg, $head) = @_;
# Prepare header chunk
my $buffer = $msg->get_header_chunk($self->{offset});
my $written = defined $buffer ? length $buffer : 0;
$self->{write} = $self->{write} - $written;
$self->{offset} = $self->{offset} + $written;
# Switch to body
if ($self->{write} <= 0) {
$self->{offset} = 0;
# Response without body
if ($head && $self->is_empty) { $self->{state} = 'finished' }
# Body
else {
$self->{http_state} = 'body';
$self->{write} = $msg->content->is_dynamic ? 1 : $msg->body_size;
}
}
return $buffer;
}
sub _start_line {
my ($self, $msg) = @_;
# Prepare start line chunk
my $buffer = $msg->get_start_line_chunk($self->{offset});
my $written = defined $buffer ? length $buffer : 0;
$self->{write} = $self->{write} - $written;
$self->{offset} = $self->{offset} + $written;
# Switch to headers
if ($self->{write} <= 0) {
$self->{http_state} = 'headers';
$self->{write} = $msg->header_size;
$self->{offset} = 0;
}
return $buffer;
}
sub _write {
my ($self, $server) = @_;
# Client starts writing right away
$self->{state} ||= 'write' unless $server;
return '' unless $self->{state} eq 'write';
# Nothing written yet
$self->{$_} ||= 0 for qw(offset write);
my $msg = $server ? $self->res : $self->req;
unless ($self->{http_state}) {
# Connection header
my $headers = $msg->headers;
$headers->connection($self->keep_alive ? 'keep-alive' : 'close')
unless $headers->connection;
# Switch to start line
$self->{http_state} = 'start_line';
$self->{write} = $msg->start_line_size;
}
# Start line
my $chunk = '';
$chunk .= $self->_start_line($msg) if $self->{http_state} eq 'start_line';
# Headers
$chunk .= $self->_headers($msg, $server) if $self->{http_state} eq 'headers';
# Body
$chunk .= $self->_body($msg, $server) if $self->{http_state} eq 'body';
return $chunk;
}
1;
=encoding utf8
=head1 NAME
Mojo::Transaction::HTTP - HTTP transaction
=head1 SYNOPSIS
use Mojo::Transaction::HTTP;
# Client
my $tx = Mojo::Transaction::HTTP->new;
$tx->req->method('GET');
$tx->req->url->parse('http://example.com');
$tx->req->headers->accept('application/json');
say $tx->res->code;
say $tx->res->headers->content_type;
say $tx->res->body;
say $tx->remote_address;
# Server
my $tx = Mojo::Transaction::HTTP->new;
say $tx->req->method;
say $tx->req->url->to_abs;
say $tx->req->headers->accept;
say $tx->remote_address;
$tx->res->code(200);
$tx->res->headers->content_type('text/plain');
$tx->res->body('Hello World!');
=head1 DESCRIPTION
L<Mojo::Transaction::HTTP> is a container for HTTP transactions as described
in RFC 2616.
=head1 EVENTS
L<Mojo::Transaction::HTTP> inherits all events from L<Mojo::Transaction> and
can emit the following new ones.
=head2 request
$tx->on(request => sub {
my $tx = shift;
...
});
Emitted when a request is ready and needs to be handled.
$tx->on(request => sub {
my $tx = shift;
$tx->res->headers->header('X-Bender' => 'Bite my shiny metal ass!');
});
=head2 unexpected
$tx->on(unexpected => sub {
my ($tx, $res) = @_;
...
});
Emitted for unexpected C<1xx> responses that will be ignored.
$tx->on(unexpected => sub {
my $tx = shift;
$tx->res->on(finish => sub { say 'Followup response is finished.' });
});
=head2 upgrade
$tx->on(upgrade => sub {
my ($tx, $ws) = @_;
...
});
Emitted when transaction gets upgraded to a L<Mojo::Transaction::WebSocket>
object.
$tx->on(upgrade => sub {
my ($tx, $ws) = @_;
$ws->res->headers->header('X-Bender' => 'Bite my shiny metal ass!');
});
=head1 ATTRIBUTES
L<Mojo::Transaction::HTTP> inherits all attributes from L<Mojo::Transaction>
and implements the following new ones.
=head2 previous
my $previous = $tx->previous;
$tx = $tx->previous(Mojo::Transaction->new);
Previous transaction that triggered this followup transaction.
# Paths of previous requests
say $tx->previous->previous->req->url->path;
say $tx->previous->req->url->path;
=head1 METHODS
L<Mojo::Transaction::HTTP> inherits all methods from L<Mojo::Transaction> and
implements the following new ones.
=head2 client_read
$tx->client_read($bytes);
Read data client-side, used to implement user agents.
=head2 client_write
my $bytes = $tx->client_write;
Write data client-side, used to implement user agents.
=head2 is_empty
my $bool = $tx->is_empty;
Check transaction for C<HEAD> request and C<1xx>, C<204> or C<304> response.
=head2 keep_alive
my $bool = $tx->keep_alive;
Check if connection can be kept alive.
=head2 redirects
my $redirects = $tx->redirects;
Return a list of all previous transactions that preceded this followup
transaction.
# Paths of all previous requests
say $_->req->url->path for @{$tx->redirects};
=head2 server_read
$tx->server_read($bytes);
Read data server-side, used to implement web servers.
=head2 server_write
my $bytes = $tx->server_write;
Write data server-side, used to implement web servers.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
=cut