Delete Spam from POP3 mailbox

My hosting provider, Digitalspace, uses My former hosting provider used SpamAssasin to help me filter spam. However, being unfamiliar with procmail and the like, I never got around to setting up something that automatically deleted spam from my inbox. Instead, I connect periodically to my POP3 account (using SSH) and manually delete messages tagged as spam.

Lately, however, I got really fed up with this process and decided to write a quick Perl script to do this on my behalf. If you can set it up, I suggest using SSH tunneling for all your communications with the POP3 server since POP3 is a clear text protocol. For Windows PCs you can use PuTTY for this purpose.

Please note that while I provide this script in the hopes that it will be useful to you, I make NO GUARANTEES OR WARRANTIES OF ANY KIND. The code is provided subject to the same terms as Perl itself. For more information, please refer to the Perl Artistic License.


use strict;
use warnings;

$| = 1;

use constant SEVERITY => 5;

use Mail::POP3Client;
use Term::ReadKey;

die "Provide user name\n" unless @ARGV;
my ($user) = @ARGV;

my $pop = Mail::POP3Client->new(HOST => '', PORT => 9999);

my $pass = prompt_password();
print "\n";

$pop->Connect or die $pop->Message;

my $count = $pop->Count;

$count >= 0 or die "Failed to get message count.\n";
$count >  0 or die "No messages in mailbox.\n";

print "Scanning messages:  ";

my $to_delete = 0;
for my $msg_num (1 .. $count) {
    my @headers = $pop->Head($msg_num);

    for my $h (@headers) {
        if($h =~ /^X-Spam-Level: (\*+)/) {
            if(SEVERITY <= scalar ($1 =~ tr/*/*/)) {
                $to_delete += 1;
                print "\b*>";
            } else {
                print "\b->";

print "\b ... done\n";

use Lingua::EN::Inflect qw( PL );

if( $to_delete ) {
    printf "%d %s will be deleted. Commit: [Y/N]?\n",
        $to_delete, PL('message', $to_delete);
    $pop->Reset unless confirm(qr/^Y/i, qr/^N/i);


print "OK\n";

sub yes {
    my ($ok_re, $cancel_re) = @_;
    while(my $r = <STDIN>) {
        return 1 if $r =~ $ok_re;
        last     if $r =~ $cancel_re;

sub prompt_password {
    print 'Password: ';
    ReadMode 2;
    my $pass = ReadLine 0;
    ReadMode 0;
    chomp $pass;
    return $pass;