}
}
+sub _text_write_cb ($$) {
+ my ($self, $lei) = @_;
+ my $dedupe = $lei->{dedupe};
+ $dedupe->prepare_dedupe if $dedupe;
+ my $lvt = $lei->{lvt};
+ my $ovv = $lei->{ovv};
+ $lei->{1} // die "no stdout ($ovv->{dst})"; # redirected earlier
+ $lei->{1}->autoflush(1);
+ binmode $lei->{1}, ':utf8';
+ my $lse = $lei->{lse}; # may be undef
+ sub { # for git_to_mail
+ my ($bref, $smsg, $eml) = @_;
+ $lse->xsmsg_vmd($smsg) if $lse;
+ $eml //= PublicInbox::Eml->new($bref); # copy bref
+ return if $dedupe && $dedupe->is_dup($eml, $smsg);
+ my $lk = $ovv->lock_for_scope;
+ $lei->out(${$lvt->eml_to_text($smsg, $eml)}, "\n");
+ }
+}
+
sub write_cb { # returns a callback for git_to_mail
my ($self, $lei) = @_;
# _mbox_write_cb, _maildir_write_cb or _imap_write_cb
$lei->{ovv}->{dst} = $dst .= '/' if substr($dst, -1) ne '/';
} elsif (substr($fmt, 0, 4) eq 'mbox') {
require PublicInbox::MboxReader;
- (-d $dst || (-e _ && !-w _)) and die
- "$dst exists and is not a writable file\n";
$self->can("eml2$fmt") or die "bad mbox format: $fmt\n";
$self->{base_type} = 'mbox';
} elsif ($fmt =~ /\Aimaps?\z/) { # TODO .onion support
$dst = $lei->{ovv}->{dst} = $$uri; # canonicalized
$lei->{net} = $net;
$self->{base_type} = 'imap';
+ } elsif ($fmt eq 'text') {
+ require PublicInbox::LeiViewText;
+ $lei->{lvt} = PublicInbox::LeiViewText->new($lei);
+ $self->{base_type} = 'text';
} else {
die "bad mail --format=$fmt\n";
}
+ if ($self->{base_type} =~ /\A(?:text|mbox)\z/) {
+ (-d $dst || (-e _ && !-w _)) and die
+ "$dst exists and is not a writable file\n";
+ }
+ if ($self->{base_type} eq 'text') {
+ my @err = map {
+ defined($lei->{opt}->{$_}) ? "--$_" : ();
+ } (qw(mua save));
+ die "@err incompatible with $fmt\n" if @err;
+ }
$self->{dst} = $dst;
$lei->{dedupe} = $lei->{lss} // do {
my $dd_cls = 'PublicInbox::'.
}
}
+sub _pre_augment_text {
+ my ($self, $lei) = @_;
+ my $dst = $lei->{ovv}->{dst};
+ my $out;
+ my $devfd = $lei->path_to_fd($dst) // die "bad $dst";
+ if ($devfd >= 0) {
+ $out = $lei->{$devfd};
+ } else { # normal-looking path
+ if (-p $dst) {
+ open $out, '>', $dst or die "open($dst): $!";
+ } elsif (-f _ || !-e _) {
+ # text allows augment, HTML/Atom won't
+ my $mode = $lei->{opt}->{augment} ? '>>' : '>';
+ open $out, $mode, $dst or die "open($mode, $dst): $!";
+ } else {
+ die "$dst is not a file or FIFO\n";
+ }
+ }
+ $lei->{ovv}->ovv_out_lk_init if !$lei->{ovv}->{lock_path};
+ $lei->{1} = $out;
+ undef;
+}
+
sub _pre_augment_mbox {
my ($self, $lei) = @_;
my $dst = $lei->{ovv}->{dst};
sub do_augment { # slow, runs in wq worker
my ($self, $lei) = @_;
# _do_augment_maildir, _do_augment_mbox, or _do_augment_imap
- my $m = "_do_augment_$self->{base_type}";
- $self->$m($lei);
+ my $m = $self->can("_do_augment_$self->{base_type}") or return;
+ $m->($self, $lei);
}
# fast (spawn compressor or mkdir), runs in same process as pre_augment
--- /dev/null
+# Copyright (C) 2021 all contributors <meta@public-inbox.org>
+# License: AGPL-3.0+ <https://www.gnu.org/licenses/agpl-3.0.txt>
+
+# PublicInbox::Eml to (optionally colorized) text coverter for terminals
+# the non-HTML counterpart to PublicInbox::View
+package PublicInbox::LeiViewText;
+use strict;
+use v5.10.1;
+use PublicInbox::MsgIter qw(msg_part_text);
+use PublicInbox::ContentHash qw(git_sha);
+use PublicInbox::MID qw(references);
+use PublicInbox::View;
+use PublicInbox::Hval;
+use PublicInbox::ViewDiff;
+use PublicInbox::Spawn qw(popen_rd);
+use Term::ANSIColor;
+
+sub _xs {
+ # xhtml_map works since we don't search for HTML ([&<>'"])
+ $_[0] =~ s/([\x7f\x00-\x1f])/$PublicInbox::Hval::xhtml_map{$1}/sge;
+}
+
+my %DEFAULT_COLOR = (
+ # mutt names, loaded from ~/.config/lei/config
+ quoted => 'blue',
+ hdrdefault => 'cyan',
+ status => 'bright_cyan', # smsg stuff
+
+ # git names and defaults, falls back to ~/.gitconfig
+ new => 'green',
+ old => 'red',
+ meta => 'bold',
+ frag => 'cyan',
+ func => undef,
+ context => undef,
+);
+
+sub my_colored {
+ my ($self, $slot) = @_; # $_[2] = buffer
+ my $val = $self->{"color.$slot"} //=
+ $self->{-leicfg}->{"color.$slot"} //
+ $self->{-gitcfg}->{"color.diff.$slot"} //
+ $self->{-gitcfg}->{"diff.color.$slot"} //
+ $DEFAULT_COLOR{$slot};
+ $val = $val->[-1] if ref($val) eq 'ARRAY';
+ if (defined $val) {
+ # git doesn't use "_", Term::ANSIColor does
+ $val =~ s/\Abright([^_])/bright_$1/i;
+ ${$self->{obuf}} .= Term::ANSIColor::colored($_[2], lc $val);
+ } else {
+ ${$self->{obuf}} .= $_[2];
+ }
+}
+
+sub uncolored { ${$_[0]->{obuf}} .= $_[2] }
+
+sub new {
+ my ($cls, $lei) = @_;
+ my $self = bless { %{$lei->{opt}}, -colored => \&uncolored }, $cls;
+ return $self unless $self->{color} || -t $lei->{1};
+ my $cmd = [ qw(git config -z --includes -l) ];
+ my ($r, $pid) = popen_rd($cmd, undef, { 2 => $lei->{2} });
+ my $cfg = PublicInbox::Config::config_fh_parse($r, "\0", "\n");
+ waitpid($pid, 0);
+ if ($?) {
+ $lei->err("# git-config failed, no color (non-fatal)");
+ return $self;
+ }
+ $self->{-colored} = \&my_colored;
+ $self->{-gitcfg} = $cfg;
+ $self->{-leicfg} = $lei->{cfg};
+ $self;
+}
+
+sub hdr_buf ($$) {
+ my ($self, $eml) = @_;
+ my $hbuf = '';
+ for my $f (qw(From To Cc)) {
+ for my $v ($eml->header($f)) {
+ next if $v !~ /\S/;
+ PublicInbox::View::fold_addresses($v);
+ _xs($v);
+ $hbuf .= "$f: $v\n";
+ }
+ }
+ for my $f (qw(Subject Date Newsgroups Message-ID X-Message-ID)) {
+ for my $v ($eml->header($f)) {
+ _xs($v);
+ $hbuf .= "$f: $v\n";
+ }
+ }
+ if (my @irt = $eml->header_raw('In-Reply-To')) {
+ for my $v (@irt) {
+ _xs($v);
+ $hbuf .= "In-Reply-To: $v\n";
+ }
+ } else {
+ my $refs = references($eml);
+ if (defined(my $irt = pop @$refs)) {
+ _xs($irt);
+ $hbuf .= "In-Reply-To: <$irt>\n";
+ }
+ if (@$refs) {
+ my $max = $self->{-max_cols};
+ $hbuf .= 'References: ' .
+ join("\n\t", map { '<'._xs($_).'>' } @$refs) .
+ ">\n";
+ }
+ }
+ $self->{-colored}->($self, 'hdrdefault', $hbuf .= "\n");
+}
+
+sub attach_note ($$$$;$) {
+ my ($self, $ct, $p, $fn, $err) = @_;
+ my ($part, $depth, $idx) = @$p;
+ my $obuf = $self->{obuf};
+ my $nl = $idx eq '1' ? '' : "\n"; # like join("\n", ...)
+ $$obuf .= <<EOF if $err;
+[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
+EOF
+ my $blob = $self->{-smsg}->{blob} // '';
+ $blob .= ':' if $blob ne '';
+ $$obuf .= "[-- Attachment $blob$idx ";
+ _xs($ct);
+ my $size = length($part->body);
+ my $ts = "Type: $ct, Size: $size bytes";
+ my $d = $part->header('Content-Description') // $fn // '';
+ _xs($d);
+ $$obuf .= $d eq '' ? "$ts --]\n" : "$d --]\n[-- $ts --]\n";
+ hdr_buf($self, $part) if $part->{is_submsg};
+}
+
+sub flush_text_diff ($$) {
+ my ($self, $cur) = @_;
+ my @top = split($PublicInbox::ViewDiff::EXTRACT_DIFFS, $$cur);
+ undef $$cur; # free memory
+ my $dctx;
+ my $obuf = $self->{obuf};
+ my $colored = $self->{-colored};
+ while (defined(my $x = shift @top)) {
+ if (scalar(@top) >= 4 &&
+ $top[1] =~ $PublicInbox::ViewDiff::IS_OID &&
+ $top[0] =~ $PublicInbox::ViewDiff::IS_OID) {
+ splice(@top, 0, 4);
+ $dctx = 1;
+ $colored->($self, 'meta', $x);
+ } elsif ($dctx) {
+ # Quiet "Complex regular subexpression recursion limit"
+ # warning. Perl will truncate matches upon hitting
+ # that limit, giving us more (and shorter) scalars than
+ # would be ideal, but otherwise it's harmless.
+ #
+ # We could replace the `+' metacharacter with `{1,100}'
+ # to limit the matches ourselves to 100, but we can
+ # let Perl do it for us, quietly.
+ no warnings 'regexp';
+
+ for my $s (split(/((?:(?:^\+[^\n]*\n)+)|
+ (?:(?:^-[^\n]*\n)+)|
+ (?:^@@ [^\n]+\n))/xsm, $x)) {
+ if (!defined($dctx)) {
+ ${$self->{obuf}} .= $s;
+ } elsif ($s =~ s/\A(@@ \S+ \S+ @@\s*)//) {
+ $colored->($self, 'frag', $1);
+ $colored->($self, 'func', $s);
+ } elsif ($s =~ /\A\+/) {
+ $colored->($self, 'new', $s);
+ } elsif ($s =~ /\A-- $/sm) { # email sig starts
+ $dctx = undef;
+ ${$self->{obuf}} .= $s;
+ } elsif ($s =~ /\A-/) {
+ $colored->($self, 'old', $s);
+ } else {
+ $colored->($self, 'context', $s);
+ }
+ }
+ } else {
+ ${$self->{obuf}} .= $x;
+ }
+ }
+}
+
+sub add_text_buf { # callback for Eml->each_part
+ my ($p, $self) = @_;
+ my ($part, $depth, $idx) = @$p;
+ my $ct = $part->content_type || 'text/plain';
+ my $fn = $part->filename;
+ my ($s, $err) = msg_part_text($part, $ct);
+ return attach_note($self, $ct, $p, $fn) unless defined $s;
+ hdr_buf($self, $part) if $part->{is_submsg};
+ $s =~ s/\r\n/\n/sg;
+ _xs($s);
+ $s .= "\n" unless substr($s, -1, 1) eq "\n";
+ my $diff = ($s =~ /^--- [^\n]+\n\+{3} [^\n]+\n@@ /ms);
+ my @sections = PublicInbox::MsgIter::split_quotes($s);
+ undef $s; # free memory
+ if (defined($fn) || ($depth > 0 && !$part->{is_submsg}) || $err) {
+ # badly-encoded message with $err? tell the world about it!
+ attach_note($self, $ct, $p, $fn, $err);
+ ${$self->{obuf}} .= "\n";
+ }
+ my $colored = $self->{-colored};
+ for my $cur (@sections) {
+ if ($cur =~ /\A>/) {
+ $colored->($self, 'quoted', $cur);
+ } elsif ($diff) {
+ flush_text_diff($self, \$cur);
+ } else {
+ ${$self->{obuf}} .= $cur;
+ }
+ undef $cur; # free memory
+ }
+}
+
+# returns an arrayref suitable for $lei->out or print
+sub eml_to_text {
+ my ($self, $smsg, $eml) = @_;
+ local $Term::ANSIColor::EACHLINE = "\n";
+ $self->{obuf} = \(my $obuf = '');
+ $self->{-smsg} = $smsg;
+ $self->{-max_cols} = ($self->{columns} //= 80) - 8; # for header wrap
+ my @h = ();
+ for my $f (qw(blob pct)) {
+ push @h, "$f:$smsg->{$f}" if defined $smsg->{$f};
+ }
+ @h = ("# @h\n") if @h;
+ for my $f (qw(kw L)) {
+ my $v = $smsg->{$f} or next;
+ push @h, "# $f:".join(',', @$v)."\n" if @$v;
+ }
+ $self->{-colored}->($self, 'status', join('', @h));
+ hdr_buf($self, $eml);
+ $eml->each_part(\&add_text_buf, $self, 1);
+ delete $self->{obuf};
+}
+
+1;