aboutsummaryrefslogtreecommitdiffstats
path: root/lib/Net/IMAP
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Net/IMAP')
-rw-r--r--lib/Net/IMAP/Sync.pm130
1 files changed, 88 insertions, 42 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm
index 48f61c1..47c6258 100644
--- a/lib/Net/IMAP/Sync.pm
+++ b/lib/Net/IMAP/Sync.pm
@@ -380,7 +380,7 @@ sub new($%) {
sub DESTROY($) {
my $self = shift;
foreach (qw/STDIN STDOUT/) {
- $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
+ $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
}
}
@@ -490,7 +490,8 @@ sub examine($$) {
# Issue a LOGOUT command. Change the state to LOGOUT.
sub logout($) {
my $self = shift;
- $self->_send('LOGOUT');
+ # don't bother if the connection is already closed
+ $self->_send('LOGOUT') if $self->{STDIN}->opened();
$self->{_STATE} = 'LOGOUT';
undef $self;
}
@@ -503,35 +504,54 @@ sub noop($) {
}
-# $self->create($mailbox)
-# $self->delete($mailbox)
+# $self->create($mailbox, [$try])
+# $self->delete($mailbox, [$try])
# CREATE or DELETE $mailbox.
-sub create($$) {
- my ($self, $mailbox) = @_;
- $self->_send("CREATE ".quote($mailbox));
- $self->log("Created mailbox ".$mailbox) unless $self->{quiet};
+# If try is set, print a warning but don't crash if the command fails.
+sub create($$;$) {
+ my ($self, $mailbox, $try) = @_;
+ my $r = $self->_send("CREATE ".quote($mailbox));
+ if ($IMAP_cond eq 'OK') {
+ $self->log("Created mailbox ".$mailbox) unless $self->{quiet};
+ }
+ else {
+ my $msg = "Couldn't create mailbox ".$mailbox.': '.$IMAP_text;
+ $try ? $self->warn($msg) : $self->fail($msg);
+ }
+ return $r;
}
-sub delete($$) {
- my ($self, $mailbox) = @_;
- $self->_send("DELETE ".quote($mailbox));
- $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet};
+sub delete($$;$) {
+ my ($self, $mailbox, $try) = @_;
+ my $r = $self->_send("DELETE ".quote($mailbox));
delete $self->{_CACHE}->{$mailbox};
delete $self->{_PCACHE}->{$mailbox};
+ if ($IMAP_cond eq 'OK') {
+ $self->log("Deleted mailbox ".$mailbox) unless $self->{quiet};
+ }
+ else {
+ my $msg = "Couldn't delete mailbox ".$mailbox.': '.$IMAP_text;
+ $try ? $self->warn($msg) : $self->fail($msg);
+ }
+ return $r;
}
-# $self->rename($oldname, $newname)
+# $self->rename($oldname, $newname, [$try])
# RENAME the mailbox $oldname to $newname.
+# If $try is set, print a warning but don't crash if the command fails.
# /!\ Requires a LIST command to be issued to determine the hierarchy
-# delimiter for the original name.
-sub rename($$$) {
- my ($self, $from, $to) = @_;
- my $delim = $self->{_CACHE}->{$from}->{DELIMITER} if defined $self->{_CACHE}->{$from};
- $self->_send("RENAME ".quote($from).' '.quote($to));
- $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet};
+# delimiter and the mailbox attributes for the original name.
+sub rename($$$;$) {
+ my ($self, $from, $to, $try) = @_;
+ my ($delim, @attrs);
+ if ($self->{_CACHE}->{$from}) {
+ $delim = $self->{_CACHE}->{$from}->{DELIMITER};
+ @attrs = @{$self->{_CACHE}->{$from}->{LIST_ATTRIBUTES} // []};
+ }
+ my $r = $self->_send("RENAME ".quote($from).' '.quote($to));
$self->{_CACHE}->{$to} = delete $self->{_CACHE}->{$from} if exists $self->{_CACHE}->{$from};
$self->{_PCACHE}->{$to} = delete $self->{_PCACHE}->{$from} if exists $self->{_PCACHE}->{$from};
- if (defined $delim) {
+ if (defined $delim and !grep {lc $_ eq lc '\NoInferiors' or lc $_ eq lc '\HasNoChildren'} @attrs) {
# on non-flat mailboxes, move children as well (cf 3501)
foreach my $c1 (grep /\A\Q$from$delim\E/, keys %{$self->{_CACHE}}) {
my $c2 = $c1 =~ s/\A\Q$from$delim\E/$to$delim/r;
@@ -539,21 +559,44 @@ sub rename($$$) {
$self->{_PCACHE}->{$c2} = delete $self->{_PCACHE}->{$c1} if exists $self->{_PCACHE}->{$c1};
}
}
+ if ($IMAP_cond eq 'OK') {
+ $self->log("Renamed mailbox ".$from.' to '.$to) unless $self->{quiet};
+ }
+ else {
+ my $msg = "Couldn't rename mailbox ".$from.': '.$IMAP_text;
+ $try ? $self->warn($msg) : $self->fail($msg);
+ }
+ return $r;
}
-# $self->subscribe($mailbox)
-# $self->unsubscribe($mailbox)
+# $self->subscribe($mailbox, [$try])
+# $self->unsubscribe($mailbox, [$try])
# SUBSCRIBE or UNSUBSCRIBE $mailbox.
-sub subscribe($$) {
- my ($self, $mailbox) = @_;
- $self->_send("SUBSCRIBE ".quote($mailbox));
- $self->log("Subscribed to mailbox ".$mailbox) unless $self->{quiet};
+# If $try is set, print a warning but don't crash if the command fails.
+sub subscribe($$;$) {
+ my ($self, $mailbox, $try) = @_;
+ my $r = $self->_send("SUBSCRIBE ".quote($mailbox));
+ if ($IMAP_cond eq 'OK') {
+ $self->log("Subscribe to ".$mailbox) unless $self->{quiet};
+ }
+ else {
+ my $msg = "Couldn't subscribe to ".$mailbox.': '.$IMAP_text;
+ $try ? $self->warn($msg) : $self->fail($msg);
+ }
+ return $r;
}
-sub unsubscribe($$) {
- my ($self, $mailbox) = @_;
- $self->_send("UNSUBSCRIBE ".quote($mailbox));
- $self->log("Unsubscribed to mailbox ".$mailbox) unless $self->{quiet};
+sub unsubscribe($$;$) {
+ my ($self, $mailbox, $try) = @_;
+ my $r = $self->_send("UNSUBSCRIBE ".quote($mailbox));
+ if ($IMAP_cond eq 'OK') {
+ $self->log("Unsubscribe to ".$mailbox) unless $self->{quiet};
+ }
+ else {
+ my $msg = "Couldn't unsubscribe to ".$mailbox.': '.$IMAP_text;
+ $try ? $self->warn($msg) : $self->fail($msg);
+ }
+ return $r;
}
@@ -1058,10 +1101,15 @@ sub _getline($;$) {
my $self = shift;
my $msg = shift // '';
- my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
- $x =~ s/\r\n\z// or $self->panic($x);
- $self->logger("S: $msg", $x) if $self->{debug};
- return $x;
+ if ($self->{STDOUT}->opened()) {
+ my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!");
+ $x =~ s/\r\n\z// or $self->panic($x);
+ $self->logger("S: $msg", $x) if $self->{debug};
+ return $x;
+ }
+ else {
+ undef $self;
+ }
}
@@ -1149,7 +1197,7 @@ sub _send($$;&) {
$IMAP_cond = $1;
$IMAP_text = $1.' '.$x;
$self->_resp_text($x);
- $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK';
+ $self->fail($IMAP_text) unless defined wantarray or $IMAP_cond eq 'OK';
$r = $1;
last;
}
@@ -1410,10 +1458,7 @@ sub _resp($$;$$$) {
if (s/\A\* //) {
if (s/\ABYE //) {
- foreach (qw/STDIN STDOUT/) {
- $self->{$_}->close() if defined $self->{$_} and $self->{$_}->opened();
- }
- exit 0;
+ undef $self;
}
elsif (s/\A(?:OK|NO|BAD) //) {
$self->_resp_text($_);
@@ -1446,15 +1491,16 @@ sub _resp($$;$$$) {
$callback->(split(/ /, ($1 =~ s/^ //r))) if defined $callback and $cmd eq 'SEARCH';
}
elsif (s/\ALIST \((\\?$RE_ATOM_CHAR+(?: \\?$RE_ATOM_CHAR+)*)?\) ("(?:\\[\x22\x5C]|[\x01-\x09\x0B\x0C\x0E-\x21\x23-\x5B\x5D-\x7F])"|NIL) //) {
- my ($delim, $flags) = ($2, $1);
- my @flags = defined $flags ? split(/ /, $flags) : ();
+ my ($delim, $attrs) = ($2, $1);
+ my @attrs = defined $attrs ? split(/ /, $attrs) : ();
my $mailbox = $self->_astring(\$_);
$self->panic($_) unless $_ eq '';
$mailbox = 'INBOX' if uc $mailbox eq 'INBOX'; # INBOX is case-insensitive
undef $delim if uc $delim eq 'NIL';
$delim =~ s/\A"(.*)"\Z/$1/ if defined $delim;
$self->_update_cache_for($mailbox, DELIMITER => $delim);
- $callback->($mailbox, $delim, @flags) if defined $callback and $cmd eq 'LIST';
+ $self->_update_cache_for($mailbox, LIST_ATTRIBUTES => \@attrs);
+ $callback->($mailbox, $delim, @attrs) if defined $callback and $cmd eq 'LIST';
}
elsif (s/\ASTATUS //) {
my $mailbox = $self->_astring(\$_);
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-26 20:08:47 +0000