summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-ximapurge.pl101
-rw-r--r--imapurge.rc2
2 files changed, 88 insertions, 15 deletions
diff --git a/imapurge.pl b/imapurge.pl
index d23f1a1..7beb0c1 100755
--- a/imapurge.pl
+++ b/imapurge.pl
@@ -1,11 +1,79 @@
#!/usr/bin/perl -w
+# This program is free software. It comes without any warranty, to the
+# extent permitted by applicable law. You can redistribute it and/or
+# modify it under the terms of the Do What The Fuck You Want To Public
+# License, Version 2, as published by Sam Hocevar.
+# See http://sam.zoy.org/wtfpl/COPYING for more details.
+
+
+use Pod::Usage;
use Mail::IMAPClient;
use IO::Socket::SSL;;
use File::Spec::Functions qw /catfile/;
use Env qw /HOME/;
use strict;
+
+=head1 NAME
+
+imapurge.pl - Prune your email accounts
+
+=head1 SYNOPSIS
+
+B<imapurge.pl>
+
+=head1 DESCRIPTION
+
+B<IMAPurge> cleans up your accounts from old seen and unflagged emails. It
+connects on the IMAP servers via SSL on port 993.
+
+=head1 CONFIGURATION
+
+B<IMAPurge> reads its configuration from the file I<$HOME/.imapurge.rc>.
+This file has to be the content of a Perl hash e.g.,
+
+=over 4
+
+account1 => {
+ hostname => 'imap.example.com',
+ username => 'username',
+ password => '******',
+ ignore => [ 'folder1', 'folder2' ],
+ only => [ 'folder3', 'folder4' ],
+ oldest => 90
+},
+ account2 => {
+ ...
+}
+
+=back
+
+The fields I<hostname>, I<username>, and I<password> are required, while
+I<ignore>, I<only>, and I<oldest> are optional.
+
+If you wish to to filter away some folders, you can fill in the field
+I<ignore>. If on the other hand you want to only clean up some folders (hence
+ignore all the others), you can fill in the field I<only>. The default
+behavior is to explore all the folders on the server.
+
+By setting the field I<oldest>, you can also define a time limit (in
+days) for each account; Seen and unflagged emails that have been sent
+before the given value (for the server's time!) will be deleted. Default
+value: 90.
+
+=head1 AUTHOR
+
+Copyright 2011 Guilhem Moulin. See the source for copying conditions.
+
+=cut
+
+
+
+pod2usage(-exitstatus => 0, -verbose => 2) if @ARGV && $ARGV[0] eq '--man';
+pod2usage(2) if @ARGV;
+
+
my $confile = catfile ($HOME, '.imapurge.rc');
die "Can't read `" .$confile. "'\n" unless -f $confile;
my %accounts = do $confile;
@@ -15,16 +83,6 @@ 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;
@@ -37,11 +95,14 @@ print "-----------\n";
print "Total: $count emails have been deleted.\n";
+#######################################################################
+# Prune the given account
sub prune {
my $config = $_[0];
+ # Create the SSL socket and login to the server
my $socket = IO::Socket::SSL->new(
PeerAddr => $config->{hostname},
PeerPort => 993,
@@ -54,34 +115,46 @@ sub prune {
SSL => 1,
Uid => 1,
) or die "Can't login: $@\n";
+ my $count = 0;
+ # I'll delete the emails that have a date < $maxdate (on the server)
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;
+ # Browse in the folder list
my @folders = $client->folders or die "Can't list folders: $@\n";
-
foreach my $folder (@folders) {
+ # Filter on the (manually set) 'ignore' & 'only' lists
next if exists $config->{ignore}
&& grep {$_ eq $folder} @{$config->{ignore}};
next if exists $config->{only}
&& not (grep {$_ eq $folder} @{$config->{only}});
+ # Explore the folder
if ($client->select($folder)) {
- my @msgs = $client->sentbefore($maxdate);
+ # Search the mails
+ my @msgs = $client->search( \( 'SENTBEFORE', $maxdate
+ , 'UNFLAGGED'
+ , 'SEEN' )
+ );
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"
+ warn " Folder `$folder': only $del/$#msgs messages have been deleted.\n"
unless $del == $#msgs+1;
}
+ else {
+ die "Can't search: $@\n" if $@;
+ }
+ # Unselect the folder & commit the changes on the server
$client->close or die "Can't close: $@\n";
}
}
+ # Logout
$client->logout();
die "Can't logout: $@\n" unless $client->IsUnconnected;
return $count;
diff --git a/imapurge.rc b/imapurge.rc
index 840dc67..d308f14 100644
--- a/imapurge.rc
+++ b/imapurge.rc
@@ -10,7 +10,7 @@
# password => '******',
# ignore => [ 'folder1', 'folder2' ], # Optional (default: [])
# only => [ 'folder3', 'folder4' ], # Optional (default: all)
-# oldest => 90 # Optional (default: $oldest) (the unit is days)
+# oldest => 90 # Optional (default: 90; the unit is days)
# },
# account2 => {
# ...