#! /usr/bin/perl
use strict;
use warnings;
use Time::Local;

# $debug = 0: do the job
# $debug = 1: do not delete anything, only print debug info
my $debug=1;

# Variables
my $flag_to_from; my $addr; my $message_age; 
my $query; my @lines; my $grep_options; my $count=0;

# Check used programs for existence
my ($mailq, $grep, $date, $postsuper) = &search_for_binaries('mailq','grep','date','postsuper');

# Parse commandline
&print_usage if scalar @ARGV != 2;
($flag_to_from,$addr,$message_age) = &parse_options (\@ARGV);

# compute timestamp before which we must delete messages
my $timestamp_to_delete = time-$message_age;

# print info for user before we do the job
print "\nTis script will  delete mails from queue with following paramerets:\n";
print "$flag_to_from: $addr\nOlder than: ",scalar(localtime($timestamp_to_delete)),"\n";
print "\nPress enter to process or <control>+c to abort\n";
<stdin>;

# set variables and get mailqueue entities
if ($flag_to_from eq "From") { $query='^(\w+).*\s+\d*\s(.+)\s+'.$addr; $grep_options = '-A2 -E'}
elsif ($flag_to_from eq "To") { $query='^\s+'.$addr; $grep_options = '-B2 -E' }
else { die "Something going wrong.."; }
@lines = `$mailq | $grep $grep_options \'$query\'`;

foreach my $line (@lines){
    chomp $line;
    # Find lines like (may be broken):
    # E56758823F   901099 Thu Oct 27 06:09:10  markswoman@cebol.us
    # EE31288357     4456 Thu Oct 27 09:27:38  MAILER-DAEMON
    if ( $line =~ /^(\w+)\s+\d+\s(.+)\s+([\S+\@\S+]+)/ ) { 
        my $message_id = $1;
        my $time_in_log = $2;
        my $timestamp_in_log = &date_to_timestamp($time_in_log);
        if ( $timestamp_in_log < $timestamp_to_delete ) {
            $count ++;
            print "$line\n";
            print "\tParsed as: $message_id\t $time_in_log\n" if $debug > 0;
            print "\tTimestamp in log:        $timestamp_in_log\n"  if $debug > 0;
            print "\tTimestamp before delete: $timestamp_to_delete\n" if $debug > 0;
            print "\tDifferences: ",$timestamp_in_log-$timestamp_to_delete,"\n" if $debug > 0;
            # In this line we do the real job!! 
            system "$postsuper -d $message_id" if $debug < 1;
        }
    }
}

print "Deleted $count messages\n";

exit;

#
# ====== Subroutines ========
#
sub parse_options {
    my @options = @{shift()};
    my $flag_to_from; my $addr; my $message_age;
    # parse <find-email-option>
    if ( $options[0] =~ /-f\=(.+)/ ) {$flag_to_from = "From"; $addr = $1;  }
    elsif ( $options[0] =~ /-t\=(.+)/ )  {$flag_to_from = "To"; $addr = $1;  }
    else { &print_usage; }
    # parse <age of email in seconds>
    if ( $options[1] =~ /^(\d+)$/ ) { $message_age = $1; }
    else { &print_usage; }

    return $flag_to_from,$addr,$message_age;
}

sub print_usage {
    print "Usage: ./clean_queue <find-email-option> <age of email in seconds>\n";
    print "Find-email-option:\n";
    print "\t-f=<form-addr>\n";
    print "\t-t=<to-addr>\n";
    print "Suggestions about age in seconds:\n";
    print "\t86400 sec = 1d; 43200 sec = 12h; 18000 sec = 5h; 3600 sec  = 1h; 300 sec = 5m\n";
    exit;
}

sub search_for_binaries {
    my @prog_path;
    my $prog_name;
    while  ( $prog_name = shift() ){
    push  (@prog_path, `which $prog_name` || die "cant find mailq $prog_name");
    }
    chomp (@prog_path);
    return @prog_path;
}

sub date_to_timestamp {
    # subroutine get date in format "Tue Oct 18 02:46:57 2016" and return epoch timestamp
    my $date_str=shift();
    my %months=( 'Jan'=>'01','Feb'=>'02','Mar'=>'03','Apr'=>'04','May'=>'05','Jun'=>'06','Jul'=>'07','Aug'=>'08','Sep'=>'09','Oct'=>'10','Nov'=>'11','Dec'=>'12' );
    my $year = `$date +%Y`;

    my @date_arr = split (' ', $date_str);
    my $mon = $date_arr[1];
    $mon = $months{$mon};
    my $mday = $date_arr[2];
    my ($hour, $min, $sec) = split (':', $date_arr[3]);
    my $timestamp=timelocal($sec, $min, $hour, $mday, $mon-1, $year) || die "Can't parse date: $date_str correct format is: Tue Oct 18 02:46:57 2016";
    return $timestamp;
}