#!/usr/sbin/perl -w
#---------#---------#---------#---------#---------#---------#---------#---------
# title
#   delete old e-mails
# author
#   s. lee henry
# description
#   The following script removes all mail that arrived before a specified
#   date. It relies on the regular format of email headers to determine
#   where a message starts and when the email arrived. If you're running
#   this script on a large number of files, then you might want to stop
#   your sendmail process while the script is running to avoid interfering
#   with the arrival of new messages.
#---------#---------#---------#---------#---------#---------#---------#---------

   if ($#ARGV != 2) {
           print "Usage: $0 <name> <month> <year>\n";
           exit;
   }
   $BOX=$ARGV[0];
   $MO=$ARGV[1];
   $YR=$ARGV[2];

   open(MBOX,"< /var/mail/$BOX") or die "No such mailbox\n";
   open(NEWBOX,"> /var/tmp/$BOX") or die "Cannot create temp file\n";

   $count=0;
   $print=0;

   while (<MBOX>) {
           if ($_ =~ /^From\s\S+@\S+\s\S+\s$MO\s\d+\s\d+:\d+:\d+\s$YR/) {
                   $print=1;
           }
           if ($print==1) {
                   print(NEWBOX);
   } else {
                   $count++;
           }
   }

   print "$count lines deleted\n";

   close MBOX;
   close NEWBOX;

   system("mv /var/tmp/$BOX /var/mail/$BOX");
   system("chown $BOX /var/mail/$BOX");
   system("ls -l /var/mail/$BOX");