aboutsummaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorGuilhem Moulin <guilhem@fripost.org>2018-05-09 01:03:28 +0200
committerGuilhem Moulin <guilhem@fripost.org>2018-05-09 01:11:18 +0200
commita95890cc5c18a2c4a16d6929b2725c6ba3fc3e5e (patch)
tree2f6abbb2b04a822a8468bb202e293425df06473f /lib
parenta32fd7afe3bff2bcea198ef62653fcde2b31534d (diff)
Library: new API idle_start() and idle_stop().
Diffstat (limited to 'lib')
-rw-r--r--lib/Net/IMAP/InterIMAP.pm32
1 files changed, 26 insertions, 6 deletions
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 6f148b7..9719de2 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -959,14 +959,15 @@ sub slurp($$$) {
foreach my $imap (@ready) {
my $x = $imap->_getline();
- $imap->_resp($x, sub($) {
- if ($stopwhen->($imap, shift)) {
+ $imap->_resp($x, sub($;$$) {
+ if ($stopwhen->(@_)) {
$aborted = 1;
$timeout = 0; # keep reading the handles while there is pending data
}
}, 'slurp');
}
}
+ return $aborted;
}
@@ -977,20 +978,39 @@ sub slurp($$$) {
# after the $timeout) and false otherwise.
sub idle($$$) {
my ($self, $timeout, $stopwhen) = @_;
+ my $tag = $self->idle_start($timeout);
+ my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins
+ $r += $self->idle_stop($tag, $stopwhen);
+ return $r;
+}
+# $self->idle_start()
+# Enter IDLE (RFC 2177).
+# Return the command tag.
+sub idle_start($) {
+ my $self = shift;
$self->fail("Server did not advertise IDLE (RFC 2177) capability.")
unless $self->_capable('IDLE');
my $tag = $self->_cmd_init('IDLE');
$self->_cmd_flush();
- my $r = slurp([$self], $timeout // 1740, $stopwhen); # 29 mins
+ return $tag;
+}
+
+# $self->idle_stop($tag, $callback)
+# Stop a running IDLE (RFC 2177) command $tag.
+# Returns the number of untagged responses received between the DONE
+# the tagged response that are satisfying $callback.
+sub idle_stop($$$) {
+ my ($self, $tag, $callback) = @_;
+ my $r = 0;
# done idling
$self->_cmd_extend('DONE');
$self->_cmd_flush();
# run the callback again to update the return value if we received
# untagged responses between the DONE and the tagged response
- $self->_recv($tag, sub($) { $r = 1 if $stopwhen->($self, shift) }, 'slurp');
+ $self->_recv($tag, sub($;$$) { $r++ if $callback->($self, @_) }, 'slurp');
return $r;
}
@@ -2247,7 +2267,7 @@ sub _resp($$;&$$) {
$self->{_NEW} += $1 - $cache->{EXISTS} if $1 > $cache->{EXISTS}; # new mails
}
$cache->{EXISTS} = $1;
- $callback->($self->{_SELECTED} // $self->panic()) if defined $callback and $cmd eq 'slurp';
+ $callback->($self->{_SELECTED} // $self->panic(), EXISTS => $1) if defined $callback and $cmd eq 'slurp';
}
elsif (/\A([0-9]+) EXPUNGE\z/) {
$self->panic() unless defined $cache->{EXISTS}; # sanity check
@@ -2340,7 +2360,7 @@ sub _resp($$;&$$) {
if ($cmd eq 'FETCH' or $cmd eq 'STORE') {
$callback->(\%mail) if defined $uid and in_set($uid, $set);
} elsif ($cmd eq 'slurp') {
- $callback->($self->{_SELECTED} // $self->panic())
+ $callback->($self->{_SELECTED} // $self->panic(), FETCH => $seq)
}
}
}