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