diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 33 | 
1 files changed, 18 insertions, 15 deletions
| diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index 73f55e8..45253c1 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -910,7 +910,7 @@ sub append($$@) {  # $self->fetch($set, $flags, [$callback])  #   Issue an UID FETCH command with the given UID $set, $flags, and  #   optional $callback. -sub fetch($$$$) { +sub fetch($$$;&) {      my ($self, $set, $flags, $callback) = @_;      $self->_send("UID FETCH $set $flags", $callback);  } @@ -938,14 +938,14 @@ sub notify($@) {  } -# $self->slurp([$cmd, $callback]) +# $self->slurp([$callback, $cmd])  #   See if the server has sent some unprocessed data; try to as many  #   lines as possible, process them, and return the number of lines  #   read.  #   This is mostly useful when waiting for notifications while no  #   command is progress, cf. RFC 2177 (IDLE) or RFC 5465 (NOTIFY). -sub slurp($;$$) { -    my ($self, $cmd, $callback) = @_; +sub slurp($;&$) { +    my ($self, $callback, $cmd) = @_;      my $ssl = $self->{_SSL};      my $read = 0; @@ -962,7 +962,7 @@ sub slurp($;$$) {              return $read if $r == 0; # nothing more to read          }          my $x = $self->_getline(); -        $self->_resp($x, $cmd, undef, $callback); +        $self->_resp($x, $callback, $cmd);          $read++;      }  } @@ -973,9 +973,10 @@ sub slurp($;$$) {  #   when the callback $stopwhen returns true.  #   Return false if the timeout was reached, and true if IDLE was  #   stopped due the callback. -sub idle($$$) { +sub idle($;$&) {      my ($self, $timeout, $stopwhen) = @_;      $timeout //= 1740; # 29 mins +    my $callback = sub() {$timeout = -1 if $stopwhen->()};      $self->fail("Server did not advertise IDLE (RFC 2177) capability.")          unless $self->_capable('IDLE'); @@ -984,14 +985,16 @@ sub idle($$$) {      $self->_cmd_flush();      for (; $timeout > 0; $timeout--) { -        $self->slurp('IDLE', sub() {$timeout = -1 if $stopwhen->()}); +        $self->slurp($callback, 'IDLE');          sleep 1 if $timeout > 0;      }      # done idling      $self->_cmd_extend('DONE');      $self->_cmd_flush(); -    $self->_recv($tag); +    # run the callback again to update the return value if we received +    # untagged responses between the DONE and the tagged response +    $self->_recv($tag, $callback, 'IDLE');      return $timeout < 0 ? 1 : 0;  } @@ -1161,7 +1164,7 @@ sub pull_updates($;$) {  } -# $self->pull_new_messages($callback, $attrs, @ignore) +# $self->pull_new_messages($attrs, $callback, @ignore)  #   FETCH new messages since the UIDNEXT found in the persistent cache  #   (or 1 in no such UIDNEXT is found), and process each response on the  #   fly with the callback. @@ -1171,7 +1174,7 @@ sub pull_updates($;$) {  #   Finally, update the UIDNEXT from the persistent cache to the value  #   found in the internal cache.  #   /!\ Use pull_updates afterwards to udpate the HIGHESTMODSEQ! -sub pull_new_messages($$$@) { +sub pull_new_messages($$&@) {      my $self = shift;      my $attrs = shift;      my $callback = shift; @@ -1921,7 +1924,7 @@ sub _send($$;&) {  #   provided, is used to process each untagged response.  $command and  #   $set can further limit the set of responses to apply the callback  #   to. -sub _recv($$;$&$) { +sub _recv($$;&$$) {      my ($self, $tag, $callback, $cmd, $set) = @_;      my $r; @@ -1937,7 +1940,7 @@ sub _recv($$;$&$) {              last;          }          else { -            $self->_resp($x, $cmd, $set, $callback); +            $self->_resp($x, $callback, $cmd, $set);          }      } @@ -2196,18 +2199,18 @@ sub _envelope($$) {      return \@envelope;  } -# $self->_resp($buf, [$cmd, $set, $callback] ) +# $self->_resp($buf, [$callback, $cmd, $set] )  #   Parse an untagged response line or a continuation request line.  #   (The trailing CRLF must be removed.)  The internal cache is  #   automatically updated when needed.  #   If a command and callback are given, the callback is be executed  #   for each (parsed) responses associated with the command. -sub _resp($$;$$$) { +sub _resp($$;&$$) {      my $self = shift;      local $_ = shift; +    my $callback = shift;      my $cmd = shift;      my $set = shift; -    my $callback = shift;      my $cache = $self->{_CACHE}->{$self->{_SELECTED}} if defined $self->{_SELECTED};      if (s/\A\* //) { | 
