]> Sergey Matveev's repositories - public-inbox.git/blob - lib/PublicInbox/LeiViewText.pm
6f5fca492bc224b10ff4f03011002098b86ad480
[public-inbox.git] / 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;