From 3cacd98501cac6436f2247dcee91f83a55c40916 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 23 Jan 2012 15:23:36 +0100 Subject: XLIST, doc --- imapurge.pl | 41 ++++++++++++++++++++++++++++++++--------- 1 file 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 and I +refer to either the alias or the actual folder names (C 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; } -- cgit v1.2.3