diff options
Diffstat (limited to 'lib/Net/IMAP')
-rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 54 |
1 files changed, 43 insertions, 11 deletions
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; |