|
Posted by Terry on February 1, 2006, 11:07 am
Please log in for more thread options
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
getmsg:
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
$_=$headers[$i];
# putting multi-line onto one.
if (/^\S+:/) {
#print "$j
$headers[$j]\n";
$j = $i;
}
else {
$headers[$j] .=
$headers[$i];
$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
if
(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
print
qq(Leaving msg $msgnum for "$rcpt\@$user" "$sj"\n);
$numLeft++;
next
getmsg; # skip if we want to keep it
}
}
print qq(Deleting msg
$msgnum for "$rcpt\@$user" "$sj"\n);
$pop->delete($msgnum);
# otherwise delete it
$numDeleted++;
next getmsg;
}
}
}
print "$numDeleted deleted, $numLeft left\n";
}
else {
print qq(No messages on the server\n);
}
$pop->quit();
}
else {
print "Error logging on to server $popserver\n";
}
}
else {
print "Error Connecting to $popserver, $!\n";
}
sleep 5;
|
|
Posted by Terry on February 1, 2006, 1:20 pm
Please log in for more thread options
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.
|
|
Posted by John Bokma on February 1, 2006, 3:48 pm
Please log in for more thread options
> 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.
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
groups).
--
John Small Perl scripts: http://johnbokma.com/perl/
Perl programmer available: http://castleamber.com/
I ploink googlegroups.com :-)
|
| Similar Threads | Posted | | Net::POP3 quit failing, cannot delete some spam email | August 31, 2004, 10:13 am |
| My Bank account EXPLODED | July 13, 2004, 11:07 am |
| [RFC] Finance::Accounts -- an abstraction above account-specific modules | July 6, 2006, 7:56 pm |
| FTP problem with delete | June 14, 2005, 12:22 pm |
| XML::XPath delete function | November 26, 2007, 3:35 pm |
| Error in delete file using NET:FTP module | February 10, 2006, 6:31 pm |
| Converting email | December 21, 2004, 6:14 pm |
| Attaching to an email | May 18, 2006, 5:59 pm |
| Email::Filter hello world | August 15, 2004, 3:36 pm |
| Manipulating ANY type of email | January 3, 2006, 5:03 pm |
|
XML Sitemap