X-Git-Url: http://www.git.stargrave.org/?a=blobdiff_plain;f=lib%2FPublicInbox%2FGzipFilter.pm;h=a11ba73fa5b13ae5c680f9664f0f382a11466022;hb=refs%2Fheads%2Fmaster;hp=1f11acb8095bee0b09864370a0274fef9d1d1728;hpb=f32456e0d0f4a7756fcc17c83ccf5b682cb512d9;p=public-inbox.git

diff --git a/lib/PublicInbox/GzipFilter.pm b/lib/PublicInbox/GzipFilter.pm
index 1f11acb8..a11ba73f 100644
--- a/lib/PublicInbox/GzipFilter.pm
+++ b/lib/PublicInbox/GzipFilter.pm
@@ -94,15 +94,15 @@ sub gone { # what: search/over/mm
 
 # for GetlineBody (via Qspawn) when NOT using $env->{'pi-httpd.async'}
 # Also used for ->getline callbacks
-sub translate ($$) {
-	my $self = $_[0]; # $_[1] => input
+sub translate {
+	my $self = shift; # $_[1] => input
 
 	# allocate the zlib context lazily here, instead of in ->new.
 	# Deflate contexts are memory-intensive and this object may
 	# be sitting in the Qspawn limiter queue for a while.
 	$self->{gz} //= gzip_or_die();
-	if (defined $_[1]) { # my $buf = $_[1];
-		zmore($self, $_[1]);
+	if (defined $_[0]) { # my $buf = $_[1];
+		zmore($self, @_);
 		length($self->{zbuf}) >= 8192 ? delete($self->{zbuf}) : '';
 	} else { # undef == EOF
 		zflush($self);
@@ -123,49 +123,51 @@ sub http_out ($) {
 }
 
 sub write {
+	my $self = shift;
 	# my $ret = bytes::length($_[1]); # XXX does anybody care?
-	http_out($_[0])->write(translate($_[0], $_[1]));
+	http_out($self)->write($self->translate(@_));
 }
 
-sub zadd {
-	my $self = shift;
-	$self->{pbuf} .= $_ for @_; # perl internal pad memory use here
+sub zfh {
+	$_[0]->{zfh} // do {
+		open($_[0]->{zfh}, '>>', \($_[0]->{pbuf} //= '')) or
+			die "open: $!";
+		$_[0]->{zfh}
+	};
 }
 
 # similar to ->translate; use this when we're sure we know we have
 # more data to buffer after this
 sub zmore {
-	my $self = shift; # $_[1] => input
+	my $self = shift;
+	my $zfh = delete $self->{zfh};
+	if (@_ > 1 || $zfh) {
+		print { $zfh // zfh($self) } @_;
+		@_ = (delete $self->{pbuf});
+		delete $self->{zfh};
+	};
 	http_out($self);
-	my $x;
-	defined($x = delete($self->{pbuf})) and unshift(@_, $x);
-	for (@_) {
-		($x = $self->{gz}->deflate($_, $self->{zbuf})) == Z_OK or
-			die "gzip->deflate: $x";
-	}
-	undef;
+	my $err;
+	($err = $self->{gz}->deflate($_[0], $self->{zbuf})) == Z_OK or
+		die "gzip->deflate: $err";
 }
 
 # flushes and returns the final bit of gzipped data
 sub zflush ($;@) {
 	my $self = shift; # $_[1..Inf] => final input (optional)
+	zmore($self, @_) if scalar(@_) || $self->{zfh};
+	# not a bug, recursing on DS->write failure
+	my $gz = delete $self->{gz} // return '';
+	my $err;
 	my $zbuf = delete $self->{zbuf};
-	my $gz = delete $self->{gz};
-	my $x;
-	defined($x = delete($self->{pbuf})) and unshift(@_, $x);
-	for (@_) { # it's a bug iff $gz is undef if @_ isn't empty, here:
-		($x = $gz->deflate($_, $zbuf)) == Z_OK or
-			die "gzip->deflate: $x";
-	}
-	$gz // return ''; # not a bug, recursing on DS->write failure
-	($x = $gz->flush($zbuf)) == Z_OK or die "gzip->flush: $x";
+	($err = $gz->flush($zbuf)) == Z_OK or die "gzip->flush: $err";
 	$zbuf;
 }
 
 sub close {
 	my ($self) = @_;
 	my $http_out = http_out($self) // return;
-	$http_out->write(zflush($self));
+	$http_out->write($self->zflush);
 	(delete($self->{http_out}) // return)->close;
 }