From 66b0682010cf24a4d2e92465dd57bcd795d21970 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Mon, 27 Jul 2015 22:02:17 +0200 Subject: No longer try to guess whether a mailbox was deleted or renamed. This was too error-prone. Instead, abort if a naming conflict occurs, and provide explicit commands --delete and --rename to delete or rename a mailbox. --- lib/Net/IMAP/Sync.pm | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'lib') diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 3216483..c1bccbf 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -520,11 +520,13 @@ sub create($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("CREATE ".quote($mailbox)); + $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; } sub delete($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; - #$self->_send("DELETE ".quote($mailbox)); + $self->_send("DELETE ".quote($mailbox)); + $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; delete $self->{_CACHE}->{$mailbox}; delete $self->{_PCACHE}->{$mailbox}; } @@ -533,12 +535,24 @@ sub delete($$) { # $self->rename($oldname, $newname) # RENAME the mailbox $oldname to $newname. Requires the 'read-only' # flag to be unset. +# /!\ Requires a LIST command to be issued to determine the hierarchy +# delimiter for the original name. sub rename($$$) { my ($self, $from, $to) = @_; + my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("RENAME ".quote($from).' '.quote($to)); + $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; $self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from}; $self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from}; + if (defined $delim) { + # on non-flat mailboxes, move children as well (cf 3501) + foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) { + my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r; + $self->{_CACHE}->{$c2} = delete $self->{_CACHE}->{$c1} if exists $self->{_CACHE}->{$c1}; + $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1}; + } + } } @@ -550,11 +564,13 @@ sub subscribe($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("SUBSCRIBE ".quote($mailbox)); + $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet}; } sub unsubscribe($$) { my ($self, $mailbox) = @_; $self->fail("Server is read-only.") if $self->{'read-only'}; $self->_send("UNSUBSCRIBE ".quote($mailbox)); + $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet}; } @@ -1456,6 +1472,7 @@ sub _resp($$;$$$) { $mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive undef $delim if uc $delim eq 'NIL'; $delim =~ s/\A"(.*)"\Z/$1/ if defined $delim; + $self->_update_cache_for($mailbox, DELIMITER => $delim); $callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST'; } elsif (s/\ASTATUS //) { -- cgit v1.2.3