From: Guilhem Moulin <guilhem@fripost.org>
Date: Thu, 3 Mar 2016 21:25:29 +0000 (+0100)
Subject: fix slurp(), useful for IDLE and NOTIFY.
X-Git-Url: https://git.g-eek.se/?a=commitdiff_plain;h=1956ce125552752f61bbe8b578f00bd049b62512;p=interimap.git

fix slurp(), useful for IDLE and NOTIFY.
---

diff --git a/interimap b/interimap
index 553586f..f8989dc 100755
--- a/interimap
+++ b/interimap
@@ -29,7 +29,7 @@ use DBI ();
 use List::Util 'first';
 
 use lib 'lib';
-use Net::IMAP::InterIMAP qw/read_config compact_set $IMAP_text $IMAP_cond/;
+use Net::IMAP::InterIMAP qw/read_config compact_set/;
 
 # Clean up PATH
 $ENV{PATH} = join ':', qw{/usr/local/bin /usr/bin /bin};
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.