From a06e30e73b89c6fe92cf55d00c03d7ef6aaa6f5c Mon Sep 17 00:00:00 2001
From: sterni <sternenseemann@systemli.org>
Date: Tue, 16 May 2023 16:22:44 +0200
Subject: refactor(sterni/mblog): move REDIRECT-STREAM into mime4cl
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Eventually, we'll want to replace dump-stream-binary with something more
efficient—given that we have flexi-streams we can use something that
only does matching element types no problem. REDIRECT-STREAM is much
more efficient thanks to using an internal buffer.

streams.lisp gets a new section at the beginning for grouping utilities
that don't have any real (internal) dependencies.

Change-Id: I141cd36440d532131f389be2768fdaa54e7c7218
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8583
Reviewed-by: sterni <sternenseemann@systemli.org>
Autosubmit: sterni <sternenseemann@systemli.org>
Tested-by: BuildkiteCI
---
 third_party/lisp/mime4cl/package.lisp |  5 ++++-
 third_party/lisp/mime4cl/streams.lisp | 24 ++++++++++++++++--------
 users/sterni/mblog/mblog.lisp         | 11 ++---------
 users/sterni/mblog/packages.lisp      |  1 +
 4 files changed, 23 insertions(+), 18 deletions(-)

diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp
index e9ff14510d..1ab598eeb8 100644
--- a/third_party/lisp/mime4cl/package.lisp
+++ b/third_party/lisp/mime4cl/package.lisp
@@ -99,4 +99,7 @@
            ;; address.lisp
            #:parse-addresses #:mailboxes-only
            #:mailbox #:mbx-description #:mbx-user #:mbx-host #:mbx-domain #:mbx-domain-name #:mbx-address
-           #:mailbox-group #:mbxg-name #:mbxg-mailboxes))
+           #:mailbox-group #:mbxg-name #:mbxg-mailboxes
+           ;; streams.lisp
+           #:redirect-stream
+           ))
diff --git a/third_party/lisp/mime4cl/streams.lisp b/third_party/lisp/mime4cl/streams.lisp
index d49e738240..b9e56cf2d2 100644
--- a/third_party/lisp/mime4cl/streams.lisp
+++ b/third_party/lisp/mime4cl/streams.lisp
@@ -21,6 +21,22 @@
 
 (in-package :mime4cl)
 
+(defun flexi-stream-root-stream (stream)
+  "Return the non FLEXI-STREAM stream a given chain of FLEXI-STREAMs is based on."
+  (if (typep stream 'flexi-stream)
+      (flexi-stream-root-stream (flexi-stream-stream stream))
+      stream))
+
+(defun redirect-stream (in out &key (buffer-size 4096))
+  "Consume input stream IN and write all its content to output stream OUT.
+The streams' element types need to match."
+  (let ((buf (make-array buffer-size :element-type (stream-element-type in))))
+    (loop for pos = (read-sequence buf in)
+          while (> pos 0)
+          do (write-sequence buf out :end pos))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (defclass coder-stream-mixin ()
   ((real-stream :type stream
                 :initarg :underlying-stream
@@ -264,11 +280,3 @@ be modified to match the :POSITION argument."
              (:base64 'qbase64:decode-stream))
            :underlying-stream portion-stream)
           portion-stream))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun flexi-stream-root-stream (stream)
-  "Return the non FLEXI-STREAM stream a given chain of FLEXI-STREAMs is based on."
-  (if (typep stream 'flexi-stream)
-      (flexi-stream-root-stream (flexi-stream-stream stream))
-      stream))
diff --git a/users/sterni/mblog/mblog.lisp b/users/sterni/mblog/mblog.lisp
index 61ba5511d6..7823bde203 100644
--- a/users/sterni/mblog/mblog.lisp
+++ b/users/sterni/mblog/mblog.lisp
@@ -26,14 +26,6 @@
                            :if-does-not-exist :create)
      ,@body))
 
-(defun redirect-stream (in out)
-  "Consume input stream IN and write all its content to output stream OUT.
-  The streams' element types need to match."
-  (let ((buf (make-array config:*general-buffer-size* :element-type (stream-element-type in))))
-    (loop for pos = (read-sequence buf in)
-          while (> pos 0)
-          do (write-sequence buf out :end pos))))
-
 ;; CSS
 
 (defvar *style* "
@@ -98,7 +90,8 @@ a:link, a:visited {
         (with-overwrite-file (attachment-out attachment-dst
                               :element-type
                               (stream-element-type attachment-in))
-          (redirect-stream attachment-in attachment-out)))))
+          (redirect-stream attachment-in attachment-out
+                           :buffer-size *general-buffer-size*)))))
 
   (values))
 
diff --git a/users/sterni/mblog/packages.lisp b/users/sterni/mblog/packages.lisp
index 03c33f7efe..d6e33955d3 100644
--- a/users/sterni/mblog/packages.lisp
+++ b/users/sterni/mblog/packages.lisp
@@ -50,6 +50,7 @@
    :config)
   (:export :build-mblog)
   (:import-from :local-time :universal-to-timestamp)
+  (:import-from :mime4cl :redirect-stream)
   (:shadowing-import-from :common-lisp :list))
 
 (defpackage :cli
-- 
cgit 1.4.1