diff options
author | Kaz Kylheku <kaz@kylheku.com> | 2024-04-04 19:48:34 -0700 |
---|---|---|
committer | Kaz Kylheku <kaz@kylheku.com> | 2024-04-04 19:48:34 -0700 |
commit | 9e42e3c971c2c1c69d2e03752735bbbd24007b6b (patch) | |
tree | 7c5cfb7bce92ce9e4c807127a41f7031ac75ad4d | |
parent | d01e894af245c7f8df9b193b482150a1b9725f1c (diff) | |
download | txr-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.c | 2 | ||||
-rw-r--r-- | stdlib/getput.tl | 46 | ||||
-rw-r--r-- | tests/018/getput.tl | 8 | ||||
-rw-r--r-- | txr.1 | 115 |
4 files changed, 171 insertions, 0 deletions
@@ -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') @@ -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 |