Commit | Line | Data |
5c33dda5 |
1 | # This is Plack::Server::CGI, copied almost verbatim. |
2 | # Except I inlined the bits of Plack::Util it needed. |
3 | # Because it loads a number of modules that I didn't. |
4 | # miyagawa, I'm sorry to butcher your code like this. |
5 | # The apology would have been in the form of a haiku. |
6 | # But I needed more syllables than that would permit. |
7 | # So I thought perhaps I'd make it bricktext instead. |
8 | # -- love, mst |
9 | |
9ddb5734 |
10 | # Hide from PAUSE |
11 | package |
12 | Plack::Server::CGI; |
5c33dda5 |
13 | use strict; |
14 | use warnings; |
15 | use IO::Handle; |
16 | BEGIN { |
17 | |
9ddb5734 |
18 | # Hide from PAUSE |
19 | package |
20 | Plack::Util; |
5c33dda5 |
21 | |
22 | sub foreach { |
23 | my($body, $cb) = @_; |
9ddb5734 |
24 | |
5c33dda5 |
25 | if (ref $body eq 'ARRAY') { |
26 | for my $line (@$body) { |
27 | $cb->($line) if length $line; |
28 | } |
29 | } else { |
30 | local $/ = \4096 unless ref $/; |
31 | while (defined(my $line = $body->getline)) { |
32 | $cb->($line) if length $line; |
33 | } |
34 | $body->close; |
35 | } |
36 | } |
37 | sub TRUE() { 1==1 } |
38 | sub FALSE() { !TRUE } |
39 | } |
40 | |
41 | sub new { bless {}, shift } |
42 | |
43 | sub run { |
44 | my ($self, $app) = @_; |
45 | my %env; |
46 | while (my ($k, $v) = each %ENV) { |
47 | next unless $k =~ qr/^(?:REQUEST_METHOD|SCRIPT_NAME|PATH_INFO|QUERY_STRING|SERVER_NAME|SERVER_PORT|SERVER_PROTOCOL|CONTENT_LENGTH|CONTENT_TYPE|REMOTE_ADDR|REQUEST_URI)$|^HTTP_/; |
48 | $env{$k} = $v; |
49 | } |
50 | $env{'HTTP_COOKIE'} ||= $ENV{COOKIE}; |
51 | $env{'psgi.version'} = [ 1, 0 ]; |
52 | $env{'psgi.url_scheme'} = ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http'; |
53 | $env{'psgi.input'} = *STDIN; |
54 | $env{'psgi.errors'} = *STDERR; |
55 | $env{'psgi.multithread'} = Plack::Util::FALSE; |
56 | $env{'psgi.multiprocess'} = Plack::Util::TRUE; |
57 | $env{'psgi.run_once'} = Plack::Util::TRUE; |
58 | my $res = $app->(\%env); |
59 | print "Status: $res->[0]\n"; |
60 | my $headers = $res->[1]; |
61 | while (my ($k, $v) = splice(@$headers, 0, 2)) { |
62 | print "$k: $v\n"; |
63 | } |
64 | print "\n"; |
65 | |
66 | my $body = $res->[2]; |
67 | my $cb = sub { print STDOUT $_[0] }; |
68 | |
69 | Plack::Util::foreach($body, $cb); |
70 | } |
71 | |
72 | 1; |
73 | __END__ |
74 | |
75 | =head1 SYNOPSIS |
76 | |
77 | ## in your .cgi |
78 | #!/usr/bin/perl |
79 | use Plack::Server::CGI; |
80 | |
81 | # or Plack::Util::load_psgi("/path/to/app.psgi"); |
82 | my $app = sub { |
83 | my $env = shift; |
84 | return [ |
85 | 200, |
86 | [ 'Content-Type' => 'text/plain', 'Content-Length' => 13 ], |
87 | 'Hello, world!', |
88 | ]; |
89 | }; |
90 | |
91 | Plack::Server::CGI->new->run($app); |
92 | |
93 | =head1 SEE ALSO |
94 | |
95 | L<Plack::Server::Base> |
96 | |
97 | =cut |
98 | |
99 | |