support dumping thread as an mbox

Some folks may not want to download and install Perl code like
ssoma, so allow downloading an mbox containing the entire
thread.

1 files changed, 30 insertions, 13 deletions

diff --git a/public-inbox.cgi b/public-inbox.cgi
index ed0f12c8..5c6dfe8a 100755
--- a/public-inbox.cgi
+++ b/public-inbox.cgi
@@ -3,12 +3,22 @@
 # License: AGPLv3 or later (https://www.gnu.org/licenses/agpl-3.0.txt)
 use strict;
 use warnings;
+use IO::Handle;
 require 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};
+
+        %HTTP_CODES = (
+                200 => 'OK',
+                301 => 'Moved Permanently',
+                404 => 'Not Found',
+                405 => 'Method Not Allowed',
+                501 => 'Not Implemented',
+        );
 }
 
 # some servers (Ruby webrick) include scheme://host[:port] here,
@@ -19,23 +29,30 @@ 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;
+
+my $out = select;
+$out->binmode;
 if (@ARGV && $ARGV[0] eq 'static') {
-        print $ret->[2]->[0]; # only show the body
+        $out->write($ret->[2]->[0]); # only show the body
 } else { # CGI
-        my ($status, $headers, $body) = @$ret;
-        my %codes = (
-                200 => 'OK',
-                301 => 'Moved Permanently',
-                404 => 'Not Found',
-                405 => 'Method Not Allowed',
-                501 => 'Not Implemented',
-        );
+        if (ref($ret) eq 'CODE') {
+                $ret->(*dump_header);
+        } else {
+                my ($status, $headers, $body) = @$ret;
+
+                dump_header([$status, $headers])->write($body->[0]);
+        }
+}
 
-        print "Status: $status $codes{$status}\r\n";
+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;
 }