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