com/github/kyleburton/sandbox/utils.clj

Line Coverage Rate: 0.3219178082191781
     Lines Covered: 94
Branch Coverage Rate: 0.07281553398058252
    Branches Covered: 15
1(ns com.github.kyleburton.sandbox.utils
2  (:require [clojure.contrib.duck-streams :as ds]))
3
4(defn raise 
5  "Simple wrapper around throw."
6  [args]
7  (throw (RuntimeException. (apply format args))))
8
9(defmacro assert-throws [& body]
10  `(let [did-throw# (atom false)]
11     (try 
12      ~body
13      (catch Exception ~'_ (reset! did-throw# true)))
14     (~'clojure.contrib.test-is/is did-throw# "Form did not throw?")))
15
16(defn log [& args]
17  (prn (apply format args)))
18
19(defn #^String get-user-home
20  "Get the user's home dir as a string."
21  []
22  (System/getProperty "user.home"))
23
24(defn #^java.io.File ->file
25  "Coerce into a File."
26  [thing]
27  (java.io.File. (str thing)))
28
29(defmacro with-tmp-file [[var & [prefix suffix]] & body]
30  `(let [prefix# ~prefix
31         suffix# ~suffix
32         ~var (java.io.File/createTempFile (or prefix# "pfx") (or suffix# "sfx"))]
33     ~@body))
34
35(defmacro with-tmp-dir [[var & [prefix suffix]] & body]
36  `(let [prefix# ~prefix
37         suffix# ~suffix
38         ~var (java.io.File/createTempFile (or prefix# "pfx") (or suffix# "sfx"))]
39     (try
40      (do
41        (.delete ~var)
42        ~@body)
43      (finally
44       ;; TODO: this will fail if dir is not empty!, should this recrusively remove all the files?
45       (.delete ~var)))))
46
47(defn basename [fname]
48  (cond (isa? fname java.io.File)
49        (.getParent fname)
50        true
51        (.getParent (java.io.File. (str fname)))))
52
53
54(defn #^java.io.File $HOME
55  "Construct a path relative to the user's home directory."
56  [& paths]
57  (->file (apply str 
58                 (cons (str (System/getProperty "user.home") "/") 
59                       (apply str (interpose "/" paths))))))
60
61(defmulti expand-file-name
62  "Perform bash style expansion on the given path.  Eg: ~/file.txt."
63  class)
64
65(defmethod expand-file-name String [#^String path]
66  (cond (.startsWith path "~/")
67        (.replaceFirst path "^~(/|$)" (str (get-user-home) "/"))
68        (.startsWith path "file://~/")
69        (.replaceFirst path "^file://~/" (str "file://" (get-user-home) "/"))
70        true
71        path))
72
73
74(defn mkdir
75  "Create the given directory path, fall back gracefuly if the path
76  exists, warning if it's not a directory."
77  [path]
78  (let [f (->file path)]
79    (if (not (.exists f))
80      (do
81        ;(log "[INFO] mkdir: creating %s" path)
82        (.mkdirs f)
83        true)
84      (if (not (.isDirectory f))
85        (do 
86          ;(log "[WARN] mkdir: %s exists and is not a directory!" path)
87          false)
88        (do
89          ;(log "[DEBUG] mkdir: exists: %s" path)
90          true)))))
91
92(defn drain-line-reader 
93  "Drain a buffered reader into a sequence."
94  [#^java.io.BufferedReader rdr]
95  (loop [res []
96         line (.readLine rdr)]
97    (if line
98      (recur (conj res line)
99             (.readLine rdr))
100      res)))
101
102(defn exec
103  "Simple wrapper around Runtime.exec - not intended to compete with clojure.contrib.shell-out"
104  [cmd]
105  (let [proc (.exec (Runtime/getRuntime) cmd)
106        rv (.waitFor proc)]
107    {:error (drain-line-reader (java.io.BufferedReader. (java.io.InputStreamReader. (.getErrorStream proc))))
108     :output (drain-line-reader (java.io.BufferedReader. (java.io.InputStreamReader. (.getInputStream proc))))
109     :exit rv}))
110
111(defn symlink
112  "Create a symlink."
113  [src dst]
114  (let [src (->file src)
115        dst (->file dst)]
116    (if (not (.exists src))
117      (raise "symlink: src does not exist: %s" src))
118    (if (.exists dst)
119      (log "[INFO] symlink: dst exists %s => %s" src dst)
120      (let [cmd (format "ln -s %s %s" src dst)
121            res (exec cmd)]
122        (log "[INFO] symlink: %s=>%s : %s" src dst cmd)
123        (if (not (= 0 (:exit res)))
124          (log "[ERROR] %s" (:error res)))))))
125
126(defn delete
127  "Remove a file if it exists."
128  [path]
129  (let [path (->file path)]
130    (if (.exists path)
131      (.delete path))))
132
133(defn url-get 
134  "Very simplistic retreival of a url target."
135  [url]
136  (with-open [is (.openStream (java.net.URL. url))]
137    (loop [sb (StringBuffer.)
138           chr (.read is)]
139      (if (= -1 chr)
140        sb
141        (do
142          (.append sb (char chr))
143          (recur sb
144                 (.read is)))))))
145
146(defn url-download
147  "Shell's out to wget to pull the file into the target directory."
148  [url #^String target-dir]
149  (let [cmd (format "wget -P %s -c %s" target-dir url)
150        res (exec cmd)]
151    (log "[INFO] wget: %s" cmd)
152    (if (not (= 0 (:exit res)))
153      (log "[ERROR] %s" (:error res)))))
154
155
156(defn all-groups 
157  "Extracts all the groups from a java.util.regex.Matcher into a seq."
158  [#^java.util.regex.Matcher m]
159  (for [grp (range 1 (+ 1 (.groupCount m)))]
160    (.group m grp)))
161
162
163(defn re-find-all
164  "Retreive all of the matches for a regex in a given string."
165  [re str]
166  (doall
167   (loop [m (re-matcher (if (isa? (class re) String) (re-pattern re) re) str)
168          res []]
169     (if (.find m)
170       (recur m (conj res (vec (all-groups m))))
171       res))))
172
173(defn re-find-first
174  "Retreive the first set of match groups for a regex in a given string."
175  [re str]
176  (first
177   (doall
178    (loop [m (re-matcher (if (isa? (class re) String) (re-pattern re) re) str)
179           res []]
180      (if (.find m)
181        (recur m (conj res (vec (all-groups m))))
182        res)))))
183
184
185;; There is no pattern matching in clojure atm, and Java6 doesn't yet
186;; support named capture groups (sure wish it did), what about a
187;; re-bind macro that created bindings for the parts?  Here is an
188;; example of what it might look like:
189
190;; (re-bind "[Nov. 18th, 2008|<b>10:03 pm</b>]"
191;;          ["\s*"
192;;           [month-name "(\S+)"] 
193;;           "\s+" 
194;;           [day-of-month "(\S+)"] ",\s+"
195;;           [year "(\S+)"] ]
196;;          {:month month-name
197;;           :day   day-of-month
198;;           :year  year})
199
200
201
202
203(defn chmod
204  "Change a file or directory's permissions.  Shells out to perform the chmod."
205  [perms file]
206  (let [cmd (format "chmod %s %s" perms file)
207        res (exec cmd)]
208    (log "[INFO] chmod: %s" cmd)
209    (if (not (= 0 (:exit res)))
210      (log "[ERROR] %s" (:error res)))))
211
212
213;; reflection class and doc utils
214(defn methods-seq
215  ([thing]
216   (if (= Class (class thing))
217     (seq (.getDeclaredMethods thing))
218     (seq (.getDeclaredMethods (class thing))))))
219
220(defn fields-seq
221  ([thing]
222   (if (= Class (class thing))
223     (seq (.getDeclaredFields thing))
224     (seq (.getDeclaredFields (class thing))))))
225
226(defn fields-value-seq
227  ([thing]
228     (map #(.get % thing) (fields-seq thing))))
229
230(defn fields-and-values-seq
231  ([thing]
232     (for [field (fields-seq thing)]
233       [(.getName field)
234        (.get field thing)])))
235
236;; this is not the same as 'bean' - bean doesn't grab fields, this
237;; grabs only fields...
238(defn fields-and-values-map
239  ([thing]
240     (reduce 
241      (fn [m [k v]]
242        (assoc m (keyword k) v))
243      {}
244      (fields-and-values-seq thing))))
245
246(defn constructors-seq
247  ([thing]
248   (if (= Class (class thing))
249     (seq (.getConstructors thing))
250     (seq (.getConstructors (class thing))))))
251
252(defn method-modifiers-as-strings [#^java.lang.reflect.Method method]
253  (str (.getModifiers method)))
254
255(defn method-return-type [#^java.lang.reflect.Method method]
256  (.getReturnType method))
257
258(defn method-name-short [#^java.lang.reflect.Method method]
259  (.getReturnType method))
260
261(defn method-argument-list [#^java.lang.reflect.Method method]
262  (.getParameterTypes method))
263
264(defn short-method-sig [#^java.lang.reflect.Method method]
265  (str (method-modifiers-as-strings method)
266        " "
267       (method-return-type method)
268        " "
269       (method-name-short method)
270        "("
271       (method-argument-list method)
272        ")"))
273
274(defn make-subst-fn [pattern replacement]
275  (fn [str]
276      (.replaceAll (.toString str)
277                    pattern replacement)))
278
279
280;; TODO: add in abstract/interface/class info, then list all parent
281;; classes and interfaces
282(defn doc-class [thing]
283  "Prints (to *out*) a summary of the class, it's members and its
284methods."
285  (let [tclass (if (= Class (class thing))
286                 (identity thing)
287                 (class thing))
288        trimmer (make-subst-fn "java.lang." "")]
289    (println (format "Class %s (%s)" (.getName tclass) (.getSuperclass tclass)))
290  (println (format "  Interfaces:"))
291  (doseq [interf (seq (.getInterfaces tclass))]
292    (println (str "    " (trimmer interf))))
293  (println (str "  Constructors:"))
294  (doseq [constructor (constructors-seq tclass)]
295    (println (str "    " (trimmer constructor))))
296  (println (str "  Members:"))
297  (doseq [field (fields-seq tclass)]
298    (println (str "    " (trimmer field))))
299  (println (str "  Methods:"))
300  (doseq [method (methods-seq tclass)]
301    (println (str "    " (trimmer method))))))
302
303
304(defn object->file [obj file]
305  (with-open [outp (java.io.ObjectOutputStream. (java.io.FileOutputStream. file))]
306    (.writeObject outp obj)))
307
308
309(defn file->object [file]
310  (with-open [inp (java.io.ObjectInputStream. (java.io.FileInputStream. file))]
311    (.readObject inp)))
312
313(defn freeze 
314  ([obj]
315     (with-open [baos (java.io.ByteArrayOutputStream. 1024)
316                 oos  (java.io.ObjectOutputStream. baos)]
317       (.writeObject oos obj)
318       (.toByteArray baos)))
319  ([obj & objs]
320     (freeze (vec (cons obj objs)))))
321
322;; (freeze "foo")
323;; (freeze "foo" "bar" "qux")
324
325
326(defn thaw [bytes]
327  (with-open [bais (java.io.ByteArrayInputStream. bytes)
328              ois  (java.io.ObjectInputStream. bais)]
329    (.readObject ois)))
330
331;; (thaw (freeze "foo"))
332
333;; (object->file "foo" ($HOME "/foo.bin"))
334;; (file->object ($HOME "/foo.bin"))
335
336(defmacro with-stdout-to-file [file & body]
337  `(with-open [out# (ds/writer ~file)]
338     (binding [*out* out#]
339       ~@body)))
340
341(defmacro with-stderr-to-file [file & body]
342  `(with-open [out# (ds/writer ~file)]
343     (binding [*err* out#]
344       ~@body)))
345
346(defn pairs->map [pairs]
347  (if (not (even? (count pairs)))
348    (throw (RuntimeException. (format "Error, pairs->map on odd # of fields? %d:(%s)" (count pairs) pairs)))
349    (reduce (fn [m [k v]] (assoc m k v))
350            {}
351            (partition 2 pairs))))
352
353
354(defn md5->string [bytes]
355  (let [digester (java.security.MessageDigest/getInstance "MD5")]
356    (.update digester bytes)
357    (apply str (map (fn [byte]
358                      (Integer/toHexString (bit-and 0xFF byte)))
359                    (.digest digester)))))
360
361(defn sha1->string [bytes]
362  (let [digester (java.security.MessageDigest/getInstance "SHA1")]
363    (.update digester bytes)
364    (apply str (map (fn [byte]
365                      (Integer/toHexString (bit-and 0xFF byte)))
366                    (.digest digester)))))
367
368;; (md5->string (.getBytes "foo bar\n"))
369;; (sha1->string (.getBytes "foo bar\n"))
370
371
372
373
374
375
376;; console is not available through slime :(, but X is - try using swing/get-password-dialog instead
377;; (String. (.readPassword console "[%s]", (into-array ["password"])))
378
379
380(defn parse-paired-arglist
381  "Ensures the given set of key/value pairs is a map, extracting non
382'pair' arguments into an additional list.  Eg:
383
384  (parse-paired-arglist [:foo 1 :bar 2])     => [[]    {:bar 2, :foo 1}]
385  (parse-paired-arglist [:foo 1 :bar 2])     => [[]    {:bar 2, :foo 1}]
386  (parse-paired-arglist [:foo 1 3 4 :bar 2]) => [[3 4] {:bar 2, :foo 1}]
387
388This is most useful in functions where you want to be able to take
389sets of optional parameters:
390
391  (defn my-func [arg1 & params]
392    (let [[additional args] (parse-paired-arglist params)
393          args (merge {:foo \"default\" :bar \"default\"} args)]
394      (prn (format \"foo=%s; bar=%s; qux=%s\"
395                   (:foo args)
396                   (:bar args)
397                   (:qux args)))))
398  (my-func 1)                      => \"foo=default; bar=default; qux=null\"
399  (my-func 1 :foo 2)               => \"foo=2; bar=default; qux=null\"
400  (my-func 1 :bar 3 :qux 4)        => \"foo=default; bar=3; qux=4\"
401  (my-func 1 :foo 2 :bar 3 :qux 4) => \"foo=2; bar=3; qux=4\"
402"
403  [args]
404  (if (map? args)
405    [[] args]
406    (loop [res {} 
407           unnamed []
408           [arg & args] args]
409      (if (not arg)
410        [unnamed res]
411        (if (keyword? arg)
412          (recur (assoc res arg (first args))
413                 unnamed
414                 (rest args))
415          (recur res
416                 (conj unnamed arg)
417                 args))))))
418
419;; (parse-paired-arglist '[:foo bar this that :other thing])
420;; (parse-paired-arglist {:foo 'bar :other 'thing})
421