aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/IMAP')
-rw-r--r--lib/Net/IMAP/Sync.pm29
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 // '';