diff options
author | sterni <sternenseemann@systemli.org> | 2023-05-16T14·22+0200 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2023-05-18T16·16+0000 |
commit | a06e30e73b89c6fe92cf55d00c03d7ef6aaa6f5c (patch) | |
tree | 7a6c57b2d22cc6a32ff9822a6d8e95ac80833c9e | |
parent | 734cec2e3bb24799869462e57853f99b8d89b294 (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
-rw-r--r-- | third_party/lisp/mime4cl/package.lisp | 5 | ||||
-rw-r--r-- | third_party/lisp/mime4cl/streams.lisp | 24 | ||||
-rw-r--r-- | users/sterni/mblog/mblog.lisp | 11 | ||||
-rw-r--r-- | 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 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)) diff --git a/users/sterni/mblog/mblog.lisp b/users/sterni/mblog/mblog.lisp index 61ba5511d6ff..7823bde20343 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 03c33f7efe12..d6e33955d31c 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 |