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 | $self->emit(request => $tx);
|
---|
24 |
|
---|
25 | # Response start-line
|
---|
26 | STDOUT->autoflush(1);
|
---|
27 | binmode STDOUT;
|
---|
28 | my $res = $tx->res->fix_headers;
|
---|
29 | return undef if $self->nph && !_write($res, 'get_start_line_chunk');
|
---|
30 |
|
---|
31 | # Response headers
|
---|
32 | my $code = $res->code || 404;
|
---|
33 | my $msg = $res->message || $res->default_message;
|
---|
34 | $res->headers->status("$code $msg") unless $self->nph;
|
---|
35 | return undef unless _write($res, 'get_header_chunk');
|
---|
36 |
|
---|
37 | # Response body
|
---|
38 | return undef unless $tx->is_empty || _write($res, 'get_body_chunk');
|
---|
39 |
|
---|
40 | # Finish transaction
|
---|
41 | $tx->closed;
|
---|
42 |
|
---|
43 | return $res->code;
|
---|
44 | }
|
---|
45 |
|
---|
46 | sub _write {
|
---|
47 | my ($res, $method) = @_;
|
---|
48 |
|
---|
49 | my $offset = 0;
|
---|
50 | while (1) {
|
---|
51 |
|
---|
52 | # No chunk yet, try again
|
---|
53 | sleep 1 and next unless defined(my $chunk = $res->$method($offset));
|
---|
54 |
|
---|
55 | # End of part
|
---|
56 | last unless my $len = length $chunk;
|
---|
57 |
|
---|
58 | # Make sure we can still write
|
---|
59 | $offset += $len;
|
---|
60 | return undef unless STDOUT->opened;
|
---|
61 | print STDOUT $chunk;
|
---|
62 | }
|
---|
63 |
|
---|
64 | return 1;
|
---|
65 | }
|
---|
66 |
|
---|
67 | 1;
|
---|
68 |
|
---|
69 | =encoding utf8
|
---|
70 |
|
---|
71 | =head1 NAME
|
---|
72 |
|
---|
73 | Mojo::Server::CGI - CGI server
|
---|
74 |
|
---|
75 | =head1 SYNOPSIS
|
---|
76 |
|
---|
77 | use Mojo::Server::CGI;
|
---|
78 |
|
---|
79 | my $cgi = Mojo::Server::CGI->new;
|
---|
80 | $cgi->unsubscribe('request')->on(request => sub {
|
---|
81 | my ($cgi, $tx) = @_;
|
---|
82 |
|
---|
83 | # Request
|
---|
84 | my $method = $tx->req->method;
|
---|
85 | my $path = $tx->req->url->path;
|
---|
86 |
|
---|
87 | # Response
|
---|
88 | $tx->res->code(200);
|
---|
89 | $tx->res->headers->content_type('text/plain');
|
---|
90 | $tx->res->body("$method request for $path!");
|
---|
91 |
|
---|
92 | # Resume transaction
|
---|
93 | $tx->resume;
|
---|
94 | });
|
---|
95 | $cgi->run;
|
---|
96 |
|
---|
97 | =head1 DESCRIPTION
|
---|
98 |
|
---|
99 | L<Mojo::Server::CGI> is a simple and portable implementation of
|
---|
100 | L<RFC 3875|http://tools.ietf.org/html/rfc3875>.
|
---|
101 |
|
---|
102 | See L<Mojolicious::Guides::Cookbook/"DEPLOYMENT"> for more.
|
---|
103 |
|
---|
104 | =head1 EVENTS
|
---|
105 |
|
---|
106 | L<Mojo::Server::CGI> inherits all events from L<Mojo::Server>.
|
---|
107 |
|
---|
108 | =head1 ATTRIBUTES
|
---|
109 |
|
---|
110 | L<Mojo::Server::CGI> inherits all attributes from L<Mojo::Server> and
|
---|
111 | implements the following new ones.
|
---|
112 |
|
---|
113 | =head2 nph
|
---|
114 |
|
---|
115 | my $bool = $cgi->nph;
|
---|
116 | $cgi = $cgi->nph($bool);
|
---|
117 |
|
---|
118 | Activate non-parsed header mode.
|
---|
119 |
|
---|
120 | =head1 METHODS
|
---|
121 |
|
---|
122 | L<Mojo::Server::CGI> inherits all methods from L<Mojo::Server> and implements
|
---|
123 | the following new ones.
|
---|
124 |
|
---|
125 | =head2 run
|
---|
126 |
|
---|
127 | my $status = $cgi->run;
|
---|
128 |
|
---|
129 | Run CGI.
|
---|
130 |
|
---|
131 | =head1 SEE ALSO
|
---|
132 |
|
---|
133 | L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
|
---|
134 |
|
---|
135 | =cut
|
---|