13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; Process convience utils
;;======================================================================
(use regex)
(declare (unit process))
(declare (uses common))
(define (conservative-read port)
(let loop ((res ""))
(if (not (eof-object? (peek-char port)))
(loop (conc res (read-char port)))
res)))
(define (cmd-run-with-stderr->list cmd . params)
;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
;; (handle-exceptions
;; exn
;; (begin
;; (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " "))
;; (print " " ((condition-property-accessor 'exn 'message) exn))
;; #f)
(let-values (((fh fho pid fhe) (if (null? params)
(process* cmd)
(process* cmd params))))
(let loop ((curr (read-line fh))
(result '()))
(let ((errstr (conservative-read fhe)))
(if (not (string=? errstr ""))
(set! result (append result (list errstr)))))
(if (not (eof-object? curr))
(loop (read-line fh)
(append result (list curr)))
(begin
(close-input-port fh)
|
|
|
|
|
|
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
|
;; Process convience utils
;;======================================================================
(use regex)
(declare (unit process))
(declare (uses common))
(define (process:conservative-read port)
(let loop ((res ""))
(if (not (eof-object? (peek-char port)))
(loop (conc res (read-char port)))
res)))
(define (process:cmd-run-with-stderr->list cmd . params)
;; (print "Called with cmd=" cmd ", proc=" proc ", params=" params)
;; (handle-exceptions
;; exn
;; (begin
;; (print "ERROR: Failed to run command: " cmd " " (string-intersperse params " "))
;; (print " " ((condition-property-accessor 'exn 'message) exn))
;; #f)
(let-values (((fh fho pid fhe) (if (null? params)
(process* cmd)
(process* cmd params))))
(let loop ((curr (read-line fh))
(result '()))
(let ((errstr (process:conservative-read fhe)))
(if (not (string=? errstr ""))
(set! result (append result (list errstr)))))
(if (not (eof-object? curr))
(loop (read-line fh)
(append result (list curr)))
(begin
(close-input-port fh)
|