diff options
| -rw-r--r-- | Changelog | 4 | ||||
| -rwxr-xr-x | interimap | 3 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 54 | 
3 files changed, 49 insertions, 12 deletions
@@ -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 @@ -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;  | 
