Script to delete email from an account

Do you have a question? Post it now! No Registration Necessary.  Now with pictures!

Threaded View

I went searching for a script that will delete emails in one of my user
accounts.  I found the script below.  I set it up as a crons job, which
seems to be running fine.  It connects to the user account, reads the
number of  messages but doesn't delete any messages.  Perl is not a
language that  I am familiar with.   I did  spend time looking at the
script and to me it should be deleting the email messages.  I was
hoping someone here could look at it and tell me why it is not working.
 Thanks in Advance.

# ! /usr/bin/perl -w
use strict;
use warnings;

use Net::POP3;

my ($popserver, $user, $pass, $maxmsg, @validusers);
my ($numDeleted,$numLeft) = (0,0);
my $pop;

#       run control parameters - should be in a separate file
$popserver = 'mail.anyaddress.usa';        #  pop3 server address
$user='info@anyaddress.usa';                           #  enter your
pop3 username
$pass='XXXXXXXXXX';                           #  and password here
$maxmsg=100;                                            #  number of
messages to process in a single batch
@validusers = qw(postmaster webmaster);
#  names NOT to delete messages for
#    - enter with a space between. eg: qw(bob andy terry)
#--------- end parameters.

print "connecting to server $popserver..\n";
if ($pop = Net::POP3->new($popserver,Debug=>0)) {
        print qq(Connected. Logging on as $user\n);
        if (my $msgcnt = $pop->login($user,$pass)) {
                if ($msgcnt > 0) {
                        print "$msgcnt messages....\n";
                        $msgcnt = $maxmsg if $msgcnt > $maxmsg;  #
limit to just the max I have set
                        for my $msgnum (1..$msgcnt){
                                my ($hdr) = $pop->top($msgnum,0);
                                my @headers = (@$hdr);
                                my $nh = $#headers;
                                my $j=0;
                                for my $i (0..$#headers) {           #
loop through the headers
                 # putting multi-line onto one.
                                        if (/^\S+:/) {
                                                #print "$j
                                                $j = $i;
                                        else {
                                                $headers[$j] .=
                                                $headers[$i] = "";

                                        $headers[$j] =~ s/\s+/ /g;
 # remove multiple spaces
                                        $headers[$j] =~ s/(^ )|( $)//g;
 # remove leading/trailing space
                                for(@headers) {print "$_\n";}

                                my $sj = "";
                                my @sjhdr = grep(/^Subject:/,
@headers); # get the Subject Header
                                if ( exists $sjhdr[0] && $sjhdr[0] =~
m/(^Subject: +)(.+)/ ) {
                                        $sj=  substr($2,0,40);
                               # print "$nh headers!\n";
                                my @rechdr = grep(/^Received:/,
@headers);                      # scan the received
                                for (@rechdr) {
                                                # header for the
(m/(^Received:.+for\s+)(.+)(\@$user)/) {     # envelope addressee
                                                my $rcpt = $2;

                                                for (@validusers) {
                # check this recipient against
                                                       if (lc($rcpt) eq
$_){           # our list of valid users
qq(Leaving msg $msgnum for "$rcpt\@$user" "$sj"\n);

getmsg;                    # skip if we want to keep it

                                                print qq(Deleting msg
$msgnum for "$rcpt\@$user" "$sj"\n);
             # otherwise delete it
                                                next getmsg;
                        print "$numDeleted deleted, $numLeft left\n";
                else {
                        print qq(No messages on the server\n);
        else {
                print "Error logging on to server $popserver\n";
else {
        print "Error Connecting to $popserver, $!\n";
sleep 5;

Re: Script to delete email from an account

I just realized I posted this in Perl Modules.  I meant to post this in
Perl Misc.  I'm going to cross post it in Perl Misc.

Sorry for the inconvience.

Re: Script to delete email from an account

Quoted text here. Click to load it

You mean multipost (which is often a bad thing), since you can't crosspost
the message after it has been posted (ok, you can quote it and add

John                   Small Perl scripts:
               Perl programmer available:
                                        I ploink :-)

Site Timeline