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')

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