ziegast@ENG.UMD.EDU (Eric Ziegast) (02/27/91)
After reading a few sections of the Perl Nutshell book, I came across
a neat little s/// and split routine that split all of the headers
of a mail message into an associative array. Unfortunately, it did't
do a good job on the last line of the header. I've made my own header
splitter to strip apart a message piped from slocal (man mhook).
What it does is read a message from standard input and split it into
two strings: $header and $body. It then cleans it up and splits the
header enties into associative keys (header names) and values (header
info).
#!/usr/bin/perl
#
# I claim no copyright to anything below. Read Perl's copyleft though.
# If it doesn't work, don't sue me, 'cause don't guarantee anything.
#
######## Extract header and body info
#
# While $body is undefined (by default), concatenate lines into $header.
# When first blank line ("\n") is read, define $body so that all lines
# will be concatenated to $body
#
while (<STDIN>) {
if ($_ eq "\n") {$body = ""; }
elsif (! defined $body) {$header .= $_; }
else { $body .= $_; }
}
######## Make all headers "one-liners" and strip unwanted Received:
#
# This part first sets a special variable ($*) so that pattern matching
# will be done accross multiple lines. The first search turns "\n" into
# " " so that all headers are one line. The second search (optional),
# removes all "Received:" headers. (I don't want them.) The last line
# resets pattern matching to be single-line only (the default).
#
$* = 1;
$header =~ s/\n\s+/ /g;
$header =~ s/Received:.*\n//g;
undef $*;
######## Load headers into an associative array
#
# For every header (note, they're all one-liners),
#
# set $head{KEY} = VALUE
#
# where KEY is the name of the header and VALUE is the text after the ":".
#
foreach $ln (split("\n", $header)) {
if ($ln =~ /^([-\w]+):\s+(.*)$/) { $head{$1} = $2; } }
################# Rest of program #################
Now, all you need to do when you need to process any header info is
use the associative array entry. For example, if I wanted to capitalize
the Subject: info, I'd use:
$head{'Subject'} =~ tr/a-z/A-Z/;
or maybe:
$head{'From'} =~ tr/A-Z/a-z/;
if ($head{'From'} =~ /jromine@(\w*.?ics.uci.edu)/) {
print "You got mail from John Romine at $1\n";
if ($head{'Subject'} =~ /[Mm][Hh].*6.7.2/) {
print "NEW MH PATCH!!\n";
}
}
A good place to use the $header and $body info is to reconstruct the
message for storage or inclusion in another message. As an example,
I provide the subroutine &adios. If I come upon some error while pro-
cessing a message, I just "&adios(MESSAGE)" and it spits back an error
message to the sender (from Return-Path: if provided) and an error
logging e-Mail address.
Note:
$ADDRESS_OWNER = "e-mail address for error logging";
$ADDRES_REQUEST = "e-mail address of human administrator";
$DRAFTS = "draft folder to create draft messages";
##########################################################################
# adios($STRING);
# Adios - Fatal error handler
# Returns message to sender (if possible) and notifies GM.
##########################################################################
sub adios {
local($ERRSTR) = @_;
# Get new message number in a drafts folder to create message
local($emsg) = `mhpath +$DRAFTS new`;
open(EMSG,"> $emsg") || exit 1;
# Use Return-Path if available.
if ($rpath eq "") { print EMSG "To: $ADDRESS_OWNER\n"; }
else { print EMSG "To: $rpath\ncc: $ADDRESS_OWNER\n"; }
print EMSG <<EMEOF;
Subject: Error processing mail message
--------
The address you sent your message to is processed automatically by a
mail filter. Obviously, something went wrong. Please mail
$ADDRESS_REQUEST
with questions and/or problems or try again.
Cause of error:
$ERRSTR
------- Included message
$header
$body
------- End of included message
EMEOF
close EMSG;
exec "send $emsg";
exit 0;
}
######## END OF SUBROUTINE #########
But wait! There's more!
Did you ever want to split apart your .mh_profile entries? With the
Jinsu(tm) .mh_profile knife attachment you can slice and dice away!
Why not use the same techniques as headers? The only exception here,
is that there are no "Received:" lines to worry about, and comments (#)
should be stripped with:
$header =~ s/#.*\n//;
Once you have a %profile associative array, you can attept something
like:
if (! defined $profile('Draft-Folder')) {
$profile('Draft-Folder') = "+drafts";
printf "No draft folder specified. Using +drafts.\n";
}
$newmsg = `mhpath $profile('Draft-Folder') new`;
open(MESSAGE,"> $newmsg") || die "Draft message \"$newmsg\": $!\n";
#
#process rest of draft
#
close(MESSAGE);
exec "send $newmsg" || die "EEEK! \"send $newmsg\": $!\n";
If using a combination of shell and awk scripts were a pain in the past,
learning Perl is the best thing you can do for yourself. I used to despise
awk because I couldn't understand it. I learned awk and learned to like
its pattern matching abilities. I used to doubt how useful Perl is for
me until I started writing 40 lines of C code to do what Perl does in one.
I still hate Lisp. But you never know... ;-)
________________________________________________________________________
Eric W. Ziegast, University of Merryland, Engineering Computing Services
ziegast@eng.umd.edu - Eric@[301.405.3689]