#!/usr/bin/perl -w

################################################################################
#                                                                              #
# imap_folder_clean, v1.0                                                      #
#                                                                              #
# Fraser Gutteridge, blue@udel.edu   11/25/2012                                #
# University of Delaware Network & Systems Services                            #
#                                                                              #
# A script to clean out messages older than n days in a list                   #
# of specified mailboxes in an IMAP account.                                   #
#                                                                              #
################################################################################

use strict;
use Net::IMAP::Simple::SSL;
use Email::Simple;
use IO::Prompt;
use Date::Parse;
use Date::Simple ( 'today' );

###############################################################
# config vars default vals - change these to suit your config #
###############################################################

# IMAP server host
my $imap_host = "";

# if mail is older than today - n days, delete it
my $delete_older_than = 60;

# list of mail folders to clear - add any folders you want to clear old
# messages from
my @mail_folders = ( 'junkmail' );

###################
# end config vars #
###################

my $dot_time = str2time ( today ( ) - $delete_older_than );

print "Enter e-mail username: ";
chomp ( my $username =  );
die "You must enter a username!\n" unless $username;

my $password = prompt ( 'Enter e-mail password: ', -e => '*' );

my $imap_conn = Net::IMAP::Simple::SSL->new ( $imap_host );
die "Could not connect to $imap_host!\n" unless $imap_conn;

$imap_conn->login ( $username => $password );

my @boxes = $imap_conn->mailboxes;

foreach my $folder_name ( @mail_folders )
{
   my $emails_deleted = 0;

   print "Marking all messages more than $delete_older_than days old as deleted in folder $folder_name\n" .
         "This may take a few minutes...\n";

   my $total_messages = $imap_conn->select ( $folder_name );
   next if ! $total_messages;

   foreach my $i ( 1 .. $total_messages )
   {
      my $es = Email::Simple->new ( join '', @{ $imap_conn->top ( $i ) } );

      # get e-mail header date, format is: Sun, 22 Jul 2012 13:29:58 -0400 (EDT)
      my $email_time = str2time ( $es->header( 'Date' ) );

      if ( $email_time < $dot_time )
      {
         $imap_conn->delete ( $i );
      }
      else
      {
         last;
      }

      $emails_deleted++;
   }

   print "$emails_deleted messages marked as deleted in folder $folder_name\n";

   if ( $emails_deleted )
   {
      my $emails_expunged = $imap_conn->expunge_mailbox ( $folder_name );
      die $imap_conn->errstr if $imap_conn->waserr;

      print "$emails_expunged messages expunged out of $total_messages in folder $folder_name\n";
   }
}

$imap_conn->quit;