#!/usr/bin/perl -w use Mail::IMAPClient; use IO::Socket::SSL;; use File::Spec::Functions qw /catfile/; use Env qw /HOME/; use strict; my $confile = catfile ($HOME, '.imapurge.rc'); die "Can't read `" .$confile. "'\n" unless -f $confile; my %accounts = do $confile; die "Error in `" .$confile. "'\n" if $@ || not %accounts; # Remotely delete mails that have been sent >90 days ago my $oldest = 90; # Account name => { # hostname => 'imap.example.com', # username => 'username', # password => '******', # ignore => [ 'folder1', 'folder2' ], # Optional (default: []) # only => [ 'folder3', 'folder4' ], # Optional (default: []) # oldest => 24 * 60 * 60 * 365 # Optional (default: $oldest) # } # # my $count = 0; while (my ($account,$config) = each %accounts) { my $n = &prune ($config); print $account, ": ", $n, "\n"; $count += $n; } print "-----------\n"; print "Total: $count emails have been deleted.\n"; sub prune { my $config = $_[0]; my $socket = IO::Socket::SSL->new( PeerAddr => $config->{hostname}, PeerPort => 993, ) or die "Can't create SSL socket: $@\n"; my $client = Mail::IMAPClient->new( Socket => $socket, User => $config->{username}, Password => $config->{password}, SSL => 1, Uid => 1, ) or die "Can't login: $@\n"; my $maxdate = $oldest; $maxdate = $config->{oldest} if exists $config->{oldest}; $maxdate *= 24 * 60 * 60; # Convert seconds to days $maxdate = $client->Rfc3501_date(time-$maxdate); my $count = 0; my @folders = $client->folders or die "Can't list folders: $@\n"; foreach my $folder (@folders) { next if exists $config->{ignore} && grep {$_ eq $folder} @{$config->{ignore}}; next if exists $config->{only} && not (grep {$_ eq $folder} @{$config->{only}}); if ($client->select($folder)) { my @msgs = $client->sentbefore($maxdate); if (@msgs) { $count += $#msgs; my $del = $client->delete_message(\@msgs) or die "Can't delete messages: $@\n"; warn " Folder `$folder': only $del message deleted, out of $#msgs\n" unless $del == $#msgs+1; } $client->close or die "Can't close: $@\n"; } } $client->logout() or die "Can't logout: $@\n"; return $count; }