diff options
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 24 |
1 files changed, 15 insertions, 9 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm index e7a86aa..d2bb130 100644 --- a/lib/Net/IMAP/InterIMAP.pm +++ b/lib/Net/IMAP/InterIMAP.pm @@ -931,14 +931,14 @@ sub notify($@) { } -# $self->slurp([$callback, $cmd]) +# $self->slurp([$callback, $cmd, $timeout]) # 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, $callback, $cmd) = @_; +sub slurp($;&$$) { + my ($self, $callback, $cmd, $timeout) = @_; my $ssl = $self->{_SSL}; my $read = 0; @@ -949,10 +949,11 @@ sub slurp($;&$) { # cause select(2) to block/timeout due to the raw socket # not being ready. (defined $ssl and Net::SSLeay::pending($ssl) > 0)) { - my $r = CORE::select($rin, undef, undef, 0); + my $r = CORE::select($rin, undef, undef, $timeout // 0); next if $r == -1 and $! == EINTR; # select(2) was interrupted $self->panic("Can't select: $!") if $r == -1; return $read if $r == 0; # nothing more to read + $timeout = 0; # don't wait during the next select(2) calls } my $x = $self->_getline(); $self->_resp($x, $callback, $cmd); @@ -969,7 +970,7 @@ sub slurp($;&$) { sub idle($;$&) { my ($self, $timeout, $stopwhen) = @_; $timeout //= 1740; # 29 mins - my $callback = sub() {$timeout = -1 if $stopwhen->()}; + my $callback = sub() {undef $timeout if $stopwhen->()}; $self->fail("Server did not advertise IDLE (RFC 2177) capability.") unless $self->_capable('IDLE'); @@ -977,9 +978,14 @@ sub idle($;$&) { my $tag = $self->_cmd_init('IDLE'); $self->_cmd_flush(); - for (; $timeout > 0; $timeout--) { - $self->slurp($callback, 'IDLE'); - sleep 1 if $timeout > 0; + for (my $now = time;;) { + $self->slurp($callback, 'IDLE', 1); + last unless defined $timeout; + my $delta = time - $now; + $timeout -= $delta; + # quit idling when a time jump of at least 30s is detected + last if $timeout <= 0 or $delta >= 30; + $now += $delta; } # done idling @@ -989,7 +995,7 @@ sub idle($;$&) { # untagged responses between the DONE and the tagged response $self->_recv($tag, $callback, 'IDLE'); - return $timeout < 0 ? 1 : 0; + return (defined $timeout) ? 0 : 1; } |