#!/usr/bin/perl -w
#
# popexpire:
# Expire messages more than n days old from a POP3 spool.
#
# Copyright (c) 2001 Chris Lightfoot. All rights reserved.
#

my $rcsid = '$Id: popexpire,v 1.1 2002/05/31 19:27:33 chris Exp $';

use Net::POP3;

$server = 'pop3.example.com';   # name of server with pop box
$user = 'fred';                 # name of user on same
$pass = 'secret';               # user's password
$days = 3;                      # age of youngest deleted message in days

# figure out cut-off day
@lt = localtime(time - $days * 3600 * 24);
($df, $mf, $yf) = @lt[3..5];
++$mf;
$yf += 1900;

$pop3 = new Net::POP3($server);
$pop3->login($user, $pass) or die "login: $!";

$msgs = $pop3->list();

%monmap = qw(jan 1 feb 2 mar 3 apr 4  may 5  jun 6
             jul 7 aug 8 sep 9 oct 10 nov 11 dec 12);

foreach (sort {int($a) <=> int($b)} keys(%$msgs)) {
    # obtain date of message
    $lines = $pop3->top($_, 0) or die "top($_, 0): $!";
    @D = grep { /^Date:/i } @$lines;
    my ($d, $m, $y) = $D[0] =~ /(\d+)\s+(Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec)[^\s]*\s+(\d+)/i;
    $m = $monmap{lc $m};
    $y += 2000 if ($y < 1900);
    if ($y < $yf || ($y == $yf && ($m < $mf || ($m == $mf & $d < $df)))) {
            push(@delete, $_);
    }
}

foreach (@delete) {
    $pop3->delete($_) or die "delete($_): $!";
}

$pop3->quit() or die "quit: $!";