no-alternative

#!/usr/bin/perl

# no-alternative version 0.50.

# expect a message on stdin.  If it's multipart/alternative, remove all
# alternatives except text/plain, and forward the message to $USER-alternative.
# Presumably you've got a ~/.qmail-alternative file which stores the mail
# in the user's mailbox.

# grovel through the headers to get the boundary.
while(<>) {
  $continuation = 0 if /^\S/;
  $continuation = 1 if m!^Content-Type: multipart/alternative;!i;
  $boundary = $1 if $continuation && /boundary="(.*?)"/;
  last if /^$/;
  $headers .= $_ unless $continuation;	# delete multipart/alternative if found.
}

# dispose of messages which are not multipart/alternative
unless ($boundary) {
  exit 0;
}

$boundary =~ s/\W/\\$&/g;	# protect any meta characters in the boundary.
$printing = 0;			# we start by discarding the pre-message cuft.
$header = 0;			# and we start outside of a header.
open(MAIL, "|forward $ENV{USER}-alternative") or die;
print MAIL $headers;
#print "Searching for boundary $boundary\n";
while(<>) {
#  print $printing?"P":" ";
#  print $header?"H":" ";
#  print $_;
  last if /^--$boundary--$/;
  if (/^--$boundary$/) {
    $header = 1;
    $printing = 0;
    next; # discard boundary
  }
  $printing = 0 if $header && m!^Content-Type:!i;
  $printing = 1 if $header && m!^Content-Type: text/plain;?!i;
  $header = 0 if $header and /^$/;
  print MAIL if $printing;
}
close MAIL;

exit 99;