www_stream: extra link to mirroring information in the footer

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

diff --git a/lib/PublicInbox/MboxReader.pm b/lib/PublicInbox/MboxReader.pm
index 59ce4fb624d57000fcf6a913c9072e927486f483..9291f00b67145b84c5de7d43dc7504e9be59d56b 100644 (file)
--- a/lib/PublicInbox/MboxReader.pm
+++ b/lib/PublicInbox/MboxReader.pm
@@ -11,6 +11,18 @@ $Data::Dumper::Useqq = 1; # should've been the default, for bad data
 my $from_strict =
        qr/^From \S+ +\S+ \S+ +\S+ [^\n:]+:[^\n:]+:[^\n:]+ [^\n:]+\n/sm;
 
+# cf: https://doc.dovecot.org/configuration_manual/mail_location/mbox/
+my %status2kw = (F => 'flagged', A => 'answered', R => 'seen', T => 'draft');
+# O (old/non-recent), and D (deleted) aren't in JMAP,
+# so probably won't be supported by us.
+sub mbox_keywords {
+       my $eml = $_[-1];
+       my $s = "@{[$eml->header_raw('X-Status'),$eml->header_raw('Status')]}";
+       my %kw;
+       $s =~ s/([FART])/$kw{$status2kw{$1}} = 1/sge;
+       [ sort(keys %kw) ];
+}
+
 sub _mbox_from {
        my ($mbfh, $from_re, $eml_cb, @arg) = @_;
        my $buf = '';
@@ -26,7 +38,7 @@ sub _mbox_from {
                }
                @raw = grep /[^ \t\r\n]/s, @raw; # skip empty messages
                while (defined(my $raw = shift @raw)) {
-                       $raw =~ s/\r?\n\z//s;
+                       $raw =~ s/^\r?\n\z//ms;
                        $raw =~ s/$from_re/$1/gms;
                        my $eml = PublicInbox::Eml->new(\$raw);
                        $eml_cb->($eml, @arg);
@@ -121,4 +133,61 @@ sub mboxcl2 {
 
 sub new { bless \(my $x), __PACKAGE__ }
 
+sub reads {
+       my $ifmt = $_[-1];
+       $ifmt =~ /\Ambox(?:rd|cl|cl2|o)\z/ ? __PACKAGE__->can($ifmt) : undef
+}
+
+# all of these support -c for stdout and -d for decompression,
+# mutt is commonly distributed with hooks for gz, bz2 and xz, at least
+# { foo => '' } means "--foo" is passed to the command-line,
+# otherwise { foo => '--bar' } passes "--bar"
+my %zsfx2cmd = (
+       gz => [ qw(GZIP pigz gzip), { rsyncable => '' } ],
+       bz2 => [ 'bzip2', {} ],
+       xz => [ 'xz', {} ],
+       # don't add new entries here unless MUA support is widely available
+);
+
+sub zsfx ($) {
+       my ($pathname) = @_;
+       my $allow = join('|', keys %zsfx2cmd);
+       $pathname =~ /\.($allow)\z/ ? $1 : undef;
+}
+
+sub zsfx2cmd ($$$) {
+       my ($zsfx, $decompress, $lei) = @_;
+       my $x = $zsfx2cmd{$zsfx} // die "BUG: no support for suffix=.$zsfx";
+       my @info = @$x;
+       my $cmd_opt = pop @info;
+       my @cmd = (undef, $decompress ? qw(-dc) : qw(-c));
+       require PublicInbox::Spawn;
+       for my $exe (@info) {
+               # I think respecting client's ENV{GZIP} is OK, not sure
+               # about ENV overrides for other, less-common compressors
+               if ($exe eq uc($exe)) {
+                       $exe = $lei->{env}->{$exe} or next;
+               }
+               $cmd[0] = PublicInbox::Spawn::which($exe) and last;
+       }
+       $cmd[0] // die join(' or ', @info)." missing for .$zsfx";
+       # push @cmd, @{$cmd_opt->{-default}} if $cmd_opt->{-default};
+       for my $bool (qw(rsyncable)) {
+               my $switch = $cmd_opt->{rsyncable} // next;
+               push @cmd, '--'.($switch || $bool);
+       }
+       for my $key (qw(rsyncable)) { # support compression level?
+               my $switch = $cmd_opt->{$key} // next;
+               my $val = $lei->{opt}->{$key} // next;
+               push @cmd, $switch, $val;
+       }
+       \@cmd;
+}
+
+sub zsfxcat ($$$) {
+       my ($in, $zsfx, $lei) = @_;
+       my $cmd = zsfx2cmd($zsfx, 1, $lei);
+       PublicInbox::Spawn::popen_rd($cmd, undef, { 0 => $in, 2 => $lei->{2} });
+}
+
 1;