using-popen.scm 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134
  1. ;;; ABOUT
  2. ;; The examples in this document were posted on the Guile
  3. ;; user mailing list and are not originally written by me
  4. ;; (zelphirkaltstahl@posteo.de).
  5. ;; Comments, some formatting and editing by me
  6. ;; (zelphirkaltstahl@posteo.de).
  7. ;;; PIPES
  8. ;; For process communication pipes are useful. A pipe is a
  9. ;; pair of 2 ports. An input port and an output port. With
  10. ;; such ports it is possible for a process to output
  11. ;; messages to the output port, which in turn enables the
  12. ;; parent process to read those messages from the input port
  13. ;; of the pair of ports. The ports are coupled together as
  14. ;; such.
  15. ;; The official docs are at:
  16. ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html#index-pipe-2
  17. ;; Some of the used procedures are for dealing with
  18. ;; ports. Official documentation about ports is at:
  19. ;; https://www.gnu.org/software/guile/manual/html_node/Ports-and-File-Descriptors.html
  20. ;; The following code is adapted from a post on the Guile
  21. ;; user mailing list, posted by post@thomasdanckaert.be and
  22. ;; is part of
  23. ;; https://github.com/tdanckaert/jobview/blob/master/jobtools.scm#L38.
  24. (import (ice-9 popen)
  25. (ice-9 textual-ports))
  26. ;; Workaround for the bug:
  27. (match-let (((input . output) (pipe)))
  28. ;; Hack to work around Guile bug 52835
  29. (define dup-output (duplicate-port output "w"))
  30. ;; Void pipe, but holds the pid for close-pipe.
  31. (define dummy-pipe
  32. (with-input-from-file "/dev/null"
  33. (lambda ()
  34. (with-output-to-port output
  35. (lambda ()
  36. (with-error-to-port dup-output
  37. (lambda ()
  38. (apply open-pipe* (cons "" command)))))))))
  39. (close-port output)
  40. (close-port dup-output)
  41. (handler input)
  42. (close-port input)
  43. (close-pipe dummy-pipe))
  44. ;; on mailing list
  45. ;; by neiljerram@gmail.com
  46. ;; Another example, for reading transactions out of a Ledger file:
  47. (use-modules (ice-9 popen))
  48. (define (ledger-transactions filename account payee commodity year)
  49. (let* ((cmd (string-append "ledger -f " filename))
  50. (cmd-add! (lambda strings (set! cmd (apply string-append cmd
  51. " " strings)))))
  52. (if payee
  53. (cmd-add! "-l 'payee=~/" payee "/'"))
  54. (if year
  55. (cmd-add! "--begin " (number->string year) " --end "
  56. (number->string (1+ year))))
  57. (cmd-add! "reg")
  58. (if account
  59. (cmd-add! account))
  60. (cmd-add! "-F '(\"%(format_date(date, \"%Y-%m-%d\"))\" \"%P\" \"%(t)\")\n'")
  61. (let ((p (open-input-pipe cmd)))
  62. (let loop ((txs '()))
  63. (let ((tx (read p)))
  64. (if (eof-object? tx)
  65. (reverse! txs)
  66. (begin
  67. (if commodity
  68. (set-car! (cddr tx) (string-replace-substring
  69. (caddr tx) commodity "")))
  70. (loop (cons tx txs)))))))))
  71. ;; by olivier.dion@polymtl.ca
  72. ;; on mailing list
  73. (define-module (shell utils)
  74. #:use-module (ice-9 format)
  75. #:use-module (ice-9 popen)
  76. #:use-module (ice-9 textual-ports))
  77. (define (shell% proc fmt . args)
  78. (let* ((port (open-input-pipe (format #f "~?" fmt args)))
  79. (output (proc port)))
  80. (close-pipe port)
  81. output))
  82. (define-public (shell . args)
  83. (apply shell% (cons get-string-all args)))
  84. (define-public (shell$ . args)
  85. (apply shell% (cons get-line args)))
  86. ;; Then
  87. (shell "ls" "-l")
  88. ;; The $ variant is to get a single line in the output.
  89. ;; on: mailing list
  90. ;; response by: leo.butler@umanitoba.ca
  91. ;; "You probably want to inspect the exit value of the shell process,
  92. ;; so that you can handle/throw the error. This is what I use (similar
  93. ;; to your `shell'):"
  94. (define* (shell-command-to-string cmd)
  95. (catch 'shell-command-error
  96. ;; thunk
  97. (lambda ()
  98. (let* ((port (open-pipe cmd OPEN_READ))
  99. (str (read-string port))
  100. (wtpd (close-pipe port))
  101. (xval (status:exit-val wtpd)))
  102. (if (or (eqv? xval #f) (> xval 0)) (throw 'shell-command-error cmd str))
  103. str))
  104. ;; handler
  105. (lambda (key cmd str)
  106. (simple-format #t "ERROR: in command ~a\nstring: ~a\n" cmd str)
  107. (throw 'error-in-shell-command-to-string cmd str))))