On 2018-02-28 12:10, Patrick Shanahan wrote:

> some time ago, in an earlier age, Sven Guckes posted a sed or perl
> filter to hide "Subject:" additions, but I seem to have lost it, and
> he seems to be missing too :^(

Here's what I do now as part of my incoming pipeline.  Of course, this
in fact _rewrites_ the email, not being just a filter for mutt display,
so it's not really what the OP is asking for.

$main::mail is a Mail::Audit instance constructed earlier in the
framework.

## <<15-degunk.pl

use Email::MIME::RFC2047::Decoder ;
use Email::MIME::RFC2047::Encoder ;

my $decoder = Email::MIME::RFC2047::Decoder->new;
my @encparms = (encoding => 'utf-8', method   => 'Q');
my $encoder = Email::MIME::RFC2047::Encoder->new(@encparms);
my $tagre = qr{\[[-_?a-zA-Z0-9/]+(\s+(list|forum|spam)|[?])?\]:?}i;
my $repre = qr{(re|fwd):}i;

my $subject = $main::mail->get('subject');

SUBJECT:
{
  do {
    last SUBJECT unless $subject;
    my $subject_dec = $decoder->decode_text($subject);
    my $is_reply = 0;
    my $prefixed = 0;
    while ($subject_dec =~ /^($tagre|$repre)\h*/) {
      my $preflen = $+[0];
      $prefixed = 1;
      $is_reply = 1 if $subject_dec =~ m(^$repre)i;
      $subject_dec = substr $subject_dec, $preflen;
    }
    last SUBJECT unless $prefixed;
    $subject_dec = 'Re: ' . $subject_dec if $is_reply;
    my $subject_enc = $encoder->encode_text($subject_dec);

    $main::mail->add_header('X-Old-Subject' => $subject);
    $main::mail->replace_header('Subject' => $subject_enc);
    last SUBJECT;
  } while 1;
}

## >>15-degunk.pl


-- 
Please don't Cc: me privately on mailing lists and Usenet,
if you also post the followup to the list or newsgroup.
To reply privately _only_ on Usenet and on broken lists
which rewrite From, fetch the TXT record for no-use.mooo.com.

Reply via email to