www: use PerlIO::scalar (zfh) for buffering

[public-inbox.git] / lib / PublicInbox / WwwStream.pm

diff --git a/lib/PublicInbox/WwwStream.pm b/lib/PublicInbox/WwwStream.pm
index 6d7c447fe6a2ecc7880cd6119e41c788dd966c96..77b6f9c29e4ec675120cd2b47f5c6f003abb8e2f 100644 (file)
--- a/lib/PublicInbox/WwwStream.pm
+++ b/lib/PublicInbox/WwwStream.pm
@@ -1,4 +1,4 @@
-# Copyright (C) 2016-2021 all contributors <meta@public-inbox.org>
+# Copyright (C) all contributors <meta@public-inbox.org>
 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
 #
 # HTML body stream for which yields getline+close methods for
@@ -27,6 +27,9 @@ sub init {
        my ($ctx, $cb) = @_;
        $ctx->{cb} = $cb;
        $ctx->{base_url} = base_url($ctx);
+       $ctx->{-res_hdr} = [ 'Content-Type' => 'text/html; charset=UTF-8' ];
+       $ctx->{gz} = PublicInbox::GzipFilter::gz_or_noop($ctx->{-res_hdr},
+                                                       $ctx->{env});
        bless $ctx, __PACKAGE__;
 }
 
@@ -86,17 +89,17 @@ sub coderepos ($) {
        my $cr = $ctx->{ibx}->{coderepo} // return ();
        my $cfg = $ctx->{www}->{pi_cfg};
        my $upfx = ($ctx->{-upfx} // ''). '../';
-       my @ret;
+       my $pfx = $ctx->{base_url} //= $ctx->base_url;
+       my $up = $upfx =~ tr!/!/!;
+       $pfx =~ s!/[^/]+\z!/! for (1..$up);
+       my @ret = ('<a id=code>' .
+               'Code repositories for project(s) associated with this '.
+               $ctx->{ibx}->thing_type . "\n");
        for my $cr_name (@$cr) {
-               $ret[0] //= <<EOF;
-<a id=code>Code repositories for project(s) associated with this inbox:
-EOF
                my $urls = $cfg->get_all("coderepo.$cr_name.cgiturl");
                if ($urls) {
                        for (@$urls) {
-                               # relative or absolute URL?, prefix relative
-                               # "foo.git" with appropriate number of "../"
-                               my $u = m!\A(?:[a-z\+]+:)?//! ? $_ : $upfx.$_;
+                               my $u = m!\A(?:[a-z\+]+:)?//! ? $_ : $pfx.$_;
                                $u = ascii_html(prurl($ctx->{env}, $u));
                                $ret[0] .= qq(\n\t<a\nhref="$u">$u</a>);
                        }
@@ -164,18 +167,26 @@ sub getline {
        $ctx->zflush(_html_end($ctx));
 }
 
-sub html_oneshot ($$;$) {
-       my ($ctx, $code, $sref) = @_;
+sub html_done ($;@) {
+       my $ctx = $_[0];
+       my $bdy = $ctx->zflush(@_[1..$#_], _html_end($ctx));
+       my $res_hdr = delete $ctx->{-res_hdr};
+       push @$res_hdr, 'Content-Length', length($bdy);
+       [ 200, $res_hdr, [ $bdy ] ]
+}
+
+sub html_oneshot ($$;@) {
+       my ($ctx, $code) = @_[0, 1];
        my $res_hdr = [ 'Content-Type' => 'text/html; charset=UTF-8',
                'Content-Length' => undef ];
        bless $ctx, __PACKAGE__;
        $ctx->{gz} = PublicInbox::GzipFilter::gz_or_noop($res_hdr, $ctx->{env});
-       $ctx->{base_url} //= do {
-               $ctx->zmore(html_top($ctx));
-               base_url($ctx);
+       my @top;
+       $ctx->{base_url} // do {
+               @top = html_top($ctx);
+               $ctx->{base_url} = base_url($ctx);
        };
-       $ctx->zmore($$sref) if $sref;
-       my $bdy = $ctx->zflush(_html_end($ctx));
+       my $bdy = $ctx->zflush(@top, @_[2..$#_], _html_end($ctx));
        $res_hdr->[3] = length($bdy);
        [ $code, $res_hdr, [ $bdy ] ]
 }
@@ -195,10 +206,18 @@ sub async_next ($) {
 }
 
 sub aresponse {
-       my ($ctx, $code, $cb) = @_;
-       my $res_hdr = [ 'Content-Type' => 'text/html; charset=UTF-8' ];
+       my ($ctx, $cb) = @_;
        init($ctx, $cb);
-       $ctx->psgi_response($code, $res_hdr);
+       $ctx->psgi_response(200, delete $ctx->{-res_hdr});
+}
+
+sub html_init {
+       my ($ctx) = @_;
+       $ctx->{base_url} = base_url($ctx);
+       my $h = $ctx->{-res_hdr} = ['Content-Type', 'text/html; charset=UTF-8'];
+       $ctx->{gz} = PublicInbox::GzipFilter::gz_or_noop($h, $ctx->{env});
+       bless $ctx, __PACKAGE__;
+       print { $ctx->zfh } html_top($ctx);
 }
 
 1;