├── package.lisp ├── cl-plumbing-test.asd ├── cl-plumbing.asd ├── cl-plumbing.lisp ├── README.org ├── test.lisp ├── fifo-pipe.lisp └── gray-streams-pipe.lisp /package.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defpackage :cl-plumbing 3 | (:use :cl :iterate) 4 | (:export 5 | #:connect-streams 6 | #:*warn-on-foreground-connect-stream* 7 | #:make-pipe)) 8 | -------------------------------------------------------------------------------- /cl-plumbing-test.asd: -------------------------------------------------------------------------------- 1 | 2 | (asdf:defsystem #:cl-plumbing-test 3 | :name "cl-plumbing-test" 4 | :author "Zachary Smith " 5 | :license "LLGPL" 6 | :description 7 | "Tests for a few (at least seemingly) missing stream operations in Common 8 | Lisp." 9 | :components ((:file "test")) 10 | :serial t 11 | :depends-on (:iterate :cl-plumbing :stefil)) 12 | 13 | -------------------------------------------------------------------------------- /cl-plumbing.asd: -------------------------------------------------------------------------------- 1 | 2 | (asdf:defsystem #:cl-plumbing 3 | :name "CL-Plumbing" 4 | :author "Zachary Smith " 5 | :license "LLGPL" 6 | :description "A few (at least seemingly) missing stream operations in Common Lisp." 7 | :components ((:file "package") 8 | #+(or abcl ccl clisp cmu ecl sbcl allegro lispworks) 9 | (:file "gray-streams-pipe") 10 | #-(or abcl ccl clisp cmu ecl sbcl allegro lispworks) 11 | (:file "fifo-pipe") 12 | (:file "cl-plumbing")) 13 | :serial t 14 | :depends-on (:iterate :trivial-gray-streams :bordeaux-threads)) 15 | -------------------------------------------------------------------------------- /cl-plumbing.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-plumbing) 3 | 4 | (defun dump-stream (input output &optional fn) 5 | (with-open-stream (echo (make-echo-stream input output)) 6 | (iter (for c = (read-char echo nil nil)) 7 | (when fn (funcall fn c)) 8 | (while c)))) 9 | 10 | (defvar *warn-on-foreground-connect-stream* t) 11 | 12 | (defun connect-streams (input output &key (background t) fn) 13 | "This reads from input and writes output until the end of input is found." 14 | #-bordeaux-threads 15 | (progn 16 | (when (and background *warn-on-foreground-connect-stream*) 17 | (warn "Unable to run in background without multithreading support")) 18 | (dump-stream input output fn)) 19 | #+bordeaux-threads 20 | (if background 21 | (bt:make-thread 22 | (lambda () 23 | (dump-stream input output fn))) 24 | (dump-stream input output fn))) 25 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | 2 | * CL-Plumbing 3 | 4 | This library adds a few stream manipulation facilities that I haven't been able 5 | to figure out using CL's stream facilities. These include: 6 | 7 | =make-pipe=: Make a two way stream (though not of type two-way-stream) that 8 | accepts data (via writing to it) and that data can then be read from it. This 9 | is similar to the piping mechanism in the shell. 10 | 11 | =connect-streams=: Take an input stream and an output stream and feed all data 12 | from the input stream to the output stream. Again, similar to the way shell 13 | pipes act, but this is for two existing streams and the other creates two new 14 | streams (well, one new two way stream). 15 | 16 | ** Future work 17 | 18 | Just now it occurred to me that it would be cool to have this provide a CL 19 | (gray) stream interface for ZeroMQ. Most of the work is already done, I 20 | believe... 21 | -------------------------------------------------------------------------------- /test.lisp: -------------------------------------------------------------------------------- 1 | 2 | (defpackage :cl-plumbing-test 3 | (:use :cl :cl-plumbing :stefil :iterate) 4 | (:export)) 5 | 6 | (in-package :cl-plumbing-test) 7 | 8 | (in-root-suite) 9 | 10 | (deftest iterate-test () 11 | "Test to see if the pipes work with Iterates in-stream driver." 12 | (let ((pipe (make-pipe))) 13 | (print 1 pipe) 14 | (print 2 pipe) 15 | (print 3 pipe) 16 | (is (equal '(1 2 3) 17 | (iter (for val in-stream pipe) 18 | (collect val)))))) 19 | 20 | (deftest pipe-test () 21 | (let ((input "hello howdy heck")) 22 | (let ((pipe (make-pipe))) 23 | (iter (for c in-sequence input) 24 | (write-char c pipe) 25 | (is (equal c (read-char pipe))))) 26 | (is (equal input 27 | (let ((pipe (make-pipe))) 28 | (iter (for c in-sequence input) 29 | (write-char c pipe)) 30 | (iter (for c = (read-char pipe nil nil)) 31 | (while c) 32 | (collect c result-type 'string))))))) 33 | 34 | -------------------------------------------------------------------------------- /fifo-pipe.lisp: -------------------------------------------------------------------------------- 1 | 2 | (in-package :cl-plumbing) 3 | 4 | ;; This is annoying, but in certain lisps (the ones that uses buffered output) 5 | ;; you need to make sure that the output is flushed because otherwise the read 6 | ;; will not see anything and will hang. One reason that this bites us here much 7 | ;; more than usual is because the stream is still open even after we are done 8 | ;; with the output. This is because, in part, I use a :io stream. 9 | 10 | ;; However, this does in fact work, if you finess it. See the example: 11 | 12 | ;; (with-open-stream (pipe (make-pipe)) 13 | ;; (let ((*standard-output* pipe)) 14 | ;; (print 'hello) 15 | ;; (force-output)) 16 | ;; (print (read pipe))) 17 | 18 | (defun make-pipe () 19 | "This makes a stream where you can write your output, then read it out 20 | elsewhere." 21 | (let ((random-fifo (format nil "/tmp/cl-plumbing-tmp-pipe-~A-~A" 22 | (get-universal-time) (random 1000000)))) 23 | #>(mkfifo ,random-fifo) 24 | (let ((str (open (pathname random-fifo) :direction :io :if-exists :overwrite))) 25 | (trivial-garbage:finalize 26 | str 27 | (lambda () #>(rm -f ,random-fifo))) 28 | str))) 29 | -------------------------------------------------------------------------------- /gray-streams-pipe.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-plumbing) 2 | 3 | ;; Gray Stream version 4 | 5 | (defclass pipe (trivial-gray-streams:fundamental-input-stream 6 | trivial-gray-streams:fundamental-output-stream 7 | trivial-gray-streams:trivial-gray-stream-mixin) 8 | ((lock :initform (bordeaux-threads:make-lock) :accessor lock-of) 9 | (input :initarg :input :accessor input-of) 10 | (output :initarg :output :accessor output-of))) 11 | 12 | ;; (defmethod stream-element-type ((stream pipe)) 13 | ;; (stream-element-type (output-of stream))) 14 | 15 | (defmethod trivial-gray-streams:stream-write-char ((p pipe) character) 16 | (bt:with-lock-held ((lock-of p)) 17 | (write-char character (output-of p)))) 18 | 19 | (defun flush-in-to-out (pipe) 20 | (let ((string (get-output-stream-string (output-of pipe)))) 21 | (when (> (length string) 0) 22 | (setf (input-of pipe) 23 | (make-concatenated-stream 24 | (input-of pipe) 25 | (make-string-input-stream string)))))) 26 | 27 | (defmethod trivial-gray-streams:stream-read-char ((p pipe)) 28 | (iter 29 | (bt:with-lock-held ((lock-of p)) 30 | (let ((eof (not (open-stream-p (output-of p))))) 31 | (flush-in-to-out p) 32 | (let ((result (read-char (input-of p) nil :eof))) 33 | (cond ((not (equal :eof result)) (return result)) 34 | ((and eof (equal :eof result)) (return :eof)) 35 | (t nil))))) 36 | ;; Is there a way to remove this polling delay? Perhaps it isn't a big 37 | ;; deal. 38 | (sleep .01))) 39 | 40 | (defmethod trivial-gray-streams:stream-read-char-no-hang ((p pipe)) 41 | (block nil 42 | (bt:with-lock-held ((lock-of p)) 43 | (let ((eof (not (open-stream-p (output-of p))))) 44 | (flush-in-to-out p) 45 | (let ((result (read-char (input-of p) nil :eof))) 46 | (cond ((not (equal :eof result)) (return result)) 47 | ((and eof (equal :eof result)) (return :eof)) 48 | (t nil))))))) 49 | 50 | (defmethod trivial-gray-streams:stream-unread-char ((p pipe) character) 51 | (bt:with-lock-held ((lock-of p)) 52 | (unread-char character (input-of p)))) 53 | 54 | (defparameter *block-size* 1024) 55 | 56 | (defmethod trivial-gray-streams:stream-read-line ((p pipe)) 57 | (let ((consumed nil)) 58 | (unwind-protect 59 | (iter 60 | (bt:with-lock-held ((lock-of p)) 61 | (flush-in-to-out p) 62 | (let* ((eof (not (open-stream-p (output-of p)))) 63 | (seq (make-array (list *block-size*))) 64 | (n-read (read-sequence seq (input-of p))) 65 | (newline-marker (iter (for char in-sequence seq with-index i) 66 | (while (< i n-read)) 67 | (finding i such-that (eql char #\Newline))))) 68 | (cond ((and newline-marker (< newline-marker n-read)) 69 | (setf (input-of p) (make-concatenated-stream 70 | (make-string-input-stream 71 | (coerce (subseq seq (+ newline-marker 1) n-read) 72 | 'string)) 73 | (input-of p))) 74 | (let ((c consumed)) 75 | (setf consumed nil) 76 | (return (coerce (apply #'concatenate 77 | 'string 78 | (reverse 79 | (cons 80 | (subseq seq 0 newline-marker) 81 | c))) 82 | 'string)))) 83 | (eof (let ((c consumed)) 84 | (setf consumed nil) 85 | (return 86 | (values (coerce (apply #'concatenate 87 | 'string 88 | (reverse 89 | (cons 90 | (subseq seq 0 n-read) 91 | c))) 92 | 'string) t)))) 93 | (t (push (subseq seq 0 n-read) consumed))))) 94 | ;; Block until there is more to read. 95 | (unread-char (read-char p) p)) 96 | (setf (input-of p) 97 | (apply 98 | 'make-concatenated-stream 99 | (reverse 100 | (cons (input-of p) 101 | (mapcar 102 | (lambda (x) (make-string-input-stream (coerce x 'string))) 103 | consumed)))))))) 104 | 105 | (defmethod trivial-gray-streams:stream-read-sequence 106 | ((p pipe) seq start end &key &allow-other-keys) 107 | (bt:with-lock-held ((lock-of p)) 108 | (flush-in-to-out p) 109 | (read-sequence seq (input-of p) :start start :end end))) 110 | 111 | (defmethod trivial-gray-streams:stream-write-sequence 112 | ((p pipe) seq start end &key &allow-other-keys) 113 | (bt:with-lock-held ((lock-of p)) 114 | (write-sequence seq (output-of p) :start start :end end))) 115 | 116 | (defmethod trivial-gray-streams:stream-line-column ((p pipe)) 117 | 0) 118 | 119 | (defmethod close ((p pipe) &key abort) 120 | (declare (ignore abort)) 121 | (close (output-of p))) 122 | 123 | (defun make-pipe () 124 | "This makes a stream where you can write your output, then read it out 125 | elsewhere." 126 | (make-instance 'pipe 127 | :input (make-string-input-stream "") 128 | :output (make-string-output-stream))) 129 | --------------------------------------------------------------------------------