my ($ctx, $srch) = @_;
sub {
my ($response) = @_; # Plack callback
- my $w = $response->([200, ['Content-Type' => 'text/plain']]);
- emit_mbox($w, $ctx, $srch);
+ emit_mbox($response, $ctx, $srch);
}
}
}
sub emit_mbox {
- my ($fh, $ctx, $srch) = @_;
+ my ($response, $ctx, $srch) = @_;
+ eval { require IO::Compress::Gzip };
+ return need_gzip($response) if $@;
+
+ # http://www.iana.org/assignments/media-types/application/gzip
+ # http://www.iana.org/assignments/media-types/application/mbox
+ my $fh = $response->([200, ['Content-Type' => 'application/gzip']]);
+ $fh = PublicInbox::MboxGz->new($fh);
require PublicInbox::GitCatFile;
require Email::Simple;
$opts{offset} += $nr;
} while ($nr > 0);
+
+ $fh->close;
+}
+
+sub need_gzip {
+ my $fh = $_[0]->([501, ['Content-Type' => 'text/html']]);
+ my $title = 'gzipped mbox not available';
+ $fh->write(<<EOF);
+<html><head><title>$title</title><body><pre>$title
+The administrator needs to install the IO::Compress::Gzip Perl module
+to support gzipped mboxes.
+<a href="../">Return to index</a></pre></body></html>
+EOF
+}
+
+1;
+
+# fh may not be a proper IO, so we wrap the write and close methods
+# to prevent IO::Compress::Gzip from complaining
+package PublicInbox::MboxGz;
+use strict;
+use warnings;
+use fields qw(gz fh buf);
+
+sub new {
+ my ($class, $fh) = @_;
+ my $self = fields::new($class);
+ my $buf;
+ $self->{buf} = \$buf;
+ $self->{gz} = IO::Compress::Gzip->new(\$buf);
+ $self->{fh} = $fh;
+ $self;
+}
+
+sub _flush_buf {
+ my ($self) = @_;
+ if (defined ${$self->{buf}}) {
+ $self->{fh}->write(${$self->{buf}});
+ ${$self->{buf}} = undef;
+ }
+}
+
+sub write {
+ $_[0]->{gz}->write($_[1]);
+ _flush_buf($_[0]);
+}
+
+sub close {
+ my ($self) = @_;
+ $self->{gz}->close;
+ _flush_buf($self);
+ # do not actually close $fh
}
1;
} elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.html\z!o) {
invalid_list_mid(\%ctx, $1, $2) || get_thread(\%ctx, $cgi);
- } elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.mbox\z!o) {
+ } elsif ($path_info =~ m!$LISTNAME_RE/t/(\S+)\.mbox\.gz!o) {
+ my $sfx = $3;
invalid_list_mid(\%ctx, $1, $2) || get_thread_mbox(\%ctx, $cgi);
} elsif ($path_info =~ m!$LISTNAME_RE/f/\S+\.txt\z!o) {
"../f/$href.html";
}
-# /$LISTNAME/t/$MESSAGE_ID.mbox -> search results as mbox
+# /$LISTNAME/t/$MESSAGE_ID.mbox.gz -> search results as gzipped mbox
+# note: I'm not a big fan of other compression formats since they're
+# significantly more expensive on CPU than gzip and less-widely available,
+# especially on older systems. Stick to zlib since that's what git uses.
sub get_thread_mbox {
my ($ctx, $cgi) = @_;
my $srch = searcher($ctx) or return need_search($ctx);
{
local $ENV{HOME} = $home;
local $ENV{PATH} = $main_path;
- my $path = "/test/t/blahblah%40example.com.mbox";
+ my $path = "/test/t/blahblah%40example.com.mbox.gz";
my $res = cgi_run($path);
like($res->{head}, qr/^Status: 501 /, "search not-yet-enabled");
my $indexed = system($index, $maindir) == 0;
if ($indexed) {
$res = cgi_run($path);
- # use Data::Dumper; print STDERR Dumper($res);
like($res->{head}, qr/^Status: 200 /, "search returned mbox");
- like($res->{body}, qr/^From /m, "From lines in mbox");
+ eval {
+ require IO::Uncompress::Gunzip;
+ my $in = $res->{body};
+ my $out;
+ IO::Uncompress::Gunzip::gunzip(\$in => \$out);
+ like($out, qr/^From /m, "From lines in mbox");
+ };
} else {
like($res->{head}, qr/^Status: 501 /, "search not available");
}