From 77fe969e15710e29f4e08dacdf7a4a7aa7f193a6 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem.moulin@ens-lyon.org>
Date: Wed, 26 Oct 2011 20:10:40 +0200
Subject: doc; don't delete flagged and unseen emails

---
 imapurge.pl | 101 +++++++++++++++++++++++++++++++++++++++++++++++++++---------
 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 => {
 #   ...
-- 
cgit v1.2.3