t/msg_iter.t

   1 # Copyright (C) 2016-2020 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3 use strict;
   4 use warnings;
   5 use Test::More;
   6 use Email::MIME;
   7 use PublicInbox::Hval qw(ascii_html);
   8 use_ok('PublicInbox::MsgIter');
   9
  10 {
  11         my $parts = [ Email::MIME->create(body => "a\n"),
  12                         Email::MIME->create(body => "b\n") ];
  13         my $mime = Email::MIME->create(parts => $parts,
  14                                 header_str => [ From => 'root@localhost' ]);
  15         my @parts;
  16         msg_iter($mime, sub {
  17                 my ($part, $level, @ex) = @{$_[0]};
  18                 my $s = $part->body_str;
  19                 $s =~ s/\s+//s;
  20                 push @parts, [ $s, $level, @ex ];
  21         });
  22         is_deeply(\@parts, [ [ qw(a 1 1) ], [ qw(b 1 2) ] ], 'order is fine');
  23 }
  24
  25 {
  26         my $parts = [ Email::MIME->create(body => 'a'),
  27                         Email::MIME->create(body => 'b') ];
  28         $parts = [ Email::MIME->create(parts => $parts,
  29                                 header_str => [ From => 'sub@localhost' ]),
  30                         Email::MIME->create(body => 'sig') ];
  31         my $mime = Email::MIME->create(parts => $parts,
  32                                 header_str => [ From => 'root@localhost' ]);
  33         my @parts;
  34         msg_iter($mime, sub {
  35                 my ($part, $level, @ex) = @{$_[0]};
  36                 my $s = $part->body_str;
  37                 $s =~ s/\s+//s;
  38                 push @parts, [ $s, $level, @ex ];
  39         });
  40         is_deeply(\@parts, [ [qw(a 2 1 1)], [qw(b 2 1 2)], [qw(sig 1 2)] ],
  41                 'nested part shows up properly');
  42 }
  43
  44 {
  45         my $f = 't/iso-2202-jp.mbox';
  46         my $mime = Email::MIME->new(do {
  47                 open my $fh, '<', $f or die "open($f): $!";
  48                 local $/;
  49                 <$fh>;
  50         });
  51         my $raw = '';
  52         msg_iter($mime, sub {
  53                 my ($part, $level, @ex) = @{$_[0]};
  54                 my ($s, $err) = msg_part_text($part, 'text/plain');
  55                 ok(!$err, 'no error');
  56                 $raw .= $s;
  57         });
  58         ok(length($raw) > 0, 'got non-empty message');
  59         is(index($raw, '$$$'), -1, 'no unescaped $$$');
  60 }
  61
  62 {
  63         my $f = 't/x-unknown-alpine.eml';
  64         my $mime = Email::MIME->new(do {
  65                 open my $fh, '<', $f or die "open($f): $!";
  66                 local $/;
  67                 binmode $fh;
  68                 <$fh>;
  69         });
  70         my $raw = '';
  71         msg_iter($mime, sub {
  72                 my ($part, $level, @ex) = @{$_[0]};
  73                 my ($s, $err) = msg_part_text($part, 'text/plain');
  74                 $raw .= $s;
  75         });
  76         like($raw, qr!^\thttps://!ms, 'tab expanded with X-UNKNOWN');
  77         like(ascii_html($raw), qr/&#8226; bullet point/s,
  78                 'got bullet point when X-UNKNOWN assumes UTF-8');
  79 }
  80
  81 { # API not finalized
  82         my @warn;
  83         local $SIG{__WARN__} = sub { push @warn, [ @_ ] };
  84         my $attr = "So and so wrote:\n";
  85         my $q = "> hello world\n" x 10;
  86         my $nq = "hello world\n" x 10;
  87         my @sections = PublicInbox::MsgIter::split_quotes($attr . $q . $nq);
  88         is($sections[0], $attr, 'attribution matches');
  89         is($sections[1], $q, 'quoted section matches');
  90         is($sections[2], $nq, 'non-quoted section matches');
  91         is(scalar(@sections), 3, 'only three sections for short message');
  92         is_deeply(\@warn, [], 'no warnings');
  93
  94         $q x= 3300;
  95         $nq x= 3300;
  96         @sections = PublicInbox::MsgIter::split_quotes($attr . $q . $nq);
  97         is_deeply(\@warn, [], 'no warnings on giant message');
  98         is(join('', @sections), $attr . $q . $nq, 'result matches expected');
  99         is(shift(@sections), $attr, 'attribution is first section');
 100         my @check = ('', '');
 101         while (defined(my $l = shift @sections)) {
 102                 next if $l eq '';
 103                 like($l, qr/\n\z/s, 'section ends with newline');
 104                 my $idx = ($l =~ /\A>/) ? 0 : 1;
 105                 $check[$idx] .= $l;
 106         }
 107         is($check[0], $q, 'long quoted section matches');
 108         is($check[1], $nq, 'long quoted section matches');
 109 }
 110
 111 done_testing();
 112 1;