refactor(sterni/mblog): move REDIRECT-STREAM into mime4cl

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
This commit is contained in:
sterni 2023-05-16 16:22:44 +02:00 committed by clbot
parent 734cec2e3b
commit a06e30e73b
4 changed files with 23 additions and 18 deletions

View file

@ -99,4 +99,7 @@
;; address.lisp ;; address.lisp
#:parse-addresses #:mailboxes-only #:parse-addresses #:mailboxes-only
#:mailbox #:mbx-description #:mbx-user #:mbx-host #:mbx-domain #:mbx-domain-name #:mbx-address #: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
))

View file

@ -21,6 +21,22 @@
(in-package :mime4cl) (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 () (defclass coder-stream-mixin ()
((real-stream :type stream ((real-stream :type stream
:initarg :underlying-stream :initarg :underlying-stream
@ -264,11 +280,3 @@ be modified to match the :POSITION argument."
(:base64 'qbase64:decode-stream)) (:base64 'qbase64:decode-stream))
:underlying-stream portion-stream) :underlying-stream portion-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))

View file

@ -26,14 +26,6 @@
:if-does-not-exist :create) :if-does-not-exist :create)
,@body)) ,@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 ;; CSS
(defvar *style* " (defvar *style* "
@ -98,7 +90,8 @@ a:link, a:visited {
(with-overwrite-file (attachment-out attachment-dst (with-overwrite-file (attachment-out attachment-dst
:element-type :element-type
(stream-element-type attachment-in)) (stream-element-type attachment-in))
(redirect-stream attachment-in attachment-out))))) (redirect-stream attachment-in attachment-out
:buffer-size *general-buffer-size*)))))
(values)) (values))

View file

@ -50,6 +50,7 @@
:config) :config)
(:export :build-mblog) (:export :build-mblog)
(:import-from :local-time :universal-to-timestamp) (:import-from :local-time :universal-to-timestamp)
(:import-from :mime4cl :redirect-stream)
(:shadowing-import-from :common-lisp :list)) (:shadowing-import-from :common-lisp :list))
(defpackage :cli (defpackage :cli