From: Guilhem Moulin <guilhem@fripost.org>
Date: Wed, 29 Jul 2015 23:16:51 +0000 (+0200)
Subject: Add a $try parameter to create, delete, rename, etc.
X-Git-Url: https://git.g-eek.se/?a=commitdiff_plain;h=a76acfe7af03ea9087c3c063c315b52109c41f10;p=interimap.git

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.
---

diff --git a/imapsync b/imapsync
index 9bcc7b5..45b214f 100755
--- a/imapsync
+++ b/imapsync
@@ -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;
         }