diff options
| -rwxr-xr-x | interimap | 2 | ||||
| -rw-r--r-- | lib/Net/IMAP/InterIMAP.pm | 31 |
2 files changed, 16 insertions, 17 deletions
@@ -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. |