clipper@no30sun.csd.uwo.ca (Khun Yee Fung) (02/20/91)
Here is a perl script that I use to sort the messages I receive from
various mailing lists. There are a few problems that I have not
solved: 1, file locking might not be very good and I still don't know
a perfect solution for copying a file that might be modified midway;
2, if the file system is full, it will wait for 10 seconds for you to
attempt remedies, could not think of a better solution. There might be
other problems.
#!/usr2/new/bin/perl # -*-perl-*-
# copyright (c) 1990 Khun Yee Fung
#
# You can modify, distribute and otherwise do anything to this program
# provided that the copyright line is not deleted and this program is not
# sold for profit. NO WARRANTY, USE AT OWN RISK.
#
# A Mail eating program for users who subscribe to mailing-lists.
# In your home directory have a file called .eatmrc with the following
# format:
# <field><TAB><reg><TAB><mailbox>
# <field> : the header fields to search for the pattern. Each field
# should be separated by a '/'. E.g., Sender/From.
# <reg> : regular-expression to be matched in header part of the mail
# <TAB> : the tab character
# <mailbox> : the mailbox to store the message from the home directory
#
# The last line should be:
# *<TAB>*<TAB><mailbox>
# This is used for all the other cases
# My own .eatmrc (without the `#' character in front of a line, of
# course)
# Cc/From/Sender/To [iI]nfo-[aA]ndrew vm/andrew
# To Request-for-Comments-List vm/rfc
# Cc/From/Sender/To habs vm/habs
# Cc/From/Sender/To [iI]nfo-[gG]nus vm/gnus
# Cc/From/Sender/To [eE]poch vm/epoch
# Cc/From/Sender/To [gG]wm vm/gwm
# Cc/From/Sender/To [Cc]om-[Pp]riv /dev/null
# Cc/From/Sender/To [Ii]nfo-[gG]nuplot vm/gnuplot
# Cc/From/Sender/To perl-manual vm/perlman
# * * vm/inbox
#
# Notice that the first regular expression matched is considered.
$LOCK_UN = 8;
$LOCK_EX = 2;
@a = getpwuid($<);
$user = $a[0];
$USER = $a[7];
$mbox = "/usr/spool/mail/$user";
if (-z $mbox) {
print "No Mail\n";
exit 0;
}
open(RC, "$USER/.eatmrc") || die "Can't find init file for eatm:";
while ($_ = <RC>) {
$_ =~ s/[\t]+/\t/g;
@words = split(/\t/, $_, 3);
if ($#words != 2) {
print "Should have exactly three fields in .eatmrc\n";
exit(1);
}
@fields = split('/', $words[0]);
while ($#fields >= $[) {
push(@field, shift(@fields));
push(@reg, $words[1]);
if ($words[2] =~ m.^/.) {
push(@box, $words[2]);
}
else {
push(@box, "$USER/$words[2]");
}
}
}
close(RC);
if ($reg[$#reg] ne '*' || $field[$#reg] ne '*') {
print "Illegal last line in .eatmrc\n";
exit(1);
}
open(MBOX, "$mbox");
flock(MBOX, $LOCK_EX);
system("cp $mbox /tmp/$user.MBOX");
truncate($mbox, 0);
flock(MBOX, $LOCK_UN);
close(MBOX);
open(MBOX, "/tmp/$user.MBOX") || die "Somebody deleted your temp file";
$message = '';
$header = 1;
while ($_ = <MBOX>) {
if ($_ =~ /^From[^:]/) {
& printmessage();
undef(%header);
$head = $_;
chop($_);
($label, $body) = split(/[ \t]/, $_, 2);
$header{'FROM'} = $body;
$message = '';
$header = 1;
$last_field = 'FROM';
}
elsif ($header && $_ =~ /^\s$/) {
$header = 0;
}
elsif ($header) {
if ($_ =~ /^[ \t]/) {
$header{$last_field} .= $_;
}
else {
($label, $body) = split(/[ :]/, $_, 2);
$header{$label} .= $body;
}
$last_field = $label;
$head = $head . $_;
}
else {
$message .= $_;
}
}
&printmessage();
close(MBOX);
sub printmessage {
local($rsize) = 0;
local($match) = 0;
if ($head ne '') {
while($rsize <= $#reg - 1) {
if ($header{$field[$rsize]} =~ /$reg[$rsize]/) {
open(MFILE, ">>$box[$rsize]");
$match = 1;
}
$rsize++;
}
if (! $match) {
open(MFILE, ">>$box[$rsize]");
}
while (! (print MFILE $head, "\n", $message)) {
print "Can't write to mailbox\n";
print "Will wait 10 seconds\n";
sleep(10);
}
close(MFILE);
}
}
--
----
Khun Yee Fung clipper@csd.uwo.ca (Internet)
Alternative: 4054_3267@UWOVAX.BITNET
Department of Computer Science
Middlesex College
The University of Western Ontario
London, Ontario, N6A 5B7 CANADA