Refactoring.

2 files changed, 84 insertions, 87 deletions

diff --git a/INSTALL b/INSTALL
index b3f9ebc..f27952b 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,6 +1,6 @@
 InterIMAP depends on the following Perl modules:
 
-  - Compress::Raw::Zlib (core module)
+  - Compress::Zlib (core module)
   - Config::Tiny
   - DBI
   - DBD::SQLite
diff --git a/lib/Net/IMAP/InterIMAP.pm b/lib/Net/IMAP/InterIMAP.pm
index 2821f98..6012049 100644
--- a/lib/Net/IMAP/InterIMAP.pm
+++ b/lib/Net/IMAP/InterIMAP.pm
@@ -20,7 +20,7 @@ package Net::IMAP::InterIMAP v0.0.1;
 use warnings;
 use strict;
 
-use Compress::Raw::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
+use Compress::Zlib qw/Z_OK Z_FULL_FLUSH Z_SYNC_FLUSH MAX_WBITS/;
 use Config::Tiny ();
 use Errno 'EWOULDBLOCK';
 use IO::Select ();
@@ -427,11 +427,11 @@ sub new($%) {
                 if ($algo eq 'DEFLATE') {
                     my ($status, $d, $i);
                     my %args = ( -WindowBits => 0 - MAX_WBITS );
-                    ($d, $status) = Compress::Raw::Zlib::Deflate::->new(%args);
+                    ($d, $status) = Compress::Zlib::deflateInit(%args);
                     $self->panic("Can't create deflation stream: ", $d->msg())
                         unless defined $d and $status == Z_OK;
 
-                    ($i, $status) = Compress::Raw::Zlib::Inflate::->new(%args);
+                    ($i, $status) = Compress::Zlib::inflateInit(%args);
                     $self->panic("Can't create inflation stream: ", $i->msg())
                         unless defined $i and $status == Z_OK;
                     @$self{qw/_Z_DEFLATE _Z_INFLATE/} = ($d, $i);
@@ -1254,9 +1254,9 @@ sub _getline($;$) {
             $self->{_OUTRAWCOUNT} += $n;
 
             if (defined (my $i = $self->{_Z_INFLATE})) {
-                my $status = $i->inflate($buf, my $data);
+                my ($out, $status) = $i->inflate($buf);
                 $self->panic("Inflation failed: ", $i->msg()) unless $status == Z_OK;
-                $buf = $data;
+                $buf = $out;
             }
             $self->{_OUTBUF} = $buf;
         }
@@ -1326,52 +1326,94 @@ sub _update_cache_for($$%) {
 
 
 # $self->_write(@data)
-#   Send the given @data to the IMAP server and flush the buffer.  If a
-#   compression layer is active, flush the deflation stream first.
+#   Send the given @data to the IMAP server.
 #   Update the interal raw byte count, but the regular byte count must
-#   have been updated earlier.
+#   have been updated earlier (eg, by _send_cmd).
 sub _write($@) {
     my $self = shift;
-    my @data = @_;
-
-    if (defined (my $d = $self->{_Z_DEFLATE})) {
-        my $status = $d->flush(my $buf, Z_SYNC_FLUSH);
-        $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
-        push @data, $buf if $buf ne '';
+    foreach (@_) {
+        next if $_ eq '';
+        $self->{STDIN}->write($_) // $self->panic("Can't write: $!");
+        $self->{_INRAWCOUNT} += length($_);
     }
-
-    my $data = join '', @data;
-    $self->{STDIN}->write($data) // $self->panic("Can't write: $!");
-    $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
-    $self->{_INRAWCOUNT} += length($data);
-}
-
-
-# $self->_z_deflate(@data)
-#   Add the given @data to the deflation stream, and return the
-#   compressed data.
-#   This method is a noop if no compression layer is active.
-sub _z_deflate($@) {
-    my $self = shift;
-    my $data = join '', @_;
-    $self->{_INCOUNT} += length($data);
-    my $d = $self->{_Z_DEFLATE} // return @_;
-
-    my $status = $d->deflate($data, my $buf);
-    $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
-    return ($buf) if $buf ne '';
 }
 
 
 # $self->_z_flush([$type])
-#   Flush the deflation stream, and return the compressed data.
+#   Flush the deflation stream, and write the compressed data.
 #   This method is a noop if no compression layer is active.
 sub _z_flush($;$) {
-    my $self = shift;
+    my ($self,$t) = @_;
     my $d = $self->{_Z_DEFLATE} // return;
-    my $status = $d->flush(my $buf, @_);
+    my ($out, $status) = $d->flush($t);
     $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
-    return ($buf) if $buf ne '';
+    $self->_write($out);
+}
+
+
+# $self->_send_cmd($tag, $command)
+#   Send the given $command to the IMAP server.
+#   If $command contains literals and the server supportes LITERAL+,
+#   non-synchronizing literals are sent instead.
+#   If a compression layer is active, $command is compressed before
+#   being send.
+sub _send_cmd($) {
+    my ($self, $tag, $command) = @_;
+    my $litplus = $self->_capable('LITERAL+') ? 1 : 0;
+    my $d = $self->{_Z_DEFLATE};
+
+    my ($offset, $litlen) = (0, 0);
+    my $z_flush = 0; # whether to flush the dictionary after processing the next literal
+
+    while(1) {
+        my $lit = substr($command, $offset, $litlen) if $litlen > 0;
+        $offset += $litlen;
+
+        my ($line, $z_flush2);
+        my $idx = index($command, "\n", $offset);
+        if ($idx < 0) {
+            $line = substr($command, $offset);
+        }
+        else {
+            $line = substr($command, $offset, $idx-1-$offset);
+            $litlen = $litplus ? ($line =~ s/\{([0-9]+)\}\z/{$1+}/ ? $1 : $self->panic())
+                               : ($line =~  /\{([0-9]+)\}\z/       ? $1 : $self->panic());
+            $z_flush2 = ($litlen > 4096 and                     # large literal
+                (uc ($self->{'use-binary'} // 'YES') eq 'NO'
+                        or $line =~ /~\{[0-9]+\}\z/)            # literal8, RFC 3516 BINARY
+            ) ? 1 : 0;
+        }
+        $self->logger('C: ', ($offset == 0 ? "$tag " : '[...]'), $line) if $self->{debug};
+
+        my @data = (($offset == 0 ? "$tag " : $lit), $line, "\r\n");
+        $self->{_INCOUNT} += length($_) foreach @data;
+        if (!defined $d) {
+            $self->_write(@data);
+        }
+        else {
+            for (my $i = 0; $i <= $#data; $i++) {
+                $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
+
+                my ($out, $status) = $d->deflate($data[$i]);
+                $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
+                $self->_write($out);
+
+                $self->_z_flush(Z_FULL_FLUSH) if $i == 0 and $z_flush;
+            }
+        }
+
+        if (!$litplus or $idx < 0) {
+            $self->_z_flush(Z_SYNC_FLUSH) if defined $d;
+
+            $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
+            last if $idx < 0;
+            my $x = $self->_getline();
+            $x =~ /\A\+ / or $self->panic($x);
+        }
+
+        $z_flush = $z_flush2;
+        $offset = $idx+1;
+    }
 }
 
 
@@ -1393,53 +1435,7 @@ 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 $litplus;
-
-    my @command = $self->_z_deflate("$tag ");
-    my $dbg_cmd = "C: $tag ";
-
-    while ($command =~ s/\A(.*?)\{([0-9]+)\}\r\n//) {
-        my ($str, $len) = ($1, $2);
-        my $lit = substr $command, 0, $len, '';   # consume the literal
-        my $bin = substr($str,-1) eq '~' ? 1 : 0; # literal8, RFC 3516 BINARY
-
-        $litplus //= $self->_capable('LITERAL+') ? '+' : '';
-        push @command, $self->_z_deflate($str, "{$len$litplus}", "\r\n");
-
-        $self->logger($dbg_cmd, $str, "{$len$litplus}") if $self->{debug};
-        $dbg_cmd = 'C: [...]';
-
-        unless ($litplus) {
-            $self->_write(@command);
-            my $x = $self->_getline();
-            $x =~ /\A\+ / or $self->panic($x);
-            @command = ();
-        }
-        if ($len > 4096 and (!$self->{'use-binary'} or $bin) and defined (my $d = $self->{_Z_DEFLATE})) {
-            my ($status, $buf);
-            # send a Z_FULL_FLUSH at the start and end of large non-text
-            # literals, as hinted at in RFC 4978 section 4
-            $status = $d->flush($buf, Z_FULL_FLUSH);
-            $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
-            push @command, $buf if $buf ne '';
-
-            undef $buf;
-            $status = $d->deflate($lit, $buf);
-            $self->panic("Deflation failed: ", $d->msg()) unless $status == Z_OK;
-            push @command, $buf if $buf ne '';
-
-            undef $buf;
-            $status = $d->flush($buf, Z_FULL_FLUSH);
-            $self->panic("Can't flush deflation stream: ", $d->msg()) unless $status == Z_OK;
-            push @command, $buf if $buf ne '';
-        }
-        else {
-            push @command, $self->_z_deflate($lit);
-        }
-    }
-    push @command, $self->_z_deflate($command, "\r\n");
-    $self->logger($dbg_cmd, $command) if $self->{debug};
-    $self->_write(@command);
+    $self->_send_cmd($tag, $command);
 
     my $r;
     # wait for the answer
@@ -1849,6 +1845,7 @@ sub _resp($$;$$$) {
             $x .= "\r\n";
             $self->{_INCOUNT} += length($x);
             $self->_write($x);
+            $self->{STDIN}->flush() // $self->panic("Can't flush: $!");
         }
     }
     else {