;; data/core/pipe.scm - pipe handling
;;
;; Copyright (C) 2000 Martin Grabmueller <mgrabmue@cs.tu-berlin.de>
;;
;; This is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; 
;; This software is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.
;; 
;; You should have received a copy of the GNU General Public License
;; along with this package; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.  

(define-module (core pipe) :use-module (core posix))

(export open-input-pipe open-output-pipe pipe-through close-pipe)

(define *child-list* (make-hash 13))

;;;
;;; FIXME: Add the following procedure to the reference manual
;;;


;; Create a process with the command line `cmd-line' and return an
;; input port which reads from the standard output of the new process.

(define (open-input-pipe cmd-line)
  (let ((ports (pipe))
	(pid (fork)))
    (cond ((= pid 0)			; Child
	   (close-input-port (car ports))
	   (dup2 (fileno (cdr ports)) 1)
	   (execlp "sh" (list "sh" "-c" cmd-line))
	   (throw 'pipe-error "Cannot execlp"))
	  (else				; Parent process
	   (hashq-create-handle! *child-list* (car ports) pid)
	   (close-output-port (cdr ports))
	   (car ports)))))


;; Create a process with the command line `cmd-line' and return an
;; output port which is connected to the standard input of the new
;; process.

(define (open-output-pipe cmd-line)
  (let ((ports (pipe))
	(pid (fork)))
    (cond ((= pid 0)			; Child
	   (close-input-port (cdr ports))
	   (dup2 (fileno (car ports)) 0)
	   (execlp "sh" (list "sh" "-c" cmd-line))
	   (throw 'pipe-error "Cannot execlp"))
	  (else				; Parent process
	   (hashq-create-handle! *child-list* (cdr ports) pid)
	   (close-input-port (car ports))
	   (cdr ports)))))


;; Create an input pipe reading from the output of `in-cmdline', an
;; output pipe writing to process `out-cmdline', and pipe the output
;; of the former into the latter.

(define (pipe-through in-cmdline out-cmdline)
  (let ((in (open-input-pipe in-cmdline))
	(out (open-output-pipe out-cmdline)))
    (let lp ((ch (read-char in)))
      (if (not (eof-object? ch))
	  (begin
	    (write-char ch out)
	    (lp (read-char in)))))
    (close-pipe in)
    (close-pipe out)))


;; Close the pipe `pipe'.  This is required to get rid of the process
;; connected to the pipe.  Also flushes any pending output.

(define (close-pipe pipe)
  (let ((p (hashq-get-handle *child-list* pipe)))
    (if p
	(begin
	  (close-port (car p))
	  (waitpid (cdr p))
	  (hashq-remove! *child-list* pipe)
	  (if #f #f)))))
