diff options
Diffstat (limited to 'lib/Net')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 9719de2..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 } @@ -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) : (); |