Add support for untagged ESEARCH responses from RFC 4731.

diff --git a/Changelog b/Changelog
index 74b36fb457d726a2b195c3983fec54a7d7227e93..f2fee83f70e1e98084202b762b499d8ed80e7f96 100644 (file)
--- a/Changelog
+++ b/Changelog
@@ -4,6 +4,7 @@ interimap (0.4) UNRELEASED
     (received by the IMAP FETCH ENVELOPE command) by the null sender address
     <>.
   + Library: new API idle_start() and idle_stop().
+  + Add support for untagged ESEARCH responses from RFC 4731.
   - Ensure the lower bound of UID ranges is at least 1.
   - Fix manpage generation with pandoc >=2.1.
 

diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 9719de26c042bbfd7d3b7450c94e9ce050d5468a..4a9ffd9017402707f886b92eaffc35676c4e2ecc 100644 (file)
--- 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
 }
 
@@ -1942,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);
     }
 }
@@ -2283,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) : ();