use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 131072;
has nph => 0;
# "Lisa, you're a Buddhist, so you believe in reincarnation.
# Eventually, Snowball will be reborn as a higher lifeform...
# like a snowman."
sub run {
my $self = shift;
# Environment
my $tx = $self->build_tx;
my $req = $tx->req->parse(\%ENV);
# Store connection information
$tx->local_port($ENV{SERVER_PORT})->remote_address($ENV{REMOTE_ADDR});
# Request body
binmode STDIN;
until ($req->is_finished) {
last unless my $read = STDIN->read(my $buffer, CHUNK_SIZE, 0);
$req->parse($buffer);
}
# Handle
$self->emit(request => $tx);
# Response start line
STDOUT->autoflush(1);
binmode STDOUT;
my $res = $tx->res;
my $offset = 0;
while ($self->nph) {
my $chunk = $res->get_start_line_chunk($offset);
# No start line yet, try again
sleep 1 and next unless defined $chunk;
# End of start line
last unless length $chunk;
# Start line
return unless STDOUT->opened;
print STDOUT $chunk;
$offset += length $chunk;
}
# Response headers
$res->fix_headers;
my $code = $res->code || 404;
my $message = $res->message || $res->default_message;
$res->headers->status("$code $message") unless $self->nph;
$offset = 0;
while (1) {
my $chunk = $res->get_header_chunk($offset);
# No headers yet, try again
sleep 1 and next unless defined $chunk;
# End of headers
last unless length $chunk;
# Headers
return unless STDOUT->opened;
print STDOUT $chunk;
$offset += length $chunk;
}
# Response body
$offset = 0;
while (1) {
my $chunk = $res->get_body_chunk($offset);
# No content yet, try again
sleep 1 and next unless defined $chunk;
# End of content
last unless length $chunk;
# Content
return unless STDOUT->opened;
print STDOUT $chunk;
$offset += length $chunk;
}
# Finish transaction
$tx->server_close;
return $res->code;
}
1;
__END__
=head1 NAME
Mojo::Server::CGI - CGI server
=head1 SYNOPSIS
use Mojo::Server::CGI;
my $cgi = Mojo::Server::CGI->new;
$cgi->unsubscribe('request')
$cgi->on(request => sub {
my ($cgi, $tx) = @_;
# Request
my $method = $tx->req->method;
my $path = $tx->req->url->path;
# Response
$tx->res->code(200);
$tx->res->headers->content_type('text/plain');
$tx->res->body("$method request for $path!");
# Resume transaction
$tx->resume;
});
$cgi->run;
=head1 DESCRIPTION
L<Mojo::Server::CGI> is a simple and portable implementation of RFC 3875.
See L<Mojolicious::Guides::Cookbook> for deployment recipes.
=head1 EVENTS
L<Mojo::Server::CGI> inherits all events from L<Mojo::Server>.
=head1 ATTRIBUTES
L<Mojo::Server::CGI> inherits all attributes from L<Mojo::Server> and
implements the following new ones.
=head2 C<nph>
my $nph = $cgi->nph;
$cgi = $cgi->nph(1);
Activate non parsed header mode.
=head1 METHODS
L<Mojo::Server::CGI> inherits all methods from L<Mojo::Server> and
implements the following new ones.
=head2 C<run>
$cgi->run;
Run CGI.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>.
=cut