Commit | Line | Data |
9d159224 |
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 | |
10 | package Plack::Server::CGI; |
11 | use strict; |
12 | use warnings; |
13 | use IO::Handle; |
14 | BEGIN { |
15 | |
16 | package Plack::Util; |
17 | |
18 | sub foreach { |
19 | my($body, $cb) = @_; |
20 | |
21 | if (ref $body eq 'ARRAY') { |
22 | for my $line (@$body) { |
23 | $cb->($line) if length $line; |
24 | } |
25 | } else { |
26 | local $/ = \4096 unless ref $/; |
27 | while (defined(my $line = $body->getline)) { |
28 | $cb->($line) if length $line; |
29 | } |
30 | $body->close; |
31 | } |
32 | } |
33 | sub TRUE() { 1==1 } |
34 | sub FALSE() { !TRUE } |
35 | } |
36 | |
37 | sub new { bless {}, shift } |
38 | |
39 | sub run { |
40 | my ($self, $app) = @_; |
41 | my %env; |
42 | while (my ($k, $v) = each %ENV) { |
43 | 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_/; |
44 | $env{$k} = $v; |
45 | } |
46 | $env{'HTTP_COOKIE'} ||= $ENV{COOKIE}; |
47 | $env{'psgi.version'} = [ 1, 0 ]; |
48 | $env{'psgi.url_scheme'} = ($ENV{HTTPS}||'off') =~ /^(?:on|1)$/i ? 'https' : 'http'; |
49 | $env{'psgi.input'} = *STDIN; |
50 | $env{'psgi.errors'} = *STDERR; |
51 | $env{'psgi.multithread'} = Plack::Util::FALSE; |
52 | $env{'psgi.multiprocess'} = Plack::Util::TRUE; |
53 | $env{'psgi.run_once'} = Plack::Util::TRUE; |
54 | my $res = $app->(\%env); |
55 | print "Status: $res->[0]\n"; |
56 | my $headers = $res->[1]; |
57 | while (my ($k, $v) = splice(@$headers, 0, 2)) { |
58 | print "$k: $v\n"; |
59 | } |
60 | print "\n"; |
61 | |
62 | my $body = $res->[2]; |
63 | my $cb = sub { print STDOUT $_[0] }; |
64 | |
65 | Plack::Util::foreach($body, $cb); |
66 | } |
67 | |
68 | 1; |
69 | __END__ |
70 | |
71 | =head1 SYNOPSIS |
72 | |
73 | ## in your .cgi |
74 | #!/usr/bin/perl |
75 | use Plack::Server::CGI; |
76 | |
77 | # or Plack::Util::load_psgi("/path/to/app.psgi"); |
78 | my $app = sub { |
79 | my $env = shift; |
80 | return [ |
81 | 200, |
82 | [ 'Content-Type' => 'text/plain', 'Content-Length' => 13 ], |
83 | 'Hello, world!', |
84 | ]; |
85 | }; |
86 | |
87 | Plack::Server::CGI->new->run($app); |
88 | |
89 | =head1 SEE ALSO |
90 | |
91 | L<Plack::Server::Base> |
92 | |
93 | =cut |
94 | |
95 | |