Article 3588 of comp.lang.perl:
Xref: feenix.metronet.com comp.lang.perl:3588
Path: feenix.metronet.com!news.ecn.bgu.edu!wupost!howland.reston.ans.net!gatech!purdue!not-for-mail
From:
[email protected] (Gene Spafford)
Newsgroups: comp.lang.perl
Subject: Re: Looking for mailstuff.pl
Date: 20 Jun 1993 22:36:09 -0500
Organization: Department of Computer Sciences, Purdue University
Lines: 87
Message-ID: <
[email protected]>
References: <
[email protected]>
NNTP-Posting-Host: uther.cs.purdue.edu
In-reply-to:
[email protected]'s message of Wed, 16 Jun 93 22:01:30 GMT
It hasn't been updated in a while, but here it is:
# Routines to parse out an RFC 822 mailheader
# E. H. Spafford, 11/91; last mod 9/9/92
#
# Includes contribution/bugfix from:
# Mike Stok <
[email protected]>
#
# ParseMailHeader breaks out the header into an % array
# indexed by a lower-cased keyword, e.g.
# &ParseMailHeader(STDIN, *Array);
# use $Array{'subject'}
#
# Note that some duplicate lines (like "Received:") will get joined
# into a single entry in %Array; use @Array if you want them separate
# $Array will contain the unprocessed header, with embedded
# newlines
# @Array will contain the header, one line per entry
#
# RetMailAddr tries to pull out the "preferred" return address
# based on the presence or absence of various return-reply fields
package MailStuff;
# Call as &ParseMailHeader(FileHandle, *array)
sub main'ParseMailHeader ## Public
{
local($save1, $save2) = ($*, $/);
local($FH, *array) = @_;
local ($keyw, $val);
%array = ();
@array = ();
# force unqualified filehandles into callers' package
local($package) = caller;
$FH =~ s/^[^']+$/$package'$&/;
($*, $/) = (1, '');
$array = $_ = <$FH>;
($*, $/) = ($save1, $save2);
s/\n\s+/ /g;
@array = split('\n');
foreach $_ (@array)
{
($keyw, $val) = m/^([^:]+):\s*(.*\S)\s*$/g;
$keyw =~ y/A-Z/a-z/;
if (defined($array{$keyw})) {
$array{$keyw} .= "\t$val";
} else {
$array{$keyw} = $val;
}
}
}
# Call as $addr = &RetMailAddr(*array)
# This assumes that the header is in RFC 822 format
sub main'RetMailAddr ## Public
{
local(*arr) = @_;
local($ReplyTo) = ($arr{'reply-to'} || $arr{'from'} ||
$arr{'return-path'} || $arr{'apparently-from'});
defined($ReplyTo) ? &CleanAddr($ReplyTo) : undef;
}
sub CleanAddr ## Private
{
local($_) = @_;
s/\s*\(.*\)\s*//;
1 while s/.*<(.*)>.*/$1/;
s/^\s*(.*\S)\s*$/$1/;
s/^@.*:.+@.+$/<$&>/;
$_;
}
1;
--
Gene Spafford, COAST Project Director
Software Engineering Research Center & Dept. of Computer Sciences
Purdue University, W. Lafayette IN 47907-1398
Internet:
[email protected] phone: (317) 494-7825
