diff options
Diffstat (limited to 'lib/Net')
| -rw-r--r-- | lib/Net/IMAP/Sync.pm | 130 |
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(\$_); |