xt/eml_octet-stream.t

   1 #!perl -w
   2 # Copyright (C) 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 PublicInbox::Git;
   6 use PublicInbox::Eml;
   7 use PublicInbox::MsgIter qw(msg_part_text);
   8 use PublicInbox::LeiToMail;
   9 my $eml2mboxcl2 = PublicInbox::LeiToMail->can('eml2mboxcl2');
  10 my $git_dir = $ENV{GIANT_GIT_DIR};
  11 plan 'skip_all' => "GIANT_GIT_DIR not defined for $0" unless defined($git_dir);
  12 use Data::Dumper;
  13 $Data::Dumper::Useqq = 1;
  14 my $mboxfh;
  15 if (my $out = $ENV{DEBUG_MBOXCL2}) {
  16         BAIL_OUT("$out exists") if -s $out;
  17         open $mboxfh, '>', $out or BAIL_OUT "open $out: $!";
  18 } else {
  19         diag "DEBUG_MBOXCL2 unset, not saving debug output";
  20 }
  21
  22 my $git = PublicInbox::Git->new($git_dir);
  23 my @cat = qw(cat-file --buffer --batch-check --batch-all-objects);
  24 if (require_git(2.19, 1)) {
  25         push @cat, '--unordered';
  26 } else {
  27         warn "git <2.19, cat-file lacks --unordered, locality suffers\n";
  28 }
  29 my ($errs, $ok, $tot);
  30 $errs = $ok = $tot = 0;
  31 my $ep = sub { # eml->each_part callback
  32         my ($part, $level, @ex) = @{$_[0]};
  33         ++$tot;
  34         my $ct = $part->content_type // return;
  35         $ct =~ m!\bapplication/octet-stream\b!i or return;
  36         my ($s, $err) = msg_part_text($part, $ct);
  37         if (defined $s) {
  38                 ++$ok;
  39         } else {
  40                 warn "binary $err\n";
  41                 ++$errs;
  42                 my $x = eval { $part->body };
  43                 if ($@) {
  44                         warn "decode totally failed: $@";
  45                 } else {
  46                         my ($bad) = ($x =~ m/([\p{XPosixPrint}\s]{0,10}
  47                                                 [^\p{XPosixPrint}\s]+
  48                                                 [\p{XPosixPrint}\s]{0,10})/sx);
  49                         warn Dumper([$bad]);
  50                 }
  51
  52                 push @{$_[1]}, $err; # $fail
  53         }
  54 };
  55
  56 my $cb = sub {
  57         my ($bref, $oid) = @_;
  58         my $eml = PublicInbox::Eml->new($bref);
  59         local $SIG{__WARN__} = sub { diag("$oid ", @_) };
  60         $eml->each_part($ep, my $fail = []);
  61         if (@$fail && $mboxfh) {
  62                 diag "@$fail";
  63                 print $mboxfh ${$eml2mboxcl2->($eml, { blob => $oid })} or
  64                         BAIL_OUT "print: $!";
  65         }
  66 };
  67 my $cat = $git->popen(@cat);
  68 while (<$cat>) {
  69         my ($oid, $type, $size) = split(/ /);
  70         $git->cat_async($oid, $cb) if $size && $type eq 'blob';
  71 }
  72 $git->async_wait_all;
  73 note "$errs errors";
  74 note "$ok/$tot messages had text as application/octet-stream";
  75 ok 1;
  76
  77 done_testing;