Merge branch 'master' into debian

1 files changed, 46 insertions, 10 deletions

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 6f148b7..4a9ffd9 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -594,12 +594,15 @@ sub incapable($@) {
 
 
 # $self->search($criterion)
-#   Issue an UID SEARCH command with the given $criterion.  Return the
-#   list of matching UIDs.
+#   Issue an UID SEARCH command with the given $criterion.  For the "normal"
+#   UID SEARCH command from RFC 3501, return the list of matching UIDs;
+#   for the extended UID SEARCH command from RFC 4731 (ensuring ESEARCH
+#   capability is the caller's responsibility), return an "UID"
+#   indicator followed by a hash containing search data pairs.
 sub search($$) {
     my ($self, $crit) = @_;
     my @res;
-    $self->_send('UID SEARCH '.$crit, sub(@) {push @res, @_});
+    $self->_send('UID SEARCH '.$crit, sub(@) {@res = @_});
     return @res
 }
 
@@ -959,14 +962,15 @@ sub slurp($$$) {
 
         foreach my $imap (@ready) {
             my $x = $imap->_getline();
-            $imap->_resp($x, sub($) {
-                if ($stopwhen->($imap, shift)) {
+            $imap->_resp($x, sub($;$$) {
+                if ($stopwhen->(@_)) {
                     $aborted = 1;
                     $timeout = 0; # keep reading the handles while there is pending data
                 }
             }, 'slurp');
         }
     }
+    return $aborted;
 }
 
 
@@ -977,20 +981,39 @@ sub slurp($$$) {
 #   after the $timeout) and false otherwise.
 sub idle($$$) {
     my ($self, $timeout, $stopwhen) = @_;
+    my $tag = $self->idle_start($timeout);
+    my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins
+    $r += $self->idle_stop($tag, $stopwhen);
+    return $r;
+}
 
+# $self->idle_start()
+#   Enter IDLE (RFC 2177).
+#   Return the command tag.
+sub idle_start($) {
+    my $self = shift;
     $self->fail("Server did not advertise IDLE (RFC 2177) capability.")
         unless $self->_capable('IDLE');
 
     my $tag = $self->_cmd_init('IDLE');
     $self->_cmd_flush();
-    my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins
+    return $tag;
+}
+
+# $self->idle_stop($tag, $callback)
+#   Stop a running IDLE (RFC 2177) command $tag.
+#   Returns the number of untagged responses received between the DONE
+#   the tagged response that are satisfying $callback.
+sub idle_stop($$$) {
+    my ($self, $tag, $callback) = @_;
+    my $r = 0;
 
     # done idling
     $self->_cmd_extend('DONE');
     $self->_cmd_flush();
     # run the callback again to update the return value if we received
     # untagged responses between the DONE and the tagged response
-    $self->_recv($tag, sub($) { $r = 1 if $stopwhen->($self, shift) }, 'slurp');
+    $self->_recv($tag, sub($;$$) { $r++ if $callback->($self, @_) }, 'slurp');
 
     return $r;
 }
@@ -1922,7 +1945,9 @@ sub _send($$;&) {
         $self->_recv($tag, undef, $cmd);
     }
     else {
-        my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1 : undef;
+        my $set = $$command =~ /\AUID (?:FETCH|STORE) ([0-9:,*]+)/ ? $1
+                : $$command =~ /\AUID SEARCH / ? "\"$tag\"" # RFC 4466's tag-string
+                : undef;
         $self->_recv($tag, $callback, $cmd, $set);
     }
 }
@@ -2247,7 +2272,7 @@ sub _resp($$;&$$) {
                 $self->{_NEW} += $1 - $cache->{EXISTS} if $1 > $cache->{EXISTS}; # new mails
             }
             $cache->{EXISTS} = $1;
-            $callback->($self->{_SELECTED} // $self->panic()) if defined $callback and $cmd eq 'slurp';
+            $callback->($self->{_SELECTED} // $self->panic(), EXISTS => $1) if defined $callback and $cmd eq 'slurp';
         }
         elsif (/\A([0-9]+) EXPUNGE\z/) {
             $self->panic() unless defined $cache->{EXISTS}; # sanity check
@@ -2263,6 +2288,17 @@ sub _resp($$;&$$) {
         elsif (/\ASEARCH((?: [0-9]+)*)\z/) {
             $callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH';
         }
+        elsif (s/\AESEARCH \(TAG \Q$set\E\)( UID)?//) {
+            my $uid = $1;
+            my %ret; # RFC 4731
+            while ($_ ne '') {
+                $self->fail("RFC 4731 violation in ESEARCH response")
+                    # XXX RFC 4466's tagged-ext-comp unsupported
+                    unless s/\A ($RE_ATOM_CHAR+) ([0-9,:]+)//;
+                $ret{uc $1} = $2;
+            }
+            $callback->($uid, %ret) if defined $callback and $cmd eq 'SEARCH';
+        }
         elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) {
             my ($delim, $attrs) = ($2, $1);
             my @attrs = defined $attrs ? split(/ /, $attrs) : ();
@@ -2340,7 +2376,7 @@ sub _resp($$;&$$) {
                 if ($cmd eq 'FETCH' or $cmd eq 'STORE') {
                     $callback->(\%mail) if defined $uid and in_set($uid, $set);
                 } elsif ($cmd eq 'slurp') {
-                    $callback->($self->{_SELECTED} // $self->panic())
+                    $callback->($self->{_SELECTED} // $self->panic(), FETCH => $seq)
                 }
             }
         }