t/lei-q-kw.t

   1 #!perl -w
   2 # Copyright (C) 2020-2021 all contributors <meta@public-inbox.org>
   3 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   4 use strict; use v5.10.1; use PublicInbox::TestCommon;
   5 use POSIX qw(mkfifo);
   6 use Fcntl qw(SEEK_SET O_RDONLY O_NONBLOCK);
   7 use IO::Uncompress::Gunzip qw(gunzip);
   8 use IO::Compress::Gzip qw(gzip);
   9 use PublicInbox::MboxReader;
  10 use PublicInbox::LeiToMail;
  11 use PublicInbox::Spawn qw(popen_rd);
  12 my $exp = {
  13         '<qp@example.com>' => eml_load('t/plack-qp.eml'),
  14         '<testmessage@example.com>' => eml_load('t/utf8.eml'),
  15 };
  16 $exp->{'<qp@example.com>'}->header_set('Status', 'RO');
  17 $exp->{'<testmessage@example.com>'}->header_set('Status', 'O');
  18
  19 test_lei(sub {
  20 lei_ok(qw(import -F eml t/plack-qp.eml));
  21 my $o = "$ENV{HOME}/dst";
  22 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  23 my @fn = glob("$o/cur/*:2,");
  24 scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn);
  25 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
  26
  27 lei_ok(qw(q -o), "maildir:$o", qw(m:bogus-noresults@example.com));
  28 ok(!glob("$o/cur/*"), 'last result cleared after augment-import');
  29
  30 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  31 @fn = glob("$o/cur/*:2,S");
  32 is(scalar(@fn), 1, "`seen' flag set on Maildir file");
  33
  34 # ensure --no-import-before works
  35 my $n = $fn[0];
  36 $n =~ s/,S\z/,RS/;
  37 rename($fn[0], $n) or BAIL_OUT "rename $!";
  38 lei_ok(qw(q --no-import-before -o), "maildir:$o",
  39         qw(m:bogus-noresults@example.com));
  40 ok(!glob("$o/cur/*"), '--no-import-before cleared destination');
  41 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  42 @fn = glob("$o/cur/*:2,S");
  43 is(scalar(@fn), 1, "`seen' flag (but not `replied') set on Maildir file");
  44
  45 SKIP: {
  46         $o = "$ENV{HOME}/fifo";
  47         mkfifo($o, 0600) or skip("mkfifo not supported: $!", 1);
  48         # cat(1) since lei() may not execve for FD_CLOEXEC to work
  49         my $cat = popen_rd(['cat', $o]);
  50         ok(!lei(qw(q --import-before bogus -o), "mboxrd:$o"),
  51                 '--import-before fails on non-seekable output');
  52         is(do { local $/; <$cat> }, '', 'no output on FIFO');
  53         close $cat;
  54         $cat = popen_rd(['cat', $o]);
  55         lei_ok(qw(q m:qp@example.com -o), "mboxrd:$o");
  56         my $buf = do { local $/; <$cat> };
  57         open my $fh, '<', \$buf or BAIL_OUT $!;
  58         PublicInbox::MboxReader->mboxrd($fh, sub {
  59                 my ($eml) = @_;
  60                 $eml->header_set('Status', 'RO');
  61                 is_deeply($eml, $exp->{'<qp@example.com>'},
  62                         'FIFO output works as expected');
  63         });
  64 };
  65
  66 lei_ok qw(import -F eml t/utf8.eml), \'for augment test';
  67 my $read_file = sub {
  68         if ($_[0] =~ /\.gz\z/) {
  69                 gunzip($_[0] => \(my $buf = ''), MultiStream => 1) or
  70                         BAIL_OUT 'gunzip';
  71                 $buf;
  72         } else {
  73                 open my $fh, '+<', $_[0] or BAIL_OUT $!;
  74                 do { local $/; <$fh> };
  75         }
  76 };
  77
  78 my $write_file = sub {
  79         if ($_[0] =~ /\.gz\z/) {
  80                 gzip(\($_[1]), $_[0]) or BAIL_OUT 'gzip';
  81         } else {
  82                 open my $fh, '>', $_[0] or BAIL_OUT $!;
  83                 print $fh $_[1] or BAIL_OUT $!;
  84                 close $fh or BAIL_OUT;
  85         }
  86 };
  87
  88 for my $sfx ('', '.gz') {
  89         $o = "$ENV{HOME}/dst.mboxrd$sfx";
  90         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  91         my $buf = $read_file->($o);
  92         $buf =~ s/^Status: [^\n]*\n//sm or BAIL_OUT "no status in $buf";
  93         $write_file->($o, $buf);
  94         lei_ok(qw(q -o), "mboxrd:$o", qw(rereadandimportkwchange));
  95         $buf = $read_file->($o);
  96         is($buf, '', 'emptied');
  97         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  98         $buf = $read_file->($o);
  99         $buf =~ s/\nStatus: O\n\n/\nStatus: RO\n\n/s or
 100                 BAIL_OUT "no Status in $buf";
 101         $write_file->($o, $buf);
 102         lei_ok(qw(q -a -o), "mboxrd:$o", qw(m:testmessage@example.com));
 103         $buf = $read_file->($o);
 104         open my $fh, '<', \$buf or BAIL_OUT "PerlIO::scalar $!";
 105         my %res;
 106         PublicInbox::MboxReader->mboxrd($fh, sub {
 107                 my ($eml) = @_;
 108                 $res{$eml->header_raw('Message-ID')} = $eml;
 109         });
 110         is_deeply(\%res, $exp, '--augment worked');
 111
 112         lei_ok(qw(q -o), "mboxrd:/dev/stdout", qw(m:qp@example.com)) or
 113                 diag $lei_err;
 114         like($lei_out, qr/^Status: RO\n/sm, 'Status set by previous augment');
 115 } # /mbox + mbox.gz tests
 116
 117 my ($ro_home, $cfg_path) = setup_public_inboxes;
 118
 119 # import keywords-only for external messages:
 120 $o = "$ENV{HOME}/kwdir";
 121 my $m = 'alpine.DEB.2.20.1608131214070.4924@example';
 122 my @inc = ('-I', "$ro_home/t1");
 123 lei_ok(qw(q -o), $o, "m:$m", @inc);
 124
 125 # emulate MUA marking a Maildir message as read:
 126 @fn = glob("$o/cur/*");
 127 scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn);
 128 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
 129
 130 lei_ok(qw(q -o), $o, 'bogus', \'clobber output dir to import keywords');
 131 @fn = glob("$o/cur/*");
 132 is_deeply(\@fn, [], 'output dir actually clobbered');
 133 lei_ok('q', "m:$m", @inc);
 134 my $res = json_utf8->decode($lei_out);
 135 is_deeply($res->[0]->{kw}, ['seen'], 'seen flag set for external message')
 136         or diag explain($res);
 137 lei_ok('q', "m:$m", '--no-external');
 138 is_deeply($res = json_utf8->decode($lei_out), [ undef ],
 139         'external message not imported') or diag explain($res);
 140
 141 $o = "$ENV{HOME}/kwmboxrd";
 142 lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc);
 143
 144 # emulate MUA marking mboxrd message as unread
 145 open my $fh, '<', $o or BAIL_OUT;
 146 my $s = do { local $/; <$fh> };
 147 $s =~ s/^Status: RO\n/Status: O\nX-Status: AF\n/sm or
 148         fail "failed to clear R flag in $s";
 149 open $fh, '>', $o or BAIL_OUT;
 150 print $fh $s or BAIL_OUT;
 151 close $fh or BAIL_OUT;
 152
 153 lei_ok(qw(q -o), "mboxrd:$o", 'm:bogus', @inc,
 154         \'clobber mbox to import keywords');
 155 lei_ok(qw(q -o), "mboxrd:$o", "m:$m", @inc);
 156 open $fh, '<', $o or BAIL_OUT;
 157 $s = do { local $/; <$fh> };
 158 like($s, qr/^Status: O\nX-Status: AF\n/ms,
 159         'seen keyword gone in mbox, answered + flagged set');
 160
 161 lei_ok(qw(q --pretty), "m:$m", @inc);
 162 like($lei_out, qr/^  "kw": \["answered", "flagged"\],\n/sm,
 163         '--pretty JSON output shows kw: on one line');
 164 }); # test_lei
 165 done_testing;