From: etnrwi@raptus.etn.ericsson.se (Raymond A. Wiker (9482))
Newsgroups: comp.lang.perl
Subject: Re: mail digestifier in Perl?
Date: 14 Apr 92 18:07:30 GMT
Distribution: comp
Organization: Ericsson Telecom AS

In article <ALIEN.92Apr13131656@vulcan.essex.ac.uk> alien@essex.ac.uk ("Adrian F Clark") writes:

>   Does anyone have a mail digestifier (a program that bundles many mail
>   messages into a single mail digest) written in Perl?  I currently use
>   one written in C, which I need to fiddle with; and a Perl one would be
>   so much easier.

Funny to see this just now... I wrote a very small & simple
digestifier a couple of days back that I am still working on. At the
moment it is a bit simple-minded, in that it is tied to a particular
mail file format (I think it is the standard Unix-mail format).
Anyway, since it is quite short, I'll include it below.

Points to note:

*	I wrote this for a particular task; it may or may not be a
suitable starting point for a more general digestifier...

*	I used this to strip mail headers from some rmail files I
picked up from an ftp site. The messages ranged from one-liners to
upto ~1500 lines (source code...) Since I wanted to print out the
digested mail, I decided that all messages longer than $Lim2 (see
source) lines should be suppressed, and all messages with $Lim1 <
length < $Lim2 should only be printed if the user answers "y" to a
prompt.

*	I wanted only the Subject, From and Date fields from the
header; this is specified by the %HeaderKeep array. All header fields
that are keys in %HeaderKeep are suppressed.

*	The mail format I was working from had each message starting
with "^From\s+@isy:"; this followed by a message header terminated by
a blank line. It should be simple to change this for more general mail
formats.

*	The program takes a number of files as input parameters, scans
through them in order and writes them on standard output. For every
filename given, we look for a file with exactly that name. If that
does not exist we look for a file with that name, suffixed by ".Z". If
the compressed file exists, "zcat" is used to uncompress it.

*	I took the output of this program and fed it into "enscript" to
get a landscape, two-column output, like this
%raptus:mail {159} > stripmail.pl dig1.Z | enscript -2r -fCourier8 -L56

'nuff talk. Here it is:

-----Cut Here----
#! /usr/local/bin/perl
# stripmail.pl --- digest mail files

# The following header fields are not suppressed.
%HeaderKeep = ("From", 1, "Date", 1, "Subject", 1);

# Declare %HeaderSkip (!). Collects the names of the header fields
# that have been skipped.
undef %HeaderSkip;

#Lim1 and Lim2 are length limits; anything less than Lim1 lines are printed
#unconditionally; anything longer than Lim2 are skipped, unconditionally
$Lim1 = 150;
$Lim2 = 600;

if ($#ARGV < 0) {
    print STDERR "Usage: $0 filename\n";
    exit 1;
}

sub doFile {
    local ($file) = @_;
    local ($inheader) = 0;
    local ($_);
    local (@lines);
    local ($numline) = 0;
    local ($subject);
    if (! -e $file && -e "$file.Z") { # Use compressed file
	$file = "$file.Z";
    }
    if ($file =~ /\.Z$/) {
	open(INFILE, "zcat $file|") || die "Couldn't uncompress $file\n";
    }
    else {
	open(INFILE, "<$file") || die "Couldn't open $file (read)\n";
    }		   
    while (<INFILE>) {
	if (/^From\s+@isy:/) {	# Start of header/new message.
				# Change this for other mail formats
			      	# Process previous...
	    $numlines = scalar @lines; # lines in previous message
	    if ($numlines > $Lim1 && $numlines < $Lim2) {
		print STDERR "Subject $subject, length $numlines, print [n] ";
		$ans = <STDIN>;
	    }
	    if ($numlines <= $Lim1 || ($numlines < $Lim2 && $ans =~ /^[yY]/)) {
		while (@lines) {
		    print(shift @lines);
		}
	    }
	    else {
		print "Subject $subject, length $numlines, skipped\n";
		undef @lines;
	    }
	    $inheader = 1;
	    print "--------------------------------------------\n\n";
	}
	elsif ($inheader) {
	    if (/^$/) {		# blank line terminates header
				# Change this for other mail formats
		$inheader = 0;
		print "\n";
	    }
	    else {
		if (/^(\w+):\s*(.*)\s*$/) {
		    local ($kw, $val) = ($1, $2);
		    if ($kw eq "Subject") {
			$subject = $val;
		    }
		    if (defined $HeaderKeep{$kw}) {
			push(@lines, $_);
		    }
		    else {
			$HeaderSkip{$kw} = 1;
		    }
		}
	    }
	}
	else {
	    push(@lines, $_);
	}
    }
}

foreach (@ARGV) {
    do doFile($_);
}

print STDERR "Skipped header fields:\n";
foreach $hf (sort(keys %HeaderSkip)) {
    print STDERR "\t$hf\n";
}
----Cut Here----
--
Raymond A. Wiker    etnrwi@etn.ericsson.se
C programmers do it with side effects /
Machine code programmers take it to bits