Delete all but the most recent 10000 messages from IMAP folders

imaplevel.pl

#!/usr/bin/perl -w
use strict;
use diagnostics;
use Mail::IMAPClient;
use Getopt::Std;

my $imap_host = 'localhost';
my $imap_user = 'martin';
my $imap_pass = 'denkste';
my $imaplevel = 10000;
my @mailboxes = qw(
	Mailinglisten.Amavis-Users
	Mailinglisten.ClamAV-Updates
	Mailinglisten.Courier-IMAP
	Mailinglisten.Enigmail
	Mailinglisten.Full-Disclosure
	Mailinglisten.Postfix-Users
	Mailinglisten.Postfixbuch-Users
	Mailinglisten.OpenBSD-Misc
	Mailinglisten.Shorewall-Devel
	Mailinglisten.Shorewall-Users
	Mailinglisten.Wireshark-Users
	);

my %opts;
getopts('y', \%opts);

my $dryrun = 1;
if ($opts{'y'}){
	$dryrun = 0;
}else{
	print "Dry run. Use -y to actually delete anything.\n";
	sleep 1;
}

my $imap = Mail::IMAPClient->new(
	Server     => $imap_host,
	User       => $imap_user,
	Password   => $imap_pass
) or die "Can't connect to localhost as $imap_user: $@\n";

foreach my $mailbox(@mailboxes){
	print "\nMailbox: $mailbox\n";
	sleep 1;
	$imap->select($mailbox) or die "Could not select $mailbox: $@\n";;
	my @ids = $imap->search('ALL');
	my @kept;
	my @deleted;
	my $progress = 0;
	foreach my $id (reverse sort {$a <=> $b} @ids){
		my $date = $imap->get_header($id,"Date");
		if (@kept <= $imaplevel){
			print "Keep: $id, $date\n";
			push @kept, $id;
		}else{
			print "Delete: $id, $date\n";
			$imap->delete_message($id) unless $dryrun;
			push @deleted, $id;
			$progress++;
			if ($progress % 100 == 0){
				print "Expunge\n";
				$imap->expunge() unless $dryrun;
			}
		}
	}
	$imap->expunge() unless $dryrun;
}