-
Notifications
You must be signed in to change notification settings - Fork 69
/
search.clj
138 lines (114 loc) · 4.42 KB
/
search.clj
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
;;;; Copied from slamhound 1.5.5
;;;; Copyright © 2011-2012 Phil Hagelberg and contributors
;;;; Distributed under the Eclipse Public License, the same as Clojure.
(ns refactor-nrepl.ns.slam.hound.search
"Search the classpath for vars and classes."
(:require [orchard.java.classpath :as cp]
[clojure.java.io :refer [file]]
[clojure.string :as string])
(:import
[java.io File FilenameFilter]
[java.util.jar JarFile JarEntry]
java.util.regex.Pattern
java.util.StringTokenizer))
;;; Mostly taken from leiningen.util.ns and swank.util.class-browse.
;; TODO: replace with bultitude? but that doesn't do classes
;;; Clojure namespaces
(defn jar? [^File f]
(and (.isFile f) (.endsWith (.getName f) ".jar")))
(defn class-file? [^String path]
(.endsWith path ".class"))
(defn clojure-fn-file? [f]
(re-find #"\$.*__\d+\.class" f))
(defn clojure-ns-file? [^String path]
(.endsWith path "__init.class"))
;;; Java classes
;; could probably be simplified
(def jar-filter
(proxy [FilenameFilter] []
(accept [d n] (jar? (file n)))))
(defn expand-wildcard
"Expands a wildcard path entry to its matching .jar files (JDK 1.6+).
If not expanding, returns the path entry as a single-element vector."
[^String path]
(let [f (File. path)]
(if (= (.getName f) "*")
(.. f getParentFile (list jar-filter))
[f])))
(defn class-or-ns-name
"Returns the Java class or Clojure namespace name for a class relative path."
[^String path]
(-> (if (clojure-ns-file? path)
(-> path (.replace "__init.class" "") (.replace "_" "-"))
(.replace path ".class" ""))
(.replace File/separator ".")))
(defmulti path-class-files
"Returns a list of classes found on the specified path location
(jar or directory), each comprised of a map with the following keys:
:name Java class or Clojure namespace name
:loc Classpath entry (directory or jar) on which the class is located
:file Path of the class file, relative to :loc"
(fn [^File f _]
(cond (.isDirectory f) :dir
(jar? f) :jar
(class-file? (.getName f)) :class)))
(defmethod path-class-files :default [& _] [])
(defmethod path-class-files :jar
;; Build class info for all jar entry class files.
[^File f ^File loc]
(let [_lp (.getPath loc)]
(try
(into ()
(comp
(map #(.getName ^JarEntry %))
(filter class-file?)
(map class-or-ns-name))
(enumeration-seq (.entries (JarFile. f))))
(catch Exception _e [])))) ; fail gracefully if jar is unreadable
(defmethod path-class-files :dir
;; Dispatch directories and files (excluding jars) recursively.
[^File d ^File loc]
(let [fs (.listFiles d (reify FilenameFilter
(accept [_ dir name]
(-> name file jar? not))))]
(into () (mapcat #(path-class-files % loc)) fs)))
(defmethod path-class-files :class
;; Build class info using file path relative to parent classpath entry
;; location. Make sure it decends; a class can't be on classpath directly.
[^File f ^File loc]
(let [fp (str f), lp (str loc)
loc-pattern (re-pattern (Pattern/quote (str "^" loc)))]
(if (re-find loc-pattern fp) ; must be descendent of loc
(let [fpr (.substring fp (inc (count lp)))]
[(class-or-ns-name fpr)])
[])))
(defn path-entries-seq
"Split a string on the 'path separator', i.e. ':'. Used for splitting multiple
classpath entries."
[path-str]
(enumeration-seq
(StringTokenizer. path-str File/pathSeparator)))
(defn all-classpath-entries []
(mapcat cp/classpath-seq (cp/classpath)))
(defn- get-available-classes []
(into ()
(comp (mapcat path-entries-seq)
(mapcat expand-wildcard)
(mapcat #(path-class-files % %))
(remove clojure-fn-file?)
(distinct)
(map symbol))
(all-classpath-entries)))
(def available-classes
(delay (get-available-classes)))
(defn- get-available-classes-by-last-segment
[]
(delay
(group-by #(symbol (peek (string/split (str %) #"\."))) @available-classes)))
(def available-classes-by-last-segment
(delay (get-available-classes-by-last-segment)))
(defn reset
"Reset the cache of classes"
[]
(alter-var-root #'available-classes (constantly (get-available-classes)))
(alter-var-root #'available-classes-by-last-segment (constantly (get-available-classes-by-last-segment))))