Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: cb9c258531
Fetching contributors…

Cannot retrieve contributors at this time

147 lines (128 sloc) 4.347 kb
(:require [conch.core :as conch]
[ :as io]
[clojure.string :as string]
[useful.seq :as seq])
(:import java.util.concurrent.LinkedBlockingQueue))
(defprotocol Redirectable
(redirect [this options k proc]))
(redirect [f options k proc]
(with-open [writer ( f)]
(doseq [x (get proc k)]
(.write writer x)))))
(extend-type clojure.lang.IFn
(redirect [f options k proc]
(doseq [buffer (get proc k)]
(f buffer proc)))))
(defn seqify? [options k]
(let [seqify (:seq options)]
(or (= seqify k)
(= seqify :out k)
(and (true? seqify) (= k :out)))))
(extend-type nil
(redirect [_ options k proc]
(let [seqify (:seq options)
s (k proc)]
(seqify? options k) s
(string/join s)))))
(defn add-proc-args [args options]
(if (seq options)
(apply concat args
(select-keys options
(defn queue-seq [q]
(let [x (.take q)]
(when-not (= x :eof)
(cons x (queue-seq q))))))
(defmulti buffer (fn [kind _]
(if (number? kind)
(defmethod buffer :number [kind reader]
(let [buf (make-array Character/TYPE kind)]
(when (pos? (.read reader buf))
(apply str buf)))
;; and wave 'em like we just don't care
(catch _)))
(defmethod buffer :none [_ reader]
(let [c (.read reader)]
(when (pos? c)
(char c)))
(catch _)))
(defmethod buffer :line [_ reader]
(.readLine reader)
(catch _)))
(defn queue-stream [stream buffer-type]
(let [reader (io/reader stream)
queue (LinkedBlockingQueue.)]
(fn []
(doseq [x (take-while identity (repeatedly (buffer buffer-type reader)))]
(.put queue x))
(.put queue :eof))))
(queue-seq queue)))
(defn queue-output [proc buffer-type]
(assoc proc
:out (queue-stream (:out proc) buffer-type)
:err (queue-stream (:err proc) buffer-type)))
(defn run-command [name args options]
(let [proc (apply conch/proc name (add-proc-args args options))
options (update-in options [:buffer] #(or %
(if (:seq options)
{:keys [buffer out in err timeout verbose]} options
proc (queue-output proc buffer)
exit-code (future (if timeout
(conch/exit-code proc timeout)
(conch/exit-code proc)))]
(when in (conch/feed-from-string proc (:in proc))) ;; This will become more sophisticated.
(let [proc-out (redirect out options :out proc)
proc-err (redirect err options :err proc)]
verbose {:proc proc
:exit-code @exit-code
:stdout proc-out
:stderr proc-err}
(= (:seq options) :err) proc-err
:else proc-out))))
(defn execute [name & args]
(let [end (last args)
options (when (map? end) end)
args (if options (drop-last args) args)]
(if (:background options)
(future (run-command name args options))
(run-command name args options))))
(defmacro programs
"Creates functions corresponding to progams on the PATH, named by names."
[& names]
`(do ~@(for [name names]
`(defn ~name [& ~'args]
(apply execute ~(str name) ~'args)))))
(defn- program-form [prog]
`(fn [& args#] (apply execute ~prog args#)))
(defmacro let-programs
"Like let, but expects bindings to be symbols to strings of paths to
[bindings & body]
`(let [~@(seq/map-nth #(program-form %) 1 2 bindings)]
(defmacro with-programs
"Like programs, but only binds names in the scope of the with-programs call."
[programs & body]
`(let [~@(interleave programs (map (comp program-form str) programs))]
Jump to Line
Something went wrong with that request. Please try again.