aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2016-03-11 03:10:56 +0100
committerGuilhem Moulin <guilhem@fripost.org>2016-03-11 03:10:56 +0100
commitaa07430ff47d3745b7c575c2f24f78c6d34ce115 (patch)
treeb41b80ca8b9e6052c84f80f92e11b96575cd8f70 /lib/Net
parent704f775cb23237e1cb5107a2d1ea142e44f1d3f5 (diff)
parent95787b188cc324fbdb6c6022d9750ba552591559 (diff)
Merge branch 'master' into debian
Diffstat (limited to 'lib/Net')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm33
1 files changed, 18 insertions, 15 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 73f55e8..45253c1 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -910,7 +910,7 @@ sub append($$@) {
# $self->fetch($set, $flags, [$callback])
# Issue an UID FETCH command with the given UID $set, $flags, and
# optional $callback.
-sub fetch($$$$) {
+sub fetch($$$;&) {
my ($self, $set, $flags, $callback) = @_;
$self->_send("UID FETCH $set $flags", $callback);
}
@@ -938,14 +938,14 @@ sub notify($@) {
}
-# $self->slurp([$cmd, $callback])
+# $self->slurp([$callback, $cmd])
# 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 2177 (IDLE) or RFC 5465 (NOTIFY).
-sub slurp($;$$) {
- my ($self, $cmd, $callback) = @_;
+sub slurp($;&$) {
+ my ($self, $callback, $cmd) = @_;
my $ssl = $self->{_SSL};
my $read = 0;
@@ -962,7 +962,7 @@ sub slurp($;$$) {
return $read if $r == 0; # nothing more to read
}
my $x = $self->_getline();
- $self->_resp($x, $cmd, undef, $callback);
+ $self->_resp($x, $callback, $cmd);
$read++;
}
}
@@ -973,9 +973,10 @@ sub slurp($;$$) {
# when the callback $stopwhen returns true.
# Return false if the timeout was reached, and true if IDLE was
# stopped due the callback.
-sub idle($$$) {
+sub idle($;$&) {
my ($self, $timeout, $stopwhen) = @_;
$timeout //= 1740; # 29 mins
+ my $callback = sub() {$timeout = -1 if $stopwhen->()};
$self->fail("Server did not advertise IDLE (RFC 2177) capability.")
unless $self->_capable('IDLE');
@@ -984,14 +985,16 @@ sub idle($$$) {
$self->_cmd_flush();
for (; $timeout > 0; $timeout--) {
- $self->slurp('IDLE', sub() {$timeout = -1 if $stopwhen->()});
+ $self->slurp($callback, 'IDLE');
sleep 1 if $timeout > 0;
}
# done idling
$self->_cmd_extend('DONE');
$self->_cmd_flush();
- $self->_recv($tag);
+ # run the callback again to update the return value if we received
+ # untagged responses between the DONE and the tagged response
+ $self->_recv($tag, $callback, 'IDLE');
return $timeout < 0 ? 1 : 0;
}
@@ -1161,7 +1164,7 @@ sub pull_updates($;$) {
}
-# $self->pull_new_messages($callback, $attrs, @ignore)
+# $self->pull_new_messages($attrs, $callback, @ignore)
# FETCH new messages since the UIDNEXT found in the persistent cache
# (or 1 in no such UIDNEXT is found), and process each response on the
# fly with the callback.
@@ -1171,7 +1174,7 @@ sub pull_updates($;$) {
# Finally, update the UIDNEXT from the persistent cache to the value
# found in the internal cache.
# /!\ Use pull_updates afterwards to udpate the HIGHESTMODSEQ!
-sub pull_new_messages($$$@) {
+sub pull_new_messages($$&@) {
my $self = shift;
my $attrs = shift;
my $callback = shift;
@@ -1921,7 +1924,7 @@ sub _send($$;&) {
# provided, is used to process each untagged response. $command and
# $set can further limit the set of responses to apply the callback
# to.
-sub _recv($$;$&$) {
+sub _recv($$;&$$) {
my ($self, $tag, $callback, $cmd, $set) = @_;
my $r;
@@ -1937,7 +1940,7 @@ sub _recv($$;$&$) {
last;
}
else {
- $self->_resp($x, $cmd, $set, $callback);
+ $self->_resp($x, $callback, $cmd, $set);
}
}
@@ -2196,18 +2199,18 @@ sub _envelope($$) {
return \@envelope;
}
-# $self->_resp($buf, [$cmd, $set, $callback] )
+# $self->_resp($buf, [$callback, $cmd, $set] )
# Parse an untagged response line or a continuation request line.
# (The trailing CRLF must be removed.) The internal cache is
# automatically updated when needed.
# If a command and callback are given, the callback is be executed
# for each (parsed) responses associated with the command.
-sub _resp($$;$$$) {
+sub _resp($$;&$$) {
my $self = shift;
local $_ = shift;
+ my $callback = shift;
my $cmd = shift;
my $set = shift;
- my $callback = shift;
my $cache = $self->{_CACHE}->{$self->{_SELECTED}} if defined $self->{_SELECTED};
if (s/\A\* //) {