|
add files
|
1 |
package Mojo::Server::CGI; |
| 2 |
use Mojo::Base 'Mojo::Server'; |
|
| 3 | ||
| 4 |
has 'nph'; |
|
| 5 | ||
| 6 |
sub run {
|
|
| 7 |
my $self = shift; |
|
| 8 | ||
| 9 |
my $tx = $self->build_tx; |
|
| 10 |
my $req = $tx->req->parse(\%ENV); |
|
| 11 |
$tx->local_port($ENV{SERVER_PORT})->remote_address($ENV{REMOTE_ADDR});
|
|
| 12 | ||
| 13 |
# Request body (may block if we try to read too much) |
|
| 14 |
binmode STDIN; |
|
| 15 |
my $len = $req->headers->content_length; |
|
| 16 |
until ($req->is_finished) {
|
|
| 17 |
my $chunk = ($len && $len < 131072) ? $len : 131072; |
|
| 18 |
last unless my $read = STDIN->read(my $buffer, $chunk, 0); |
|
| 19 |
$req->parse($buffer); |
|
| 20 |
last if ($len -= $read) <= 0; |
|
| 21 |
} |
|
| 22 | ||
| 23 |
# Handle request |
|
| 24 |
$self->emit(request => $tx); |
|
| 25 | ||
| 26 |
# Response start line |
|
| 27 |
STDOUT->autoflush(1); |
|
| 28 |
binmode STDOUT; |
|
| 29 |
my $res = $tx->res; |
|
| 30 |
return undef if $self->nph && !_write($res, 'get_start_line_chunk'); |
|
| 31 | ||
| 32 |
# Response headers |
|
| 33 |
$res->fix_headers; |
|
| 34 |
my $code = $res->code || 404; |
|
| 35 |
my $msg = $res->message || $res->default_message; |
|
| 36 |
$res->headers->status("$code $msg") unless $self->nph;
|
|
| 37 |
return undef unless _write($res, 'get_header_chunk'); |
|
| 38 | ||
| 39 |
# Response body |
|
| 40 |
$tx->is_empty or _write($res, 'get_body_chunk') or return undef; |
|
| 41 | ||
| 42 |
# Finish transaction |
|
| 43 |
$tx->server_close; |
|
| 44 | ||
| 45 |
return $res->code; |
|
| 46 |
} |
|
| 47 | ||
| 48 |
sub _write {
|
|
| 49 |
my ($res, $method) = @_; |
|
| 50 | ||
| 51 |
my $offset = 0; |
|
| 52 |
while (1) {
|
|
| 53 | ||
| 54 |
# No chunk yet, try again |
|
| 55 |
sleep 1 and next unless defined(my $chunk = $res->$method($offset)); |
|
| 56 | ||
| 57 |
# End of part |
|
| 58 |
last unless my $len = length $chunk; |
|
| 59 | ||
| 60 |
# Make sure we can still write |
|
| 61 |
$offset += $len; |
|
| 62 |
return undef unless STDOUT->opened; |
|
| 63 |
print STDOUT $chunk; |
|
| 64 |
} |
|
| 65 | ||
| 66 |
return 1; |
|
| 67 |
} |
|
| 68 | ||
| 69 |
1; |
|
| 70 | ||
| 71 |
=encoding utf8 |
|
| 72 | ||
| 73 |
=head1 NAME |
|
| 74 | ||
| 75 |
Mojo::Server::CGI - CGI server |
|
| 76 | ||
| 77 |
=head1 SYNOPSIS |
|
| 78 | ||
| 79 |
use Mojo::Server::CGI; |
|
| 80 | ||
| 81 |
my $cgi = Mojo::Server::CGI->new; |
|
| 82 |
$cgi->unsubscribe('request')
|
|
| 83 |
$cgi->on(request => sub {
|
|
| 84 |
my ($cgi, $tx) = @_; |
|
| 85 | ||
| 86 |
# Request |
|
| 87 |
my $method = $tx->req->method; |
|
| 88 |
my $path = $tx->req->url->path; |
|
| 89 | ||
| 90 |
# Response |
|
| 91 |
$tx->res->code(200); |
|
| 92 |
$tx->res->headers->content_type('text/plain');
|
|
| 93 |
$tx->res->body("$method request for $path!");
|
|
| 94 | ||
| 95 |
# Resume transaction |
|
| 96 |
$tx->resume; |
|
| 97 |
}); |
|
| 98 |
$cgi->run; |
|
| 99 | ||
| 100 |
=head1 DESCRIPTION |
|
| 101 | ||
| 102 |
L<Mojo::Server::CGI> is a simple and portable implementation of RFC 3875. |
|
| 103 | ||
| 104 |
See L<Mojolicious::Guides::Cookbook> for more. |
|
| 105 | ||
| 106 |
=head1 EVENTS |
|
| 107 | ||
| 108 |
L<Mojo::Server::CGI> inherits all events from L<Mojo::Server>. |
|
| 109 | ||
| 110 |
=head1 ATTRIBUTES |
|
| 111 | ||
| 112 |
L<Mojo::Server::CGI> inherits all attributes from L<Mojo::Server> and |
|
| 113 |
implements the following new ones. |
|
| 114 | ||
| 115 |
=head2 nph |
|
| 116 | ||
| 117 |
my $bool = $cgi->nph; |
|
| 118 |
$cgi = $cgi->nph($bool); |
|
| 119 | ||
| 120 |
Activate non-parsed header mode. |
|
| 121 | ||
| 122 |
=head1 METHODS |
|
| 123 | ||
| 124 |
L<Mojo::Server::CGI> inherits all methods from L<Mojo::Server> and implements |
|
| 125 |
the following new ones. |
|
| 126 | ||
| 127 |
=head2 run |
|
| 128 | ||
| 129 |
my $status = $cgi->run; |
|
| 130 | ||
| 131 |
Run CGI. |
|
| 132 | ||
| 133 |
=head1 SEE ALSO |
|
| 134 | ||
| 135 |
L<Mojolicious>, L<Mojolicious::Guides>, L<http://mojolicio.us>. |
|
| 136 | ||
| 137 |
=cut |