Path: utzoo!utgpu!news-server.csri.toronto.edu!cs.utexas.edu!uunet!tut.cis.ohio-state.edu!ucbvax!iwarp.intel.com!news
From: merlyn@iwarp.intel.com (Randal L. Schwartz)
Newsgroups: comp.lang.perl
Subject: Re: Email parsing in perl?
Message-ID: <1991Feb17.024216.17118@iwarp.intel.com>
Date: 17 Feb 91 02:42:16 GMT
References: <16798@venera.isi.edu> <1991Feb16.185313.1789@convex.com>
Sender: news@iwarp.intel.com
Reply-To: merlyn@iwarp.intel.com (Randal L. Schwartz)
Distribution: comp
Organization: Stonehenge; netaccess via Intel, Beaverton, Oregon, USA
Lines: 89
In-Reply-To: tchrist@convex.COM (Tom Christiansen)

In article <1991Feb16.185313.1789@convex.com>, tchrist@convex (Tom Christiansen) writes:
| Off the top of my head, you should be able to munge this into use:
| 
|     $/ = ''; # paramode
|     $* = 1;
|     $_ = <>; # read header
| 
|     @hdrs = split( /^([-\w]+):\s*/ );
|     shift @hdrs;  # don't need leading stuff
| 
|     while ( ($name, $text) = splice(@hdrs,0,2) ) {
| 	$text =~ s/\n/ /g;  # maybe don't want multlines
| 	$Header{$name} .= ", " if $Headers{$name};
| 	$Header{$name} .= $text;
|     }
| 
|     for $header (sort keys %Header) {
| 	print "<$header>: $Header{$header}\n";
|     }

Here's what I'm using everytime someone sends me a mail message (this
is an extract... hopefully, nothing above it or below it is necessary
for this example.  sigh.):

##################################################
$message = join("",<STDIN>);
($header,$body) = split(/\n\n/,$message,2); $body; # use $body for perl -w
$header =~ s/\n(\s+)/\377\1/g; # hide continuations
@headerlines = split(/\n/,$header);
for $h (split(/\s+/,<<EOL)) {
Reply-To From Sender Apparently-To To Cc Subject Date Message-ID
EOL
	@copy = @headerlines;
	@h = grep(s/^$h:\s*//i, @copy);
	next unless @h;
	if ($h =~ /^(Apparently-To|To|Cc)$/) {
		%addr = ();
		for (@h) {
			for (split(/,/)) {
				$addr{&cleanaddr($_)}++;
			}
		}
		@h = sort keys addr;
	}
	$field{$h} = join("\n",@h)."\n";
}
for (sort keys %field) {
	print "$_:\t", join("\n\t",split(/\n/,$field{$_})),"\n";
}
print "\n";

($from) = split(/\n/,$field{"Reply-To"}.$field{"From"}); # first from gets it
%tocc = ();
for ("Apparently-To","Cc","To") {
	for (split(/\n/,$field{$_})) {
		$tocc{$_}++;
	}
}
($subject) = split(/\n/,$field{"Subject"});
$subject = "(Life, the Universe, Everything)" unless $subject;

# at this point,
# $message is the entire original message
# $header contains a massaged header, $body contains the body
# $field{X} contains headers for X
# (with some massage on [Apparently-]To and Cc)
# $from is where you should send msgs back
# %tocc contains the "to"-type fields

# ... (stuff left out here)

sub cleanaddr {
	local($_) = @_;
	s/\s*\(.*\)\s*//;
	1 while s/.*<(.*)>.*/\1/;
	s/^\s+//;
	s/\s+$//;
	$_;
}
##################################################

&cleanaddr is simpleminded, but it seems to get the job done.

print "Just another Perl hacker,"
-- 
/=Randal L. Schwartz, Stonehenge Consulting Services (503)777-0095 ==========\
| on contract to Intel's iWarp project, Beaverton, Oregon, USA, Sol III      |
| merlyn@iwarp.intel.com ...!any-MX-mailer-like-uunet!iwarp.intel.com!merlyn |
\=Cute Quote: "Intel: putting the 'backward' in 'backward compatible'..."====/