XLIST, docHEADmaster

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;
 }