X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FWwwStream.pm;h=c80440d14dad6291abdc0fe091c7f9011c9e1eb7;hb=52a02a813a46940530183ede4d4cc7028290cd8f;hp=79ed6871e6f3e9224dfc422b3896d3d718881b14;hpb=b8b03f9c896432816019828b27708fa3b6903d83;p=public-inbox.git diff --git a/lib/PublicInbox/WwwStream.pm b/lib/PublicInbox/WwwStream.pm index 79ed6871..c80440d1 100644 --- a/lib/PublicInbox/WwwStream.pm +++ b/lib/PublicInbox/WwwStream.pm @@ -13,8 +13,7 @@ use base qw(Exporter); our @EXPORT_OK = qw(html_oneshot); use bytes (); # length use PublicInbox::Hval qw(ascii_html prurl); -use Compress::Raw::Zlib qw(Z_FINISH Z_OK); -use PublicInbox::GzipFilter qw(gzip_maybe); +use PublicInbox::GzipFilter qw(gzf_maybe); our $TOR_URL = 'https://www.torproject.org/'; our $CODE_URL = 'https://public-inbox.org/public-inbox.git'; @@ -28,26 +27,24 @@ sub base_url ($) { $base_url; } -sub new { - my ($class, $ctx, $cb) = @_; - - bless { - nr => 0, - cb => $cb, - ctx => $ctx, - base_url => base_url($ctx), - }, $class; +sub init { + my ($ctx, $cb) = @_; + $ctx->{cb} = $cb; + $ctx->{base_url} = base_url($ctx); + $ctx->{nr} = 0; + bless $ctx, __PACKAGE__; } sub response { - my ($class, $ctx, $code, $cb) = @_; - [ $code, [ 'Content-Type', 'text/html; charset=UTF-8' ], - $class->new($ctx, $cb) ] + my ($ctx, $code, $cb) = @_; + my $h = [ 'Content-Type', 'text/html; charset=UTF-8' ]; + init($ctx, $cb); + $ctx->{gzf} = gzf_maybe($h, $ctx->{env}); + [ $code, $h, $ctx ] } sub _html_top ($) { - my ($self) = @_; - my $ctx = $self->{ctx}; + my ($ctx) = @_; my $ibx = $ctx->{-inbox}; my $desc = ascii_html($ibx->description); my $title = delete($ctx->{-title_html}) // $desc; @@ -88,14 +85,13 @@ sub code_footer ($) { } sub _html_end { - my ($self) = @_; + my ($ctx) = @_; my $urls = 'Archives are clonable:'; - my $ctx = $self->{ctx}; my $ibx = $ctx->{-inbox}; my $desc = ascii_html($ibx->description); my @urls; - my $http = $self->{base_url}; + my $http = $ctx->{base_url}; my $max = $ibx->max_git_epoch; my $dir = (split(m!/!, $http))[-1]; my %seen = ($http => 1); @@ -162,46 +158,42 @@ EOF # callback for HTTP.pm (and any other PSGI servers) sub getline { - my ($self) = @_; - my $nr = $self->{nr}++; - - return _html_top($self) if $nr == 0; + my ($ctx) = @_; + my $nr = $ctx->{nr}++; + + my $buf = do { + if ($nr == 0) { + _html_top($ctx); + } elsif (my $middle = $ctx->{cb}) { + $middle->($nr, $ctx); + } + } // (delete($ctx->{cb}) ? _html_end($ctx) : undef); - if (my $middle = $self->{cb}) { - $middle = $middle->($nr, $self->{ctx}) and return $middle; - } + # gzf may be GzipFilter, `undef' or `0' + my $gzf = $ctx->{gzf} or return $buf; - delete $self->{cb} ? _html_end($self) : undef; + return $gzf->translate($buf) if defined $buf; + $ctx->{gzf} = 0; # next call to ->getline returns $buf (== undef) + $gzf->translate(undef); } sub html_oneshot ($$;$) { my ($ctx, $code, $sref) = @_; - my $self = bless { - ctx => $ctx, - base_url => base_url($ctx), - }, __PACKAGE__; + $ctx->{base_url} = base_url($ctx); + bless $ctx, __PACKAGE__; my @x; - my @h = ('Content-Type' => 'text/html; charset=UTF-8'); - if (my $gz = gzip_maybe($ctx->{env})) { - my $err = $gz->deflate(_html_top($self), $x[0]); - die "gzip->deflate: $err" if $err != Z_OK; - if ($sref) { - $err = $gz->deflate($sref, $x[0]); - die "gzip->deflate: $err" if $err != Z_OK; - } - $err = $gz->deflate(_html_end($self), $x[0]); - die "gzip->deflate: $err" if $err != Z_OK; - $err = $gz->flush($x[0], Z_FINISH); - die "gzip->flush: $err" if $err != Z_OK; - push @h, qw(Vary Accept-Encoding Content-Encoding gzip); + my $h = [ 'Content-Type' => 'text/html; charset=UTF-8', + 'Content-Length' => undef ]; + if (my $gzf = gzf_maybe($h, $ctx->{env})) { + $gzf->zmore(_html_top($ctx)); + $gzf->zmore($$sref) if $sref; + $x[0] = $gzf->zflush(_html_end($ctx)); + $h->[3] = length($x[0]); } else { - @x = (_html_top($self), $sref ? $$sref : (), _html_end($self)); + @x = (_html_top($ctx), $sref ? $$sref : (), _html_end($ctx)); + $h->[3] += bytes::length($_) for @x; } - - my $len = 0; - $len += bytes::length($_) for @x; - push @h, 'Content-Length', $len; - [ $code, \@h, \@x ] + [ $code, $h, \@x ] } 1;