summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKaz Kylheku <kaz@kylheku.com>2024-04-04 19:48:34 -0700
committerKaz Kylheku <kaz@kylheku.com>2024-04-04 19:48:34 -0700
commit9e42e3c971c2c1c69d2e03752735bbbd24007b6b (patch)
tree7c5cfb7bce92ce9e4c807127a41f7031ac75ad4d
parentd01e894af245c7f8df9b193b482150a1b9725f1c (diff)
downloadtxr-9e42e3c971c2c1c69d2e03752735bbbd24007b6b.tar.gz
txr-9e42e3c971c2c1c69d2e03752735bbbd24007b6b.tar.bz2
txr-9e42e3c971c2c1c69d2e03752735bbbd24007b6b.zip
New functions for filtering through external processes.
* stdlib/getput.tl (sys:maproc-common): new function. (map-command-lines, map-command-str, map-command-buf, map-process-lines, map-process-str, map-process-buf): New functions. * autoload.c (getput_set_entries): Trigger autoload of getput module on new function symbols. * tests/018/getput.tl: New tests. * txr.1: Documented.
-rw-r--r--autoload.c2
-rw-r--r--stdlib/getput.tl46
-rw-r--r--tests/018/getput.tl8
-rw-r--r--txr.1115
4 files changed, 171 insertions, 0 deletions
diff --git a/autoload.c b/autoload.c
index 512369f2..f9e50a2c 100644
--- a/autoload.c
+++ b/autoload.c
@@ -477,6 +477,8 @@ static val getput_set_entries(val fun)
lit("command-get-buf"), lit("command-put-buf"),
lit("command-get-json"), lit("command-put-json"),
lit("command-get-jsons"), lit("command-put-jsons"),
+ lit("map-command-lines"), lit("map-process-lines"), lit("map-command-str"),
+ lit("map-process-str"), lit("map-command-buf"), lit("map-process-buf"),
lit("close-lazy-streams"),
nil
};
diff --git a/stdlib/getput.tl b/stdlib/getput.tl
index aa28b56d..c01c73c5 100644
--- a/stdlib/getput.tl
+++ b/stdlib/getput.tl
@@ -46,6 +46,22 @@
(buf-set-length b (min (+ p p) bytes)))))
b))
+(defun sys:maproc-common (cmd-lambda put-expr get-expr)
+ (tree-bind (pipe-rd . pipe-wr) (pipe)
+ (with-stream (cmd-stdout (open-fileno pipe-wr "w"))
+ (with-stream (cmd-out (open-fileno pipe-rd "r"))
+ (match-case (fork)
+ (0 (close-stream cmd-out)
+ (with-stream (cmd-in (let ((*stdout* cmd-stdout))
+ [cmd-lambda]))
+ [put-expr cmd-in])
+ (exit* 0))
+ (nil (throwf 'process-error "~s: fork failed" %fun%))
+ (@pid (close-stream cmd-stdout)
+ (let ((out [get-expr cmd-out]))
+ (wait pid)
+ out)))))))
+
(defun get-jsons (: (s *stdin*))
(when (stringp s)
(set s (make-string-byte-input-stream s)))
@@ -205,6 +221,36 @@
(with-stream (s (open-command cmd `w@mopt`))
(put-jsons seq s flat-p)))
+(defun map-command-lines (command lines : mopt)
+ (sys:maproc-common (lambda () (open-command command `w@mopt`))
+ (lambda (strm) (put-lines lines strm))
+ (lambda (strm) (lcons-force (get-lines strm)))))
+
+(defun map-process-lines (program args lines : mopt)
+ (sys:maproc-common (lambda () (open-process program `w@mopt` args))
+ (lambda (strm) (put-lines lines strm))
+ (lambda (strm) (lcons-force (get-lines strm)))))
+
+(defun map-command-str (command str : mopt)
+ (sys:maproc-common (lambda () (open-command command `w@mopt`))
+ (lambda (strm) (put-string str strm))
+ (lambda (strm) (get-string strm))))
+
+(defun map-process-str (program args str : mopt)
+ (sys:maproc-common (lambda () (open-process program `w@mopt` args))
+ (lambda (strm) (put-string str strm))
+ (lambda (strm) (get-string strm))))
+
+(defun map-command-buf (command buf : (pos 0) bytes (skip 0) mopt)
+ (sys:maproc-common (lambda () (open-command command `w@mopt`))
+ (lambda (strm) (put-buf buf pos strm))
+ (lambda (strm) (sys:get-buf-common strm bytes skip))))
+
+(defun map-process-buf (program args buf : (pos 0) bytes (skip 0) mopt)
+ (sys:maproc-common (lambda () (open-process program `w@mopt` args))
+ (lambda (strm) (put-buf buf pos strm))
+ (lambda (strm) (sys:get-buf-common strm bytes skip))))
+
(defmacro close-lazy-streams (. body)
^(let ((sys:*lazy-streams*))
(unwind-protect
diff --git a/tests/018/getput.tl b/tests/018/getput.tl
index 7e8e2be1..ed5a4e5f 100644
--- a/tests/018/getput.tl
+++ b/tests/018/getput.tl
@@ -31,3 +31,11 @@
(true (contains "syntax error" errors)) t
(true (contains "unterminated" errors)) t
(true (contains ":1" errors)) t))
+
+(mtest
+ (map-command-lines "tr '[a-z]' '[A-Z]'" '#"a b c") #"A B C"
+ (map-process-lines "tr" '#"[a-z] [A-Z]" '#"a b c") #"A B C"
+ (map-command-str "tr '[a-z]' '[A-Z]'" "abc") "ABC"
+ (map-process-str "tr" '#"[a-z] [A-Z]" "abc") "ABC"
+ (map-command-buf "tr '[a-z]' '[A-Z]'" #b'616263') #b'414243'
+ (map-process-buf "tr" '#"[a-z] [A-Z]" #b'616263') #b'414243')
diff --git a/txr.1 b/txr.1
index d236688c..260ccea8 100644
--- a/txr.1
+++ b/txr.1
@@ -65953,6 +65953,121 @@ returns, the child process terminates as if by a call to
.code exit*
with an argument of zero.
+.coNP Functions @, map-command-lines @ map-command-str and @ map-command-buf
+.synb
+.mets (map-command-lines < cmd < lines <> [ mode-opts ])
+.mets (map-command-str < cmd < str <> [ mode-opts ])
+.mets (map-command-buf < cmd < buf >> [ pos >> [ bytes <> [ skip ]]]]])
+.syne
+.desc
+The
+.codn map-command-lines ,
+.code map-command-str
+and
+.code map-command-buf
+functions filter data through an external command.
+
+The
+.meta cmd
+parameter has the same meaning as the corresponding parameter in the
+.meta open-command
+function. The command open with the
+.str w
+mode, which is implied.
+
+The
+.meta mode-opts
+optional argument, if present, specifies extra mode options,
+which must be compatible with
+.codn w .
+
+The
+.meta lines
+argument in
+.code map-command-lines
+must be a sequence of strings. These strings are transmitted to
+the command as newline-terminated lines, as if by the
+.code put-lines
+function. Simultaneously, the output of the command is read and divided into
+lines as if by the
+.code get-lines
+function. The entire output of the command is read before the
+function terminates, and the list of lines is returned.
+
+Similarly, the
+.meta str
+argument in
+.code map-command-str
+is transmitted to the executing command as its complete input, as if by
+.codn put-string .
+Simultaneously, the output of the command is captured as a single string,
+as if using the
+.code get-string
+function. That string is returned.
+
+The
+.meta buf
+argument in
+.code map-command-buf
+must be a buffer. The bytes of the buffer are transmitted to the
+executing command, whose output bytes are gathered into a new buffer
+object which is returned. The optional
+.meta pos
+argument, which defaults to zero, specifies the starting position within
+.metn buf .
+Bytes from that position to the end of the buffer are transmitted
+to the command. The optional
+.meta bytes
+argument specifies a limit on the number of bytes of the command's output that
+should be accumulated into a buffer. The default is unlimited.
+The optional
+.meta skip
+argument, defaulting to zero, specifies how many initial bytes
+of the command's output must be discarded prior to reading the
+bytes that are to be accumulated.
+
+.coNP Functions @, map-process-lines @ map-process-str and @ map-process-buf
+.synb
+.mets (map-process-lines < program < args < lines <> [ mode-opts ])
+.mets (map-process-str < program < args < str <> [ mode-opts ])
+.mets (map-process-buf < program < args < buf
+.mets \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ >> [ pos >> [ bytes <> [ skip ]]]]])
+.syne
+.desc
+The
+.codn map-process-lines ,
+.code map-process-str
+and
+.code map-process-buf
+are counterparts to
+.codn map-command-lines ,
+.code map-command-str
+and
+.code map-command-buf
+which specify the external process differently.
+
+Instead of the
+.meta cmd
+parameter, these functions feature a pair of parameters
+.meta program
+and
+.meta args
+which have the same semantics as the
+.meta program
+and
+.meta argument-list
+parameters of
+.metn open-process .
+
+Thus the relationship between these groups of three functions is
+like that between
+.code open-command
+and
+.codn open-process .
+
+In all other regards, these functions are identical to their
+counterparts.
+
.SS* I/O-Related Convenience Functions
The functions in this group create a stream, perform an I/O operation