From 71cddb9e85ae0ea2468c64687319677e6bc9746a Mon Sep 17 00:00:00 2001
From: Guilhem Moulin <guilhem@fripost.org>
Date: Sun, 26 Jul 2015 01:14:39 +0200
Subject: Clean how we're sending commands to the server.

---
 lib/Net/IMAP/Sync.pm | 55 ++++++++++++++++++++++++++--------------------------
 1 file 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();
         }
     }
-- 
cgit v1.2.3