posix-pipes.lisp (3437 bytes)
1 ;;;; pulled straight from CLOCC 2 3 (in-package #:posix-pipes) 4 5 (defun pipe-output (prog &rest args) 6 "Return an output stream which will go to the command." 7 #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args) 8 :input :stream :wait nil) 9 #+clisp (ext:make-pipe-output-stream (format nil "~a~{ ~a~}" prog args)) 10 #+cmu (ext:process-input (ext:run-program prog args :input :stream 11 :output t :wait nil)) 12 #+ecl (ext:run-program prog args :input :stream 13 :output t :wait nil) 14 #+gcl (si::fp-input-stream (apply #'si:run-process prog args)) 15 #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args) 16 :direction :output) 17 #+lucid (lcl:run-program prog :arguments args :wait nil :output :stream) 18 #+sbcl (sb-ext:process-input (sb-ext:run-program prog args :input :stream 19 :output t :wait nil)) 20 #-(or allegro clisp cmu gcl lispworks lucid sbcl ecl) 21 (error 'not-implemented :proc (list 'pipe-output prog args))) 22 23 (defun pipe-input (prog &rest args) 24 "Return an input stream from which the command output will be read." 25 #+allegro (excl:run-shell-command (format nil "~a~{ ~a~}" prog args) 26 :output :stream :wait nil) 27 #+clisp (ext:make-pipe-input-stream (format nil "~a~{ ~a~}" prog args)) 28 #+cmu (ext:process-output (ext:run-program prog args :output :stream 29 :error t :input t :wait nil)) 30 #+ecl (two-way-stream-output-stream (ext:run-program prog args :output :stream 31 :input t :wait nil)) 32 #+gcl (si::fp-output-stream (apply #'si:run-process prog args)) 33 #+lispworks (sys::open-pipe (format nil "~a~{ ~a~}" prog args) 34 :direction :input) 35 #+lucid (lcl:run-program prog :arguments args :wait nil :input :stream) 36 #+sbcl (sb-ext:process-output (sb-ext:run-program prog args :output :stream 37 :error t :input t :wait nil)) 38 #-(or allegro clisp cmu gcl lispworks lucid sbcl ecl) 39 (error 'not-implemented :proc (list 'pipe-input prog args))) 40 41 ;;; Allegro CL: a simple `close' does NOT get rid of the process. 42 ;;; The right way, of course, is to define a Gray stream `pipe-stream', 43 ;;; define the `close' method and use `with-open-stream'. 44 ;;; Unfortunately, not every implementation supports Gray streams, so we 45 ;;; have to stick with this to further the portability. 46 ;;; [2005] actually, all implementations support Gray streams (see gray.lisp) 47 ;;; but Gray streams may be implemented inefficiently 48 49 (defun close-pipe (stream) 50 "Close the pipe stream." 51 (declare (stream stream)) 52 (close stream) 53 ;; CLOSE does not close constituent streams 54 ;; CLOSE-CONSTRUCTED-STREAM:ARGUMENT-STREAM-ONLY 55 ;; http://www.lisp.org/HyperSpec/Issues/iss052.html 56 (typecase stream 57 (two-way-stream 58 (close (two-way-stream-input-stream stream)) 59 (close (two-way-stream-output-stream stream)))) 60 #+allegro (sys:reap-os-subprocess)) 61 62 (defmacro with-open-pipe ((pipe open) &body body) 63 "Open the pipe, do something, then close it." 64 `(let ((,pipe ,open)) 65 (declare (stream ,pipe)) 66 (unwind-protect (progn ,@body) 67 (close-pipe ,pipe))))