mail-to-filter

#!/usr/bin/perl
no warnings 'deprecated';

# changes
# - silence warnings
# - use Return-Path to detect mutt weed

#   mail-to-filter - strips long distribution lists from mail
#   Copyright (C) 2000-2003 Gary A. Johnson
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.

# Description:
#
#       This program is intended to be used as a filter ahead of a mail
#       reader's pager, for example as the display_filter for mutt.  It
#       shortens To and Cc lists longer than two lines, replacing the
#       second and subsequent lines with
#
#               [<lines> lines deleted]
#
#       indicating the number of lines deleted.  It also removes excess
#       spaces at the ends of all lines of the message, but preserves
#       the trailing space of the signature's "-- " line.
#
# Revision History:
#
#       18 Nov. 2003 - Allow the lower-case header field names "to" and
#                      "cc" generated by some MUAs.  Patch contributed
#                      by Aseem Asthana.
#
#       27 Mar. 2002 - Truncates lines in To: and Cc: lists longer than
#                      $COLUMNS.
#
#       25 Jan. 2002 - Detects mutt's "weed" state by checking for
#                      "^From " on the first line and if not weeding,
#                      does not filter To and Cc lists.
#
#       27 Nov. 2001 - No longer removes trailing space from
#                      sigdashes ("^-- $").
#
# The latest version is available at
#
#       http://www.spocom.com/users/gjohnson/mutt/mail-to-filter
#
# Please direct any comments to:
#
#       Gary Johnson <garyjohn@spk.agilent.com>


eval 'exec /usr/bin/perl -S $0 ${1+"$@"}'
    if $running_under_some_shell;
                        # this emulates #! processing on NIH machines.
                        # (remove #! line above if indigestible)

eval '$'.$1.'$2;' while $ARGV[0] =~ /^([A-Za-z_0-9]+=)(.*)/ && shift;
                        # process any FOO=bar switches

$[ = 1;                 # set array base to 1
$, = ' ';               # set output field separator
$\ = "\n";              # set output record separator

$weeding = 1;
$in_to_list = 0;
$in_cc_list = 0;
$spaces = sprintf('%80s', '');
$width = $ENV{'COLUMNS'} || 80;

line: while (<>) {
    chop;               # strip record separator
    s/\s+$// unless /^-- $/;
                        # Remove excess spaces at the ends of lines
                        # that can cause lines to wrap unnecessarily,
                        # but don't corrupt sigdashes.

    if ($weeding == 1) {
        @Fld = split(' ', $_, 9999);

        if ($in_to_list == 1) {
            if (/^[Tt][Oo]:.*@/) {
                $lines += 1;
                $last_line = $_;
                next line;
            }
            if (/^[^ \t]/ || /^$/) {
                if ($lines == 1) {
                    # The $last_line was not the first line of the "To:"
                    # list, so it should begin with a tab.  Assume for
                    # now that it does and adjust the long-line
                    # truncation procedure accordingly.
                    #
                    if (length($last_line) > $width - 7) {
                        substr($last_line, $width - 7 - 4) = "[...]";
                    }
                    print $last_line;
                }
                elsif ($lines > 1) {
                    print $indentation . '[' . $lines . ' lines deleted]';
                }
                $in_to_list = 0;
            }
            else {
                $lines += 1;
                $last_line = $_;
                next line;
            }
        }
        if ($in_cc_list == 1) {
            if (/^[Cc][Cc]:.*@/) {
                $lines += 1;
                $last_line = $_;
                next line;
            }
            if (/^[^ \t]/ || /^$/) {
                if ($lines == 1) {
                    # The $last_line was not the first line of the "Cc:"
                    # list, so it should begin with a tab.  Assume for
                    # now that it does and adjust the long-line
                    # truncation procedure accordingly.
                    #
                    if (length($last_line) > $width - 7) {
                        substr($last_line, $width - 7 - 4) = "[...]";
                    }
                    print $last_line;
                }
                elsif ($lines > 1) {
                    print $indentation . '[' . $lines . ' lines deleted]';
                }
                $in_cc_list = 0;
            }
            else {
                $lines += 1;
                $last_line = $_;
                next line;
            }
        }
        if (/^[Tt][Oo]:.*@/) {
            $indentation = substr($spaces, 1, index($_, $Fld[2]) - 1);
            $in_to_list = 1;
            $lines = 0;
            if (length($_) > $width) {
                substr($_, $width - 4) = "[...]";
            }
        }
        if (/^[Cc][Cc]:.*@/) {
            $indentation = substr($spaces, 1, index($_, $Fld[2]) - 1);
            $in_cc_list = 1;
            $lines = 0;
            if (length($_) > $width) {
                substr($_, $width - 4) = "[...]";
            }
        }
        if (($. == 3) && (/^Return-Path: /)) {
            $weeding = 0;
        }
    }
    print $_;
}

exit 0;