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