Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-07-27

KMRCLを眺める(180) COMMAND-OUTPUT

| 21:42 | KMRCLを眺める(180) COMMAND-OUTPUT - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(180) COMMAND-OUTPUT - わだばLisperになる

今回は、KMRCLのos.lispからCOMMAND-OUTPUTです。

外部のシェルでコマンドを実行したり外部コマンドの出力を取得したりしたくなることは多いと思うのですが、ANSI CLではその辺りのことは決められていませんので、実装依存になります。

しかし、大抵の実装では、外部シェルとやりとりをする一連の関数が提供されています。

COMMAND-OUTPUTはそういうコマンドを処理系に依存しないようにラッピングするものです。

動作は、

(KL:COMMAND-OUTPUT "ls -l /etc/hosts")
;⇒ "-rw-r--r--. 1 root root 1055 2010-07-24 16:51 /etc/hosts
    "
   ""
   0

で、

  1. コマンド出力の文字列
  2. エラー
  3. コマンドの終了コード

と3つの値を返すようになっていて、大体の処理系は、上記3つを取得できる関数を持っているようです。

定義は、処理系ごとに色々違うので長くなっていますが、下記のようになっています。

(defun command-output (control-string &rest args)
  "Interpolate ARGS into CONTROL-STRING as if by FORMAT, and
synchronously execute the result using a Bourne-compatible shell,
returns (VALUES string-output error-output exit-status)"
  (let ((command (apply #'format nil control-string args)))
    #+sbcl
    (let* ((process (sb-ext:run-program
                    "/bin/sh"
                    (list "-c" command)
                    :input nil :output :stream :error :stream))
           (output (read-stream-to-string (sb-impl::process-output process)))
           (error (read-stream-to-string (sb-impl::process-error process))))
      (close (sb-impl::process-output process))
      (close (sb-impl::process-error process))
      (values
       output
       error
       (sb-impl::process-exit-code process)))


    #+(or cmu scl)
    (let* ((process (ext:run-program
                     "/bin/sh"
                     (list "-c" command)
                     :input nil :output :stream :error :stream))
           (output (read-stream-to-string (ext::process-output process)))
           (error (read-stream-to-string (ext::process-error process))))
      (close (ext::process-output process))
      (close (ext::process-error process))

      (values
       output
       error
       (ext::process-exit-code process)))

    #+allegro
    (multiple-value-bind (output error status)
        (excl.osi:command-output command :whole t)
      (values output error status))

    #+lispworks
    ;; BUG: Lispworks combines output and error streams
    (let ((output (make-string-output-stream)))
      (unwind-protect
          (let ((status
                 (system:call-system-showing-output
                  command
                  :prefix ""
                  :show-cmd nil
                  :output-stream output)))
            (values (get-output-stream-string output) nil status))
        (close output)))

    #+clisp
    ;; BUG: CLisp doesn't allow output to user-specified stream
    (values
     nil
     nil
     (ext:run-shell-command  command :output :terminal :wait t))

    #+openmcl
    (let* ((process (ccl:run-program
                     "/bin/sh"
                     (list "-c" command)
                     :input nil :output :stream :error :stream
                     :wait t))
           (output (read-stream-to-string (ccl::external-process-output-stream process)))
           (error (read-stream-to-string (ccl::external-process-error-stream process))))
      (close (ccl::external-process-output-stream process))
      (close (ccl::external-process-error-stream process))
      (values output
              error
              (nth-value 1 (ccl::external-process-status process))))

    #-(or openmcl clisp lispworks allegro scl cmu sbcl)
    (error "COMMAND-OUTPUT not implemented for this Lisp")

    ))