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:
parent
734cec2e3b
commit
a06e30e73b
4 changed files with 23 additions and 18 deletions
5
third_party/lisp/mime4cl/package.lisp
vendored
5
third_party/lisp/mime4cl/package.lisp
vendored
|
@ -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
|
||||||
|
))
|
||||||
|
|
24
third_party/lisp/mime4cl/streams.lisp
vendored
24
third_party/lisp/mime4cl/streams.lisp
vendored
|
@ -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))
|
|
||||||
|
|
|
@ -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))
|
||||||
|
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in a new issue