diff options
author | Guilhem Moulin <guilhem@fripost.org> | 2015-07-30 01:16:51 +0200 |
---|---|---|
committer | Guilhem Moulin <guilhem@fripost.org> | 2015-07-30 01:27:08 +0200 |
commit | a76acfe7af03ea9087c3c063c315b52109c41f10 (patch) | |
tree | b21a869a746d41e12c4f42e0a1dc0a5db495ee4c | |
parent | 0c1aa3921e1736ab29caa9b77e62446c40d9214a (diff) |
Add a $try parameter to create, delete, rename, etc.
And no longer crash when trying to create a mailbox that already exists.
This could happen for instance if list-select-opts contains 'SUBSCRIBE'
and the mailbox is not subscribed on one side.
-rwxr-xr-x | imapsync | 4 | ||||
-rw-r--r-- | lib/Net/IMAP/Sync.pm | 90 |
2 files changed, 66 insertions, 28 deletions
@@ -471,7 +471,7 @@ my @MAILBOXES; } my $subscribed = mbx_subscribed('local', $mailbox); $STH_INSERT_MAILBOX->execute($mailbox, $subscribed); - $IMAP->{remote}->{client}->create($mailbox); + $IMAP->{remote}->{client}->create($mailbox, 1); $IMAP->{remote}->{client}->subscribe($mailbox) if $subscribed; $DBH->commit(); } @@ -483,7 +483,7 @@ my @MAILBOXES; } my $subscribed = mbx_subscribed('remote', $mailbox); $STH_INSERT_MAILBOX->execute($mailbox, $subscribed); - $IMAP->{local}->{client}->create($mailbox); + $IMAP->{local}->{client}->create($mailbox, 1); $IMAP->{local}->{client}->subscribe($mailbox) if $subscribed; $DBH->commit(); } diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 48f61c1..509ad5b 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -503,32 +503,47 @@ sub noop($) { } -# $self->create($mailbox) -# $self->delete($mailbox) +# $self->create($mailbox, [$try]) +# $self->delete($mailbox, [$try]) # CREATE or DELETE $mailbox. -sub create($$) { - my ($self, $mailbox) = @_; - $self->_send("CREATE ".quote($mailbox)); - $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; +# If try is set, print a warning but don't crash if the command fails. +sub create($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("CREATE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Created mailbox ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't create mailbox ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -sub delete($$) { - my ($self, $mailbox) = @_; - $self->_send("DELETE ".quote($mailbox)); - $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; +sub delete($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("DELETE ".quote($mailbox)); delete $self->{_CACHE}->{$mailbox}; delete $self->{_PCACHE}->{$mailbox}; + if ($IMAP_cond eq 'OK') { + $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't delete mailbox ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -# $self->rename($oldname, $newname) +# $self->rename($oldname, $newname, [$try]) # RENAME the mailbox $oldname to $newname. +# If $try is set, print a warning but don't crash if the command fails. # /!\ Requires a LIST command to be issued to determine the hierarchy # delimiter for the original name. -sub rename($$$) { - my ($self, $from, $to) = @_; +sub rename($$$;$) { + my ($self, $from, $to, $try) = @_; my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from}; - $self->_send("RENAME ".quote($from).' '.quote($to)); - $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; + my $r = $self->_send("RENAME ".quote($from).' '.quote($to)); $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) { @@ -539,21 +554,44 @@ sub rename($$$) { $self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1}; } } + if ($IMAP_cond eq 'OK') { + $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet}; + } + else { + my $msg = "Couldn't rename mailbox ".$from.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -# $self->subscribe($mailbox) -# $self->unsubscribe($mailbox) +# $self->subscribe($mailbox, [$try]) +# $self->unsubscribe($mailbox, [$try]) # SUBSCRIBE or UNSUBSCRIBE $mailbox. -sub subscribe($$) { - my ($self, $mailbox) = @_; - $self->_send("SUBSCRIBE ".quote($mailbox)); - $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet}; +# If $try is set, print a warning but don't crash if the command fails. +sub subscribe($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("SUBSCRIBE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Subscribe to ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't subscribe to ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } -sub unsubscribe($$) { - my ($self, $mailbox) = @_; - $self->_send("UNSUBSCRIBE ".quote($mailbox)); - $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet}; +sub unsubscribe($$;$) { + my ($self, $mailbox, $try) = @_; + my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox)); + if ($IMAP_cond eq 'OK') { + $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet}; + } + else { + my $msg = "Couldn't unsubscribe to ".$mailbox.': '.$IMAP_text; + $try ? $self->warn($msg) : $self->fail($msg); + } + return $r; } @@ -1149,7 +1187,7 @@ sub _send($$;&) { $IMAP_cond = $1; $IMAP_text = $1.' '.$x; $self->_resp_text($x); - $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK'; + $self->fail($IMAP_text) unless defined wantarray or $IMAP_cond eq 'OK'; $r = $1; last; } |