123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134 |
- ;;; 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).
- ;;; PIPES
- ;; For process communication pipes are useful. A pipe is a
- ;; pair of 2 ports. An input port and an output port. With
- ;; such ports it is possible for a process to output
- ;; messages to the output port, which in turn enables the
- ;; parent process to read those messages from the input port
- ;; of the pair of ports. The ports are coupled together as
- ;; such.
- ;; The official docs are at:
- ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html#index-pipe-2
- ;; Some of the used procedures are for dealing with
- ;; ports. Official documentation about ports is at:
- ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html
- ;; 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))
- ;; Workaround for the bug:
- (match-let (((input . output) (pipe)))
- ;; Hack to work around Guile bug 52835
- (define dup-output (duplicate-port output "w"))
- ;; Void pipe, but holds the pid for close-pipe.
- (define dummy-pipe
- (with-input-from-file "/dev/null"
- (lambda ()
- (with-output-to-port output
- (lambda ()
- (with-error-to-port dup-output
- (lambda ()
- (apply open-pipe* (cons "" command)))))))))
- (close-port output)
- (close-port dup-output)
- (handler input)
- (close-port input)
- (close-pipe dummy-pipe))
- ;; on mailing list
- ;; by neiljerram@gmail.com
- ;; Another example, for reading transactions out of a Ledger file:
- (use-modules (ice-9 popen))
- (define (ledger-transactions filename account payee commodity year)
- (let* ((cmd (string-append "ledger -f " filename))
- (cmd-add! (lambda strings (set! cmd (apply string-append cmd
- " " strings)))))
- (if payee
- (cmd-add! "-l 'payee=~/" payee "/'"))
- (if year
- (cmd-add! "--begin " (number->string year) " --end "
- (number->string (1+ year))))
- (cmd-add! "reg")
- (if account
- (cmd-add! account))
- (cmd-add! "-F '(\"%(format_date(date, \"%Y-%m-%d\"))\" \"%P\" \"%(t)\")\n'")
- (let ((p (open-input-pipe cmd)))
- (let loop ((txs '()))
- (let ((tx (read p)))
- (if (eof-object? tx)
- (reverse! txs)
- (begin
- (if commodity
- (set-car! (cddr tx) (string-replace-substring
- (caddr tx) commodity "")))
- (loop (cons tx txs)))))))))
- ;; by olivier.dion@polymtl.ca
- ;; on mailing list
- (define-module (shell utils)
- #:use-module (ice-9 format)
- #:use-module (ice-9 popen)
- #:use-module (ice-9 textual-ports))
- (define (shell% proc fmt . args)
- (let* ((port (open-input-pipe (format #f "~?" fmt args)))
- (output (proc port)))
- (close-pipe port)
- output))
- (define-public (shell . args)
- (apply shell% (cons get-string-all args)))
- (define-public (shell$ . args)
- (apply shell% (cons get-line args)))
- ;; Then
- (shell "ls" "-l")
- ;; The $ variant is to get a single line in the output.
- ;; on: mailing list
- ;; response by: leo.butler@umanitoba.ca
- ;; "You probably want to inspect the exit value of the shell process,
- ;; so that you can handle/throw the error. This is what I use (similar
- ;; to your `shell'):"
- (define* (shell-command-to-string cmd)
- (catch 'shell-command-error
- ;; thunk
- (lambda ()
- (let* ((port (open-pipe cmd OPEN_READ))
- (str (read-string port))
- (wtpd (close-pipe port))
- (xval (status:exit-val wtpd)))
- (if (or (eqv? xval #f) (> xval 0)) (throw 'shell-command-error cmd str))
- str))
- ;; handler
- (lambda (key cmd str)
- (simple-format #t "ERROR: in command ~a\nstring: ~a\n" cmd str)
- (throw 'error-in-shell-command-to-string cmd str))))
|