lib/PublicInbox/LeiViewText.pm

   1 # Copyright (C) 2021 all contributors <meta@public-inbox.org>
   2 # License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
   3
   4 # PublicInbox::Eml to (optionally colorized) text coverter for terminals
   5 # the non-HTML counterpart to PublicInbox::View
   6 package PublicInbox::LeiViewText;
   7 use strict;
   8 use v5.10.1;
   9 use PublicInbox::MsgIter qw(msg_part_text);
  10 use PublicInbox::ContentHash qw(git_sha);
  11 use PublicInbox::MID qw(references);
  12 use PublicInbox::View;
  13 use PublicInbox::Hval;
  14 use PublicInbox::ViewDiff;
  15 use PublicInbox::Spawn qw(popen_rd);
  16 use Term::ANSIColor;
  17
  18 sub _xs {
  19         # xhtml_map works since we don't search for HTML ([&<>'"])
  20         $_[0] =~ s/([\x7f\x00-\x1f])/$PublicInbox::Hval::xhtml_map{$1}/sge;
  21 }
  22
  23 my %DEFAULT_COLOR = (
  24         # mutt names, loaded from ~/.config/lei/config
  25         quoted => 'blue',
  26         hdrdefault => 'cyan',
  27         status => 'bright_cyan', # smsg stuff
  28
  29         # git names and defaults, falls back to ~/.gitconfig
  30         new => 'green',
  31         old => 'red',
  32         meta => 'bold',
  33         frag => 'cyan',
  34         func => undef,
  35         context => undef,
  36 );
  37
  38 sub my_colored {
  39         my ($self, $slot) = @_; # $_[2] = buffer
  40         my $val = $self->{"color.$slot"} //=
  41                         $self->{-leicfg}->{"color.$slot"} //
  42                         $self->{-gitcfg}->{"color.diff.$slot"} //
  43                         $self->{-gitcfg}->{"diff.color.$slot"} //
  44                         $DEFAULT_COLOR{$slot};
  45         $val = $val->[-1] if ref($val) eq 'ARRAY';
  46         if (defined $val) {
  47                 # git doesn't use "_", Term::ANSIColor does
  48                 $val =~ s/\Abright([^_])/bright_$1/i;
  49                 ${$self->{obuf}} .= Term::ANSIColor::colored($_[2], lc $val);
  50         } else {
  51                 ${$self->{obuf}} .= $_[2];
  52         }
  53 }
  54
  55 sub uncolored { ${$_[0]->{obuf}} .= $_[2] }
  56
  57 sub new {
  58         my ($cls, $lei) = @_;
  59         my $self = bless { %{$lei->{opt}}, -colored => \&uncolored }, $cls;
  60         return $self unless $self->{color} || -t $lei->{1};
  61         my $cmd = [ qw(git config -z --includes -l) ];
  62         my ($r, $pid) = popen_rd($cmd, undef, { 2 => $lei->{2} });
  63         my $cfg = PublicInbox::Config::config_fh_parse($r, "\0", "\n");
  64         waitpid($pid, 0);
  65         if ($?) {
  66                 $lei->err("# git-config failed, no color (non-fatal)");
  67                 return $self;
  68         }
  69         $self->{-colored} = \&my_colored;
  70         $self->{-gitcfg} = $cfg;
  71         $self->{-leicfg} = $lei->{cfg};
  72         $self;
  73 }
  74
  75 sub hdr_buf ($$) {
  76         my ($self, $eml) = @_;
  77         my $hbuf = '';
  78         for my $f (qw(From To Cc)) {
  79                 for my $v ($eml->header($f)) {
  80                         next if $v !~ /\S/;
  81                         PublicInbox::View::fold_addresses($v);
  82                         _xs($v);
  83                         $hbuf .= "$f: $v\n";
  84                 }
  85         }
  86         for my $f (qw(Subject Date Newsgroups Message-ID X-Message-ID)) {
  87                 for my $v ($eml->header($f)) {
  88                         _xs($v);
  89                         $hbuf .= "$f: $v\n";
  90                 }
  91         }
  92         if (my @irt = $eml->header_raw('In-Reply-To')) {
  93                 for my $v (@irt) {
  94                         _xs($v);
  95                         $hbuf .= "In-Reply-To: $v\n";
  96                 }
  97         } else {
  98                 my $refs = references($eml);
  99                 if (defined(my $irt = pop @$refs)) {
 100                         _xs($irt);
 101                         $hbuf .= "In-Reply-To: <$irt>\n";
 102                 }
 103                 if (@$refs) {
 104                         my $max = $self->{-max_cols};
 105                         $hbuf .= 'References: ' .
 106                                 join("\n\t", map { '<'._xs($_).'>' } @$refs) .
 107                                 ">\n";
 108                 }
 109         }
 110         $self->{-colored}->($self, 'hdrdefault', $hbuf .= "\n");
 111 }
 112
 113 sub attach_note ($$$$;$) {
 114         my ($self, $ct, $p, $fn, $err) = @_;
 115         my ($part, $depth, $idx) = @$p;
 116         my $obuf = $self->{obuf};
 117         my $nl = $idx eq '1' ? '' : "\n"; # like join("\n", ...)
 118         $$obuf .= <<EOF if $err;
 119 [-- Warning: decoded text below may be mangled, UTF-8 assumed --]
 120 EOF
 121         my $blob = $self->{-smsg}->{blob} // '';
 122         $blob .= ':' if $blob ne '';
 123         $$obuf .= "[-- Attachment $blob$idx ";
 124         _xs($ct);
 125         my $size = length($part->body);
 126         my $ts = "Type: $ct, Size: $size bytes";
 127         my $d = $part->header('Content-Description') // $fn // '';
 128         _xs($d);
 129         $$obuf .= $d eq '' ? "$ts --]\n" : "$d --]\n[-- $ts --]\n";
 130         hdr_buf($self, $part) if $part->{is_submsg};
 131 }
 132
 133 sub flush_text_diff ($$) {
 134         my ($self, $cur) = @_;
 135         my @top = split($PublicInbox::ViewDiff::EXTRACT_DIFFS, $$cur);
 136         undef $$cur; # free memory
 137         my $dctx;
 138         my $obuf = $self->{obuf};
 139         my $colored = $self->{-colored};
 140         while (defined(my $x = shift @top)) {
 141                 if (scalar(@top) >= 4 &&
 142                                 $top[1] =~ $PublicInbox::ViewDiff::IS_OID &&
 143                                 $top[0] =~ $PublicInbox::ViewDiff::IS_OID) {
 144                         splice(@top, 0, 4);
 145                         $dctx = 1;
 146                         $colored->($self, 'meta', $x);
 147                 } elsif ($dctx) {
 148                         # Quiet "Complex regular subexpression recursion limit"
 149                         # warning.  Perl will truncate matches upon hitting
 150                         # that limit, giving us more (and shorter) scalars than
 151                         # would be ideal, but otherwise it's harmless.
 152                         #
 153                         # We could replace the `+' metacharacter with `{1,100}'
 154                         # to limit the matches ourselves to 100, but we can
 155                         # let Perl do it for us, quietly.
 156                         no warnings 'regexp';
 157
 158                         for my $s (split(/((?:(?:^\+[^\n]*\n)+)|
 159                                         (?:(?:^-[^\n]*\n)+)|
 160                                         (?:^@@ [^\n]+\n))/xsm, $x)) {
 161                                 if (!defined($dctx)) {
 162                                         ${$self->{obuf}} .= $s;
 163                                 } elsif ($s =~ s/\A(@@ \S+ \S+ @@\s*)//) {
 164                                         $colored->($self, 'frag', $1);
 165                                         $colored->($self, 'func', $s);
 166                                 } elsif ($s =~ /\A\+/) {
 167                                         $colored->($self, 'new', $s);
 168                                 } elsif ($s =~ /\A-- $/sm) { # email sig starts
 169                                         $dctx = undef;
 170                                         ${$self->{obuf}} .= $s;
 171                                 } elsif ($s =~ /\A-/) {
 172                                         $colored->($self, 'old', $s);
 173                                 } else {
 174                                         $colored->($self, 'context', $s);
 175                                 }
 176                         }
 177                 } else {
 178                         ${$self->{obuf}} .= $x;
 179                 }
 180         }
 181 }
 182
 183 sub add_text_buf { # callback for Eml->each_part
 184         my ($p, $self) = @_;
 185         my ($part, $depth, $idx) = @$p;
 186         my $ct = $part->content_type || 'text/plain';
 187         my $fn = $part->filename;
 188         my ($s, $err) = msg_part_text($part, $ct);
 189         return attach_note($self, $ct, $p, $fn) unless defined $s;
 190         hdr_buf($self, $part) if $part->{is_submsg};
 191         $s =~ s/\r\n/\n/sg;
 192         _xs($s);
 193         $s .= "\n" unless substr($s, -1, 1) eq "\n";
 194         my $diff = ($s =~ /^--- [^\n]+\n\+{3} [^\n]+\n@@ /ms);
 195         my @sections = PublicInbox::MsgIter::split_quotes($s);
 196         undef $s; # free memory
 197         if (defined($fn) || ($depth > 0 && !$part->{is_submsg}) || $err) {
 198                 # badly-encoded message with $err? tell the world about it!
 199                 attach_note($self, $ct, $p, $fn, $err);
 200                 ${$self->{obuf}} .= "\n";
 201         }
 202         my $colored = $self->{-colored};
 203         for my $cur (@sections) {
 204                 if ($cur =~ /\A>/) {
 205                         $colored->($self, 'quoted', $cur);
 206                 } elsif ($diff) {
 207                         flush_text_diff($self, \$cur);
 208                 } else {
 209                         ${$self->{obuf}} .= $cur;
 210                 }
 211                 undef $cur; # free memory
 212         }
 213 }
 214
 215 # returns an arrayref suitable for $lei->out or print
 216 sub eml_to_text {
 217         my ($self, $smsg, $eml) = @_;
 218         local $Term::ANSIColor::EACHLINE = "\n";
 219         $self->{obuf} = \(my $obuf = '');
 220         $self->{-smsg} = $smsg;
 221         $self->{-max_cols} = ($self->{columns} //= 80) - 8; # for header wrap
 222         my @h = ();
 223         for my $f (qw(blob pct)) {
 224                 push @h, "$f:$smsg->{$f}" if defined $smsg->{$f};
 225         }
 226         @h = ("# @h\n") if @h;
 227         for my $f (qw(kw L)) {
 228                 my $v = $smsg->{$f} or next;
 229                 push @h, "# $f:".join(',', @$v)."\n" if @$v;
 230         }
 231         $self->{-colored}->($self, 'status', join('', @h));
 232         hdr_buf($self, $eml);
 233         $eml->each_part(\&add_text_buf, $self, 1);
 234         delete $self->{obuf};
 235 }
 236
 237 1;