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