summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem.moulin@ens-lyon.org>2012-01-23 15:23:36 +0100
committerGuilhem Moulin <guilhem.moulin@ens-lyon.org>2012-01-23 15:23:36 +0100
commit3cacd98501cac6436f2247dcee91f83a55c40916 (patch)
tree8bddb3d22f7deb292a7df2c0cd51a0fe35b7f6c4
parentd55a5c24b28b1ea7c3c2cde6acd840e177caedb0 (diff)
XLIST, docHEADmaster
-rwxr-xr-ximapurge.pl41
1 files changed, 32 insertions, 9 deletions
diff --git a/imapurge.pl b/imapurge.pl
index df8c40e..fe12342 100755
--- a/imapurge.pl
+++ b/imapurge.pl
@@ -59,9 +59,18 @@ days) for each account; Seen and unflagged emails that are not drafts
and have been sent before the given value (for the server's time!) will
be deleted. Default value: 90.
+If the IMAP server you connect to implements the XLIST extension (such
+as GMail), the folders you choose via the fields I<only> and I<ignore>
+refer to either the alias or the actual folder names (C<Trash> versus
+C<[Gmail]/Trash>) for instance).
+
+On some IMAP servers, the messages marked as deleted and expunged are
+not immediately deleted, but archived for instance. Check out your
+settings then.
+
=head1 AUTHOR
-Copyright 2011 Guilhem Moulin. See the source for copying conditions.
+Copyright 2011-2012 Guilhem Moulin. See the source for copying conditions.
=cut
@@ -121,13 +130,27 @@ sub prune {
$maxdate = $client->Rfc3501_date(time-$maxdate);
# Browse in the folder list
- my @folders = $client->folders or die "Can't list folders: $@\n";
+ my $folders = $client->xlist_folders;
+ my @folders;
+ if (defined $folders) {
+ # XLIST extension is implemented
+ @folders = map {$folders->{$_}} (keys %$folders);
+ }
+ else {
+ @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}};
+ && grep {$_ eq $folder or (defined ($folders)
+ && exists ($folders->{$_})
+ && $folders->{$_} eq $folder)}
+ @{$config->{ignore}};
next if exists $config->{only}
- && not (grep {$_ eq $folder} @{$config->{only}});
+ && not (grep {$_ eq $folder or (defined ($folders)
+ && exists ($folders->{$_})
+ && $folders->{$_} eq $folder)}
+ @{$config->{only}});
# Explore the folder
if ($client->select($folder)) {
@@ -138,23 +161,23 @@ sub prune {
, 'SEEN' )
);
if (@msgs) {
- $count += $#msgs+1;
my $del = $client->delete_message(\@msgs)
or die "Can't delete messages: $@\n";
- warn " Folder `$folder': only $del/" .$#msgs+1
- ."messages have been deleted.\n"
+ warn " Folder `$folder': only $del/" .($#msgs+1).
+ " messages have been deleted.\n"
unless $del == $#msgs+1;
+ $count += $del;
}
else {
die "Can't search: $@\n" if $@;
}
# Unselect the folder & commit the changes on the server
- $client->close or die "Can't close: $@\n";
+ $client->close($folder) or die "Can't close: $@\n";
}
}
# Logout
- $client->logout();
+ $client->disconnect();
die "Can't logout: $@\n" unless $client->IsUnconnected;
return $count;
}