diff options
| -rw-r--r-- | Changelog | 1 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 32 |
2 files changed, 27 insertions, 6 deletions
@@ -3,6 +3,7 @@ interimap (0.4) UNRELEASED * pullimap: replace non RFC 5321-compliant envelope sender addresses (received by the IMAP FETCH ENVELOPE command) by the null sender address <>. + + Library: new API idle_start() and idle_stop(). - 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 6f148b7..9719de2 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -959,14 +959,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 +978,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; } @@ -2247,7 +2267,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 @@ -2340,7 +2360,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) } } } |