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::Spawn qw(popen_rd);
  11 test_lei(sub {
  12 lei_ok(qw(import -F eml t/plack-qp.eml));
  13 my $o = "$ENV{HOME}/dst";
  14 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  15 my @fn = glob("$o/cur/*:2,");
  16 scalar(@fn) == 1 or BAIL_OUT "wrote multiple or zero files: ".explain(\@fn);
  17 rename($fn[0], "$fn[0]S") or BAIL_OUT "rename $!";
  18
  19 lei_ok(qw(q -o), "maildir:$o", qw(m:bogus-noresults@example.com));
  20 ok(!glob("$o/cur/*"), 'last result cleared after augment-import');
  21
  22 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  23 @fn = glob("$o/cur/*:2,S");
  24 is(scalar(@fn), 1, "`seen' flag set on Maildir file");
  25
  26 # ensure --no-import-augment works
  27 my $n = $fn[0];
  28 $n =~ s/,S\z/,RS/;
  29 rename($fn[0], $n) or BAIL_OUT "rename $!";
  30 lei_ok(qw(q --no-import-augment -o), "maildir:$o",
  31         qw(m:bogus-noresults@example.com));
  32 ok(!glob("$o/cur/*"), '--no-import-augment cleared destination');
  33 lei_ok(qw(q -o), "maildir:$o", qw(m:qp@example.com));
  34 @fn = glob("$o/cur/*:2,S");
  35 is(scalar(@fn), 1, "`seen' flag (but not `replied') set on Maildir file");
  36
  37 SKIP: {
  38         $o = "$ENV{HOME}/fifo";
  39         mkfifo($o, 0600) or skip("mkfifo not supported: $!", 1);
  40         # cat(1) since lei() may not execve for FD_CLOEXEC to work
  41         my $cat = popen_rd(['cat', $o]);
  42         ok(!lei(qw(q --import-augment bogus -o), "mboxrd:$o"),
  43                 '--import-augment fails on non-seekable output');
  44         is(do { local $/; <$cat> }, '', 'no output on FIFO');
  45 };
  46
  47 lei_ok qw(import -F eml t/utf8.eml), \'for augment test';
  48 my $read_file = sub {
  49         if ($_[0] =~ /\.gz\z/) {
  50                 gunzip($_[0] => \(my $buf = ''), MultiStream => 1) or
  51                         BAIL_OUT 'gunzip';
  52                 $buf;
  53         } else {
  54                 open my $fh, '+<', $_[0] or BAIL_OUT $!;
  55                 do { local $/; <$fh> };
  56         }
  57 };
  58
  59 my $write_file = sub {
  60         if ($_[0] =~ /\.gz\z/) {
  61                 gzip(\($_[1]), $_[0]) or BAIL_OUT 'gzip';
  62         } else {
  63                 open my $fh, '>', $_[0] or BAIL_OUT $!;
  64                 print $fh $_[1] or BAIL_OUT $!;
  65                 close $fh or BAIL_OUT;
  66         }
  67 };
  68
  69 my $exp = {
  70         '<qp@example.com>' => eml_load('t/plack-qp.eml'),
  71         '<testmessage@example.com>' => eml_load('t/utf8.eml'),
  72 };
  73 $exp->{'<qp@example.com>'}->header_set('Status', 'OR');
  74 $exp->{'<testmessage@example.com>'}->header_set('Status', 'O');
  75 for my $sfx ('', '.gz') {
  76         $o = "$ENV{HOME}/dst.mboxrd$sfx";
  77         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  78         my $buf = $read_file->($o);
  79         $buf =~ s/^Status: [^\n]*\n//sm or BAIL_OUT "no status in $buf";
  80         $write_file->($o, $buf);
  81         lei_ok(qw(q -o), "mboxrd:$o", qw(rereadandimportkwchange));
  82         $buf = $read_file->($o);
  83         is($buf, '', 'emptied');
  84         lei_ok(qw(q -o), "mboxrd:$o", qw(m:qp@example.com));
  85         $buf = $read_file->($o);
  86         $buf =~ s/\nStatus: O\n\n/\nStatus: OR\n\n/s or
  87                 BAIL_OUT "no Status in $buf";
  88         $write_file->($o, $buf);
  89         lei_ok(qw(q -a -o), "mboxrd:$o", qw(m:testmessage@example.com));
  90         $buf = $read_file->($o);
  91         open my $fh, '<', \$buf or BAIL_OUT "PerlIO::scalar $!";
  92         my %res;
  93         PublicInbox::MboxReader->mboxrd($fh, sub {
  94                 my ($eml) = @_;
  95                 $res{$eml->header_raw('Message-ID')} = $eml;
  96         });
  97         is_deeply(\%res, $exp, '--augment worked');
  98
  99         lei_ok(qw(q -o), "mboxrd:/dev/stdout", qw(m:qp@example.com)) or
 100                 diag $lei_err;
 101         like($lei_out, qr/^Status: OR\n/sm, 'Status set by previous augment');
 102 }
 103
 104 });
 105 done_testing;