diff options
| -rw-r--r-- | lib/Net/IMAP/Sync.pm | 29 |
1 files changed, 21 insertions, 8 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index 6c4b8a3..7c76996 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -21,6 +21,7 @@ use warnings; use strict; use Config::Tiny (); +use IO::Select (); use List::Util 'first'; use Socket 'SO_KEEPALIVE'; @@ -709,24 +710,35 @@ sub notify($@) { my $command = 'NOTIFY '; $command .= @_ ? ('SET '. join(' ', map {"($_ ($events))"} @_)) : 'NONE'; $self->_send($command); + $self->{_SEL_OUT} = IO::Select::->new($self->{STDOUT}); } # $self->slurp() -# Turn on non-blocking IO, try to as many lines as possible, then turn -# non-blocking IO back off and return the number of lines read. +# 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 5465 (NOTIFY). sub slurp($) { my $self = shift; + + my $stdout = $self->{STDOUT}; my $read = 0; - $self->{STDOUT}->blocking(0) // $self->panic("Can't turn on non-blocking IO: $!"); - while (defined (my $x = $self->_getline())) { - $self->_resp($x); - $read++ + + while (1) { + # Unprocessed data within the current SSL frame would cause + # select(2) to block/timeout due to the raw socket not being + # ready. + unless (ref $stdout eq 'IO::Socket::SSL' and $stdout->pending() > 0) { + my $sel = IO::Select::->new($stdout); + my ($ok) = $self->{_SEL_OUT}->can_read(0); + return $read unless defined $ok; + } + + $self->_resp( $self->_getline() ); + $read++; } - $self->{STDOUT}->blocking(1) // $self->panic("Can't turn off non-blocking IO: $!"); - return $read; } @@ -1039,6 +1051,7 @@ sub _fingerprint_match($$$) { # $self->_getline([$msg]) # Read a line from the handle and strip the trailing CRLF. +# /!\ Don't use this method with non-blocking IO! sub _getline($;$) { my $self = shift; my $msg = shift // ''; |