Merge branch 'master' into debiandebian/0.2-1

3 files changed, 49 insertions, 12 deletions

diff --git a/Changelog b/Changelog
index 8cd8be2..bc60b19 100644
--- a/Changelog
+++ b/Changelog
@@ -25,6 +25,10 @@ interimap (0.2) upstream;
   * Set X.509 certificate purpose to 'SSL Server' for SSL_verify=YES.
   * Display the certificate chain, SSL protocol and cipher in debug
     mode.
+  * Bug fix: don't delete the lockfile if another instance of interimap
+    is running.
+  * Display source UIDs upon APPEND.  Previously only target UIDs where
+    displayed in non-debug mode.
 
  -- Guilhem Moulin <guilhem@guilhem.org>  Wed, 09 Sep 2015 00:44:35 +0200
 
diff --git a/interimap b/interimap
index 54ae0aa..401bfa2 100755
--- a/interimap
+++ b/interimap
@@ -130,6 +130,7 @@ $SIG{TERM} = sub { cleanup(); exit 0; };
         close $lock;
         chomp $pid;
         my $msg = "LOCKFILE '$LOCKFILE' exists.";
+        undef $LOCKFILE; # don't delete the lockfile
         $msg .= " (Is PID $pid running?)" if defined $pid and $pid =~ /^[0-9]+$/;
         die $msg, "\n";
     }
@@ -276,7 +277,7 @@ foreach my $name (qw/local remote/) {
 #
 
 # Add a new mailbox to the database.
-my $STH_INSERT_MAILBOX= $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)});
+my $STH_INSERT_MAILBOX = $DBH->prepare(q{INSERT INTO mailboxes (mailbox,subscribed) VALUES (?,?)});
 
 # Get the index associated with a mailbox.
 my $STH_GET_INDEX = $DBH->prepare(q{SELECT idx,subscribed FROM mailboxes WHERE mailbox = ?});
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index d6c46a8..3a6481e 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -24,7 +24,7 @@ use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use IO::Select ();
 use Net::SSLeay ();
-use List::Util 'first';
+use List::Util qw/all first/;
 use POSIX ':signal_h';
 use Socket qw/SOCK_STREAM IPPROTO_TCP AF_INET AF_INET6 SOCK_RAW :addrinfo/;
 
@@ -117,10 +117,12 @@ sub read_config($$%) {
 }
 
 
-# compact_set(@set).
+# compact_set(@set)
+# compact_list(@set)
 #   Compact the UID or sequence number set @set, which must be
-#   non-empty and may not contain '*'.  (Duplicates are allowed, but
-#   are removed).
+#   non-empty and may not contain '*'.
+#   compact_set sorts the input UID list and removes duplicates, while
+#   compact_list doesn't.
 sub compact_set(@) {
     my @set = sort {$a <=> $b} @_;
     my $min = my $max = shift @set // die 'Empty range';
@@ -147,6 +149,28 @@ sub compact_set(@) {
     $set .= $min == $max ? $min : "$min:$max";
     return $set;
 }
+sub compact_list(@) {
+    my $min = my $max = shift // die 'Empty range';
+    my ($set, $dir);
+
+    while (@_) {
+        my $k = shift;
+        $dir //= $k < $max ? -1 : 1;
+        if ($k != $max and $k == $max + $dir) {
+            $max += $dir;
+        }
+        else {
+            $set .= ',' if defined $set;
+            $set .= $min == $max ? $min : "$min:$max";
+            $min = $max = $k;
+            undef $dir;
+        }
+    }
+
+    $set .= ',' if defined $set;
+    $set .= $min == $max ? $min : "$min:$max";
+    return $set;
+}
 
 
 # in_set($x, $set)
@@ -780,8 +804,8 @@ sub remove_message($@) {
     delete @{$self->{_MODIFIED}}{@expunged};
     $self->{_VANISHED} = [ keys %vanished ];
 
-    $self->log("Removed ".($#expunged+1)." message(s), ".
-               "UID ".compact_set(@expunged)) if @expunged and !$self->{quiet};
+    $self->log("Removed ".($#expunged+1)." UID(s) ".
+               compact_set(@expunged)) if @expunged and !$self->{quiet};
     $self->warn("Couldn't UID EXPUNGE ".compact_set(@failed)) if @failed;
     return @failed;
 }
@@ -791,10 +815,11 @@ sub remove_message($@) {
 #   Issue an APPEND command with the given mails.  Croak if the server
 #   did not advertise "UIDPLUS" (RFC 4315) in its CAPABILITY list.
 #   Each $mail is a hash reference with key 'RFC822' and optionally
-#   'FLAGS' and 'INTERNALDATE'.
+#   'UID', 'FLAGS' and 'INTERNALDATE'.
 #   Providing multiple mails is only allowed for servers supporting
 #   "MULTIAPPEND" (RFC 3502).
-#   Return the list of UIDs allocated for the new messages.
+#   Return the list of UIDs allocated for the new messages, in the order
+#   they were APPENDed.
 sub append($$@) {
     my $self = shift;
     my $mailbox = shift;
@@ -856,9 +881,16 @@ sub append($$@) {
     }
 
     unless ($self->{quiet}) {
-        my $msg = "Added ".($#_+1)." message(s)";
-        $msg .= " to $mailbox" unless defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED};
-        $msg .= ", got new UID ".compact_set(@uids);
+        my $msg = "Added ".($#_+1)." UID(s) ";
+        $msg .= "to $mailbox " unless defined $self->{_SELECTED} and $mailbox eq $self->{_SELECTED};
+        if (defined $self->{name} and all {defined $_->{UID}} @_) {
+            $msg .= $self->{name} eq 'local' ?
+                (compact_list(@uids) .' <- '. compact_list(map {$_->{UID}} @_)) :
+                (compact_list(map {$_->{UID}} @_) .' -> '. compact_list(@uids));
+        }
+        else {
+            $msg .= compact_list(@uids);
+        }
         $self->log($msg);
     }
     return @uids;