about summary refs log tree commit diff
path: root/third_party/lisp/mime4cl
diff options
context:
space:
mode:
authorsterni <sternenseemann@systemli.org>2023-05-16T14·22+0200
committerclbot <clbot@tvl.fyi>2023-05-18T16·16+0000
commita06e30e73b89c6fe92cf55d00c03d7ef6aaa6f5c (patch)
tree7a6c57b2d22cc6a32ff9822a6d8e95ac80833c9e /third_party/lisp/mime4cl
parent734cec2e3bb24799869462e57853f99b8d89b294 (diff)
refactor(sterni/mblog): move REDIRECT-STREAM into mime4cl r/6154
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
Diffstat (limited to 'third_party/lisp/mime4cl')
-rw-r--r--third_party/lisp/mime4cl/package.lisp5
-rw-r--r--third_party/lisp/mime4cl/streams.lisp24
2 files changed, 20 insertions, 9 deletions
diff --git a/third_party/lisp/mime4cl/package.lisp b/third_party/lisp/mime4cl/package.lisp
index e9ff14510d2b..1ab598eeb8e1 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 d49e73824000..b9e56cf2d22c 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))