#!/usr/bin/perl -w
#by Torben Menke
#http://www.entorb.net
# 2008-02-29
# Script for scaning emails for keywords
# The emails are piped through this script
# The result is printed to the top of the body of the message
# Works with multipart messages, the result is printed to the top of the first part

# TODO:
# multipart mails: check only text parts, skip binary parts?

use strict;
use warnings;
use Data::Dumper;

# search is not case-sensetive
my @keywords = qw(
Pattensen
Winsen
Faslam
Ubuntu
Joomla
StudiVZ
Facebook
XING
OpenBC
LinkedIn
Photovoltaik
Nanopartikel
Nanoparticle
Nanaokristall
);

my %hits;
my @cont = <>; # read the full email
my @header = ();
my @body = ();
my $i;
my $s;

# get header of email
# stop at first empty line
while (my $line = shift @cont){
push @header,$line;
if ($line eq "$/") {
last;
}
}

# check for multipart messages:
# Content-Type: multipart/mixed;
# boundary="----=_NextPart_000_0009_01C878C3.7A3D1B40"
my $multipartboundary;
$s = join '',@header;
if ($s =~ m/Content-Type:\s*multipart\S*\s*boundary="([^"]+)"/) {
$multipartboundary = $1;
# 1. shift @cont -> @header until line contains the boundary
# 2. shift @cont -> @header until line is empty
my $found_boundary = 0;
my $found_empty = 0;
while ($found_empty == 0 and my $line = shift @cont){
push @header,$line;
if ($line =~ /$multipartboundary/) {
$found_boundary ++;
}
if ($found_boundary > 0 and $line eq "$/" ) {
$found_empty ++;
}
}
}

@body = @cont
and undef (@cont);

# search for the keywords
my $searchstr = '('.join ('|',@keywords).')';
foreach my $line (@body) {
if ($line =~ m/$searchstr/i) {
$hits{"\L$1\E"} ++ ; # lowercase
}
}

# add '!!!' to subject
if (keys(%hits)) {
foreach my $line (@header) {
if ($line =~ m/^Subject: /) {
$line =~ s/(Subject: )/$1!!!/;
last;
}
}
}
print @header;

# print search result
if (keys(%hits)) {
print "o------\n";
print "my eMail-Keyword-Search found:\n";
foreach my $key (keys %hits) {
print "$hits{$key} x $key\n";
}
print "o------\n\n";
}

# print the email
print @body;

# underline the search word in the mail
# if ($line=~/(testwort)/) {
# $line =~ s/($1)/__$1__/g;
# }

---

Hope you found what you where looking for. Feel free to drop me a line
Torben