1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798 |
- ;;; ABOUT
- ;; The examples in this document were posted on the Guile
- ;; user mailing list and are not originally written by me
- ;; zelphirkaltstahl@posteo.de.
- ;; Comments, some formatting and editing by me
- ;; (zelphirkaltstahl@posteo.de).
- ;; The following code is adapted from a post on the Guile
- ;; user mailing list, posted by post@thomasdanckaert.be and
- ;; is part of
- ;; https://github.com/tdanckaert/jobview/blob/master/jobtools.scm#L38.
- (import (ice-9 popen)
- (ice-9 textual-ports)
- (ice-9 exceptions)
- (ice-9 receive)
- (ice-9 match))
- ;; Removed comments to shorting this example. For more
- ;; explanation see the first example.
- (define run-command
- (λ (cmd)
- "Runs CMD as an external process, with an input port
- from which the process' stdout may be read."
- (match-let ([(err-read . err-write) (pipe)]
- [stderr (current-error-port)])
- (with-error-to-port err-write
- (λ ()
- (let* (;; Run the actual command. If an error
- ;; happens, it should write to the
- ;; err-write port. Output of the command
- ;; should be written to an output port,
- ;; which corresponds to the input-port,
- ;; which is returned by open-input-pipe.
- [in-port (open-input-pipe cmd)]
- ;; Read in block mode.
- [_ignored (setvbuf in-port 'block)]
- ;; Get command output and error output.
- [command-output (get-string-all in-port)]
- ;; Get the exit code of the command.
- [exit-code (close-pipe in-port)])
- ;; Close the port, to which the child process
- ;; was to write errors, as the child process has
- ;; finished (either successfully or
- ;; unsuccessfully, but definitely finished).
- (close-port err-write)
- (let (;; Get the error message, if there is any.
- [error-message (get-string-all err-read)])
- (values exit-code
- command-output
- error-message))))))))
- (receive (exit-code command-output error-message)
- (let ([command "echo 'bong' 1>&2"])
- (run-command command))
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (unless (string-null? command-output)
- (display (simple-format #f "command-output: \n~a" command-output)))
- (unless (string-null? error-message)
- (display (simple-format #f "error-message: \n~a" error-message))))
- (receive (exit-code command-output error-message)
- (let ([command "ls -al"])
- (run-command command))
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (unless (string-null? command-output)
- (display (simple-format #f "command-output: \n~a" command-output)))
- (unless (string-null? error-message)
- (display (simple-format #f "error-message: \n~a" error-message))))
- ;; Both, output and error:
- (receive (exit-code command-output error-message)
- (let ([command "ls -al 2>&1 && echo 'bong' 1>&2"])
- (run-command command))
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (unless (string-null? command-output)
- (display (simple-format #f "command-output: \n~a" command-output)))
- (unless (string-null? error-message)
- (display (simple-format #f "error-message: \n~a" error-message))))
- ;; With failing command:
- (receive (exit-code command-output error-message)
- (let ([command "lsasdasd -al"])
- (run-command command))
- (display (simple-format #f "exit code: ~a\n" exit-code))
- (unless (string-null? command-output)
- (display (simple-format #f "command-output: \n~a" command-output)))
- (unless (string-null? error-message)
- (display (simple-format #f "error-message: \n~a" error-message))))
|