From 1956ce125552752f61bbe8b578f00bd049b62512 Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 22:25:29 +0100
Subject: fix slurp(), useful for IDLE and NOTIFY.
---
lib/Net/IMAP/InterIMAP.pm | 31 +++++++++++++++----------------
1 file changed, 15 insertions(+), 16 deletions(-)
(limited to 'lib/Net/IMAP')
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 7af04e7..e3285de 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -22,7 +22,6 @@ use strict;
use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
use Config::Tiny ();
-use IO::Select ();
use Net::SSLeay ();
use List::Util qw/all first/;
use POSIX ':signal_h';
@@ -933,31 +932,31 @@ sub notify($@) {
my $command = 'NOTIFY ';
$command .= @_ ? ('SET '. join(' ', map {"($_ ($events))"} @_)) : 'NONE';
$self->_send($command);
- $self->{_SEL_OUT} = IO::Select::->new($self->{STDOUT});
}
-# $self->slurp()
+# $self->slurp([$cmd, $callback])
# 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;
-
+# command is progress, cf. RFC 2177 (IDLE) or RFC 5465 (NOTIFY).
+sub slurp($;$$) {
+ my ($self, $cmd, $callback) = @_;
my $ssl = $self->{_SSL};
my $read = 0;
+ vec(my $rin, fileno($self->{STDOUT}), 1) = 1;
while (1) {
- # Unprocessed data within the current TLS record would cause
- # select(2) to block/timeout due to the raw socket not being
- # ready.
- unless (defined $ssl and Net::SSLeay::pending($ssl) > 0) {
- my ($ok) = $self->{_SEL_OUT}->can_read(0);
- return $read unless defined $ok;
- }
- $self->_resp( $self->_getline() );
+ return $read unless
+ (defined $self->{_OUTBUF} and $self->{_OUTBUF} ne '') or
+ # Unprocessed data within the current TLS record would cause
+ # select(2) to block/timeout due to the raw socket not being
+ # ready.
+ (defined $ssl and Net::SSLeay::pending($ssl) > 0) or
+ select($rin, undef, undef, 0) > 0;
+ my $x = $self->_getline();
+ $self->_resp($x, $cmd, undef, $callback);
$read++;
}
}
@@ -2111,7 +2110,7 @@ sub _envelope($$) {
return \@envelope;
}
-# $self->_resp($buf, [$cmd, $callback] )
+# $self->_resp($buf, [$cmd, $set, $callback] )
# Parse an untagged response line or a continuation request line.
# (The trailing CRLF must be removed.) The internal cache is
# automatically updated when needed.
--
cgit v1.2.3