TODO: add a few more items

[public-inbox.git] / public-inbox.cgi

diff --git a/public-inbox.cgi b/public-inbox.cgi
index 57935c50d62fc1ed8d282a04ee2e3dede66a62a9..4b74a62ae04f59710e32774e611d6e9d3b04cb71 100755 (executable)
--- a/public-inbox.cgi
+++ b/public-inbox.cgi
@@ -1,14 +1,31 @@
 #!/usr/bin/perl -w
-# Copyright (C) 2014, Eric Wong <normalperson@yhbt.net> and all contributors
+# Copyright (C) 2014-2015 all contributors <meta@public-inbox.org>
 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
+#
+# Enables using PublicInbox::WWW as a CGI script
 use strict;
 use warnings;
-require PublicInbox::WWW;
+use IO::Handle;
+use PublicInbox::WWW;
 use CGI qw/-nosticky/;
 our $NO_SCRIPT_NAME;
+our %HTTP_CODES;
 BEGIN {
        $NO_SCRIPT_NAME = 1 if $ENV{NO_SCRIPT_NAME};
-       CGI->compile if $ENV{MOD_PERL};
+       if ($ENV{MOD_PERL}) {
+               CGI->compile;
+               PublicInbox::WWW->preload;
+       }
+
+       %HTTP_CODES = (
+               200 => 'OK',
+               300 => 'Multiple Choices',
+               301 => 'Moved Permanently',
+               302 => 'Found',
+               404 => 'Not Found',
+               405 => 'Method Not Allowed',
+               501 => 'Not Implemented',
+       );
 }
 
 # some servers (Ruby webrick) include scheme://host[:port] here,
@@ -19,22 +36,27 @@ delete $ENV{REQUEST_URI};
 $ENV{SCRIPT_NAME} = '' if $NO_SCRIPT_NAME;
 my $req = CGI->new;
 my $ret = PublicInbox::WWW::run($req, $req->request_method);
-binmode STDOUT;
-if (@ARGV && $ARGV[0] eq 'static') {
-       print $ret->[2]->[0]; # only show the body
-} else { # CGI
+
+my $out = select;
+$out->binmode;
+
+if (ref($ret) eq 'CODE') {
+       $ret->(*dump_header);
+} else {
        my ($status, $headers, $body) = @$ret;
-       my %codes = (
-               200 => 'OK',
-               301 => 'Moved Permanently',
-               404 => 'Not Found',
-               405 => 'Method Not Allowed',
-       );
 
-       print "Status: $status $codes{$status}\r\n";
+       dump_header([$status, $headers])->write($body->[0]);
+}
+
+sub dump_header {
+       my ($res) = @_;
+       my $fh = select;
+       my ($status, $headers) = @$res;
+       $fh->write("Status: $status $HTTP_CODES{$status}\r\n");
        my @tmp = @$headers;
        while (my ($k, $v) = splice(@tmp, 0, 2)) {
-               print "$k: $v\r\n";
+               $fh->write("$k: $v\r\n");
        }
-       print "\r\n", $body->[0];
+       $fh->write("\r\n");
+       $fh;
 }