lib/Web/Simple/HackedPlack.pm

   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