1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
#!/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 messages deleted, out of $#msgs\n"
unless $del == $#msgs+1;
}
$client->close or die "Can't close: $@\n";
}
}
$client->logout();
die "Can't logout: $@\n" unless $client->IsUnconnected;
return $count;
}
|