diff options
| -rwxr-xr-x | imapurge.pl | 101 | ||||
| -rw-r--r-- | imapurge.rc | 2 |
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 => { # ... |