view release on metacpan or  search on metacpan

examples/filter.pl  view on Meta::CPAN

#!/usr/bin/perl -w

use strict;
use 5.005;

my $TMPDIR = $ENV{TMPDIR} || $ENV{TEMP} || '/usr/tmp';

# The default mailbox for delivery.
my $default = "/var/spool/mail/".getpwuid($>);

# A pattern to break out words in email names.
my $wordpat = qr/[-a-zA-Z0-9_.]+/;
my $wordpat_nodot = qr/[-a-zA-Z0-9_]+/;

# Destination for special emails.
sub incoming { $ENV{HOME}."/Mail/Incoming/".$_[0].".spool" }

# Destination for mailing lists.
sub maillist { incoming("maillists.".$_[0]) }

# Destination for SPAM.
sub spambox  { incoming("spam.".$_[0]) }

use Mail::Procmail;

################ The Process ################

eval { ################ BEGIN PROTECTED EXECUTION ################

# Setup Procmail module.
my $m_obj = pm_init ( logfile => 'stderr', loglevel => 3 );

# Init local values for often used headers.
my $m_from		    = pm_gethdr("from");
my $m_to		    = pm_gethdr("to");
my $m_cc		    = pm_gethdr("cc");
my $m_subject		    = pm_gethdr("subject");
my $m_sender		    = pm_gethdr("sender");
my $m_apparently_to	    = pm_gethdr("apparently-to");
my $m_resent_to		    = pm_gethdr("resent-to");
my $m_resent_cc		    = pm_gethdr("resent-cc");
my $m_resent_from	    = pm_gethdr("resent-from");
my $m_resent_sender	    = pm_gethdr("resent-sender");
my $m_apparently_resent_to  = pm_gethdr("apparently-resent-to");

my $m_header                = $m_obj->head->as_string || '';
my $m_lines		    = pm_body();
my $m_body                  = join("", @$m_lines);
my $m_size		    = length($m_body);

# These mimic procmail's TO and FROM patterns.
my $m_TO   = join("\n", $m_to, $m_cc, $m_apparently_to,
	                $m_resent_to, $m_resent_cc,
                        $m_apparently_resent_to);
my $m_FROM = join("\n", $m_from, $m_sender,
		        $m_resent_from, $m_resent_sender);

# Start logging.
pm_log(1, "Mail from $m_from");
pm_log(1, "To: $m_to");
pm_log(1, "Subject: $m_subject");

################ Get rid of some SPAMs ################

pm_ignore("Non-ASCII in subject")
  if $m_subject =~ /[\232-\355]{3}/;

pm_ignore("Bogus address: \@internet.sciurius.nl")
  if $m_TO =~ /\@internet.sciurius.nl/mi;