skeleton BUILDALL support
[catagits/Web-Simple.git] / lib / Web / Simple / HackedPlack.pm
CommitLineData
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
10package Plack::Server::CGI;
11use strict;
12use warnings;
13use IO::Handle;
14BEGIN {
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
37sub new { bless {}, shift }
38
39sub 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
681;
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
91L<Plack::Server::Base>
92
93=cut
94
95