diff options
| -rw-r--r-- | lib/Net/IMAP/Sync.pm | 55 |
1 files changed, 27 insertions, 28 deletions
diff --git a/lib/Net/IMAP/Sync.pm b/lib/Net/IMAP/Sync.pm index cea647f..6c4b8a3 100644 --- a/lib/Net/IMAP/Sync.pm +++ b/lib/Net/IMAP/Sync.pm @@ -1043,7 +1043,7 @@ sub _getline($;$) { my $self = shift; my $msg = shift // ''; - my $x = $self->{STDOUT}->getline() // return; # non-blocking IO + my $x = $self->{STDOUT}->getline() // $self->panic("Can't read: $!"); $x =~ s/\r\n\z// or $self->panic($x); $self->log("S: $msg", $x) if $self->{debug}; return $x; @@ -1099,42 +1099,47 @@ sub _send($$;&) { # literals, mark literals as such and then the whole command in one # go, otherwise send literals one at a time my $tag = sprintf '%06d', $self->{_TAG}++; - my $prefix = $tag.' '; + my $litplus; + my @command = ("$tag "); + my $dbg_cmd = "C: $command[0]"; while ($command =~ s/\A(.*?)\{([0-9]+)\}\r\n//) { my ($str, $len) = ($1, $2); my $lit = substr $command, 0, $len, ''; # consume the literal - if ($self->_capable('LITERAL+')) { # RFC 2088 LITERAL+ - $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len+}") if $self->{debug}; - $self->{STDIN}->print($prefix, $str, "{$len+}\r\n"); - } - else { - $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $str, "{$len}") if $self->{debug}; - $self->{STDIN}->print($prefix, $str, "{$len}\r\n"); + $litplus //= $self->_capable('LITERAL+') ? '+' : ''; + push @command, $str, "{$len$litplus}", "\r\n"; + $self->log($dbg_cmd, $str, "{$len$litplus}") if $self->{debug}; + $dbg_cmd = 'C: [...]'; + + unless ($litplus) { + $self->{STDIN}->write(join('',@command)) // $self->panic("Can't write: $!"); $self->{STDIN}->flush(); my $x = $self->_getline(); $x =~ /\A\+ / or $self->panic($x); + @command = (); } - $self->{STDIN}->print($lit); - $prefix = ''; + push @command, $lit; } - $self->log('C: ', ($prefix ne '' ? $prefix : '[...]'), $command) if $self->{debug}; - $self->{STDIN}->print($prefix, $command, "\r\n"); + push @command, $command, "\r\n"; + $self->log($dbg_cmd, $command) if $self->{debug}; + $self->{STDIN}->write(join('',@command)) // $self->panic("Can't write: $!"); $self->{STDIN}->flush(); + my $r; # wait for the answer - while (defined($_ = $self->_getline())) { - if (s/\A\Q$tag\E (OK|NO|BAD) //) { + while (1) { + my $x = $self->_getline(); + if ($x =~ s/\A\Q$tag\E (OK|NO|BAD) //) { $IMAP_cond = $1; - $IMAP_text = $1.' '.$_; - $self->_resp_text($_); + $IMAP_text = $1.' '.$x; + $self->_resp_text($x); $self->fail($IMAP_text, "\n") unless defined wantarray or $IMAP_cond eq 'OK'; $r = $1; last; } else { - $self->_resp($_, $cmd, $set, $callback); + $self->_resp($x, $cmd, $set, $callback); } } @@ -1312,16 +1317,10 @@ sub _string($$) { } elsif ($$stream =~ s/\A\{([0-9]+)\}\z//) { # literal - my $count = $1; - my @acc; - my $buf; - while ($count > 0) { - my $n = $self->{STDOUT}->read($buf, $count); - push @acc, $buf; - $count -= $n; - } + $self->{STDOUT}->read(my $lit, $1) // $self->panic("Can't read: $!"); + # read a the rest of the response $$stream = $self->_getline('[...]'); - return join ('', @acc); + return $lit; } else { $self->panic($$stream); @@ -1523,7 +1522,7 @@ sub _resp($$;$$$) { if (defined $callback and $cmd eq 'AUTHENTICATE') { my $x = $callback->($_); print STDERR "C: ", $x, "\n" if $self->{debug}; - $self->{STDIN}->print($x, "\r\n"); + $self->{STDIN}->write($x."\r\n") // $self->panic("Can't write: $!"); $self->{STDIN}->flush(); } } |