1 | ;;;; The ABCL specific overrides in ASDF. |
---|
2 | ;;;; |
---|
3 | ;;;; Done separately from asdf.lisp for stability. |
---|
4 | (require :asdf) |
---|
5 | (in-package :asdf) |
---|
6 | |
---|
7 | (defclass iri (component) |
---|
8 | ((schema :initform nil) |
---|
9 | (authority :initform nil) |
---|
10 | (path :initform nil) |
---|
11 | (query :initform nil) |
---|
12 | (fragment :initform nil))) |
---|
13 | |
---|
14 | (defclass mvn (iri) |
---|
15 | ((group-id :initarg :group-id :initform nil) |
---|
16 | (artifact-id :initarg :artifact-id :initform nil) |
---|
17 | (repository :initarg :repository :initform "http://repo1.maven.org/maven2/") ;;; XXX unimplemented |
---|
18 | (resolved-classpath :initform nil :accessor resolved-classpath) |
---|
19 | (classname :initarg :classname :initform nil) |
---|
20 | (alternate-uri :initarg :alternate-uri :initform nil) |
---|
21 | ;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01 |
---|
22 | #+nil (version :initform nil))) |
---|
23 | |
---|
24 | #+nil |
---|
25 | (defmethod find-component ((component iri) path) |
---|
26 | component) |
---|
27 | |
---|
28 | |
---|
29 | ;;; We intercept compilation to ensure that load-op will succeed |
---|
30 | (defmethod perform ((op compile-op) (c mvn)) |
---|
31 | (unless (resolved-classpath c) |
---|
32 | (setf (resolved-classpath c) |
---|
33 | (abcl-asdf:resolve |
---|
34 | (ensure-parsed-mvn c))))) |
---|
35 | |
---|
36 | (defmethod perform ((operation load-op) (c mvn)) |
---|
37 | (let ((resolved-classpath (resolved-classpath c))) |
---|
38 | (when (stringp resolved-classpath) |
---|
39 | (java:add-to-classpath (abcl-asdf:as-classpath resolved-classpath))))) |
---|
40 | |
---|
41 | ;;; A Maven URI has the form "mvn:group-id/artifact-id/version" |
---|
42 | ;;; |
---|
43 | ;;; Sometimes people write "group-id:artifact-id:version" to refer to |
---|
44 | ;;; Maven artifacts. One can use ABCL-ASDF:RESOLVE directly for |
---|
45 | ;;; serialized references to artifacts of this form. |
---|
46 | ;;; |
---|
47 | ;;; Currently we "stuff" the group-id/artifact-id into the 'name' and |
---|
48 | ;;; use the component 'version' for the version. Parts of ASDF |
---|
49 | ;;; *reallY* want ASDF:VERSION to be a triple of intergers, and never |
---|
50 | ;;; anything more, so that is part of the motivation behind this effort. |
---|
51 | (defparameter *mvn-repositories* nil |
---|
52 | "A list of all Maven repositories encountered in the lifetime of this instance of the implementation.") |
---|
53 | |
---|
54 | #+nil |
---|
55 | (defmethod slot-missing ((class mvn) object slot-name operation &optional new-value) |
---|
56 | (setf (slot-value object slot-name) |
---|
57 | (if new-value |
---|
58 | new-value |
---|
59 | nil))) |
---|
60 | |
---|
61 | (defun ensure-parsed-mvn (component) |
---|
62 | (with-slots (name group-id artifact-id |
---|
63 | version schema path repository) |
---|
64 | component |
---|
65 | (when (null asdf::artifact-id) |
---|
66 | (let ((parsed (abcl-asdf::split-string name "/")) |
---|
67 | (asdf-version-p (slot-boundp component 'version)) |
---|
68 | (default-version "LATEST")) |
---|
69 | (cond ((= (length parsed) 3) |
---|
70 | (setf |
---|
71 | group-id (first parsed) |
---|
72 | artifact-id (second parsed) |
---|
73 | version (third parsed))) |
---|
74 | ((= (length parsed) 2) |
---|
75 | (setf |
---|
76 | group-id (first parsed) |
---|
77 | artifact-id (second parsed) |
---|
78 | version (if asdf-version-p |
---|
79 | version |
---|
80 | default-version))) |
---|
81 | (t |
---|
82 | (error "Failed to construct a mvn reference from name '~A' and version '~A'" |
---|
83 | name version))) |
---|
84 | (setf schema "mvn") |
---|
85 | (when repository |
---|
86 | (pushnew repository *mvn-repositories*)) |
---|
87 | ;;; Always set path to normalized path "on the way out" to |
---|
88 | ;;; contain group-id/artifact-id/version |
---|
89 | ;;; TODO? record repository as well in path of component |
---|
90 | (setf path (format nil "~A/~A/~A" group-id artifact-id version)))) |
---|
91 | component)) |
---|
92 | |
---|
93 | (eval-when (:compile-toplevel :load-toplevel :execute) |
---|
94 | (export `(mvn iri ensure-parsed-mvn group-id artifact-id version) |
---|
95 | 'asdf)) |
---|
96 | |
---|
97 | (defmethod source-file-type ((component iri) (system system)) |
---|
98 | nil) |
---|
99 | |
---|
100 | (defmethod component-relative-pathname ((component iri)) |
---|
101 | nil) |
---|
102 | |
---|
103 | (in-package #:abcl-asdf) |
---|
104 | |
---|
105 | (defgeneric resolve (something) |
---|
106 | (:documentation "Returns a string in JVM CLASSPATH format as entries delimited by classpath separator string.")) |
---|
107 | |
---|
108 | (defmethod resolve ((mvn-component asdf::mvn)) |
---|
109 | "Resolve all runtime dependencies of MVN-COMPONENT. |
---|
110 | |
---|
111 | Returns either a string in jvm classpath format as entries delimited |
---|
112 | by classpath separator string or T. If the value T is returned, it |
---|
113 | denotes that current JVM already has already loaded a given class. Can possibly be a |
---|
114 | single entry denoting a remote binary artifact." |
---|
115 | (asdf:ensure-parsed-mvn mvn-component) |
---|
116 | (let ((name (slot-value mvn-component 'asdf::name)) |
---|
117 | (group-id (slot-value mvn-component 'asdf::group-id)) |
---|
118 | (artifact-id (slot-value mvn-component 'asdf::artifact-id)) |
---|
119 | (classname (slot-value mvn-component 'asdf::classname)) |
---|
120 | (alternate-uri (slot-value mvn-component 'asdf::alternate-uri)) |
---|
121 | (repository (slot-value mvn-component 'asdf::repository)) |
---|
122 | (version (if (slot-value mvn-component 'asdf::version) |
---|
123 | (slot-value mvn-component 'asdf::version) |
---|
124 | "LATEST"))) |
---|
125 | (handler-case |
---|
126 | (when (and classname |
---|
127 | (jss:find-java-class classname)) |
---|
128 | (warn "Not loading ~A from the network because ~A is present in classpath." |
---|
129 | name classname) |
---|
130 | (return-from resolve t)) |
---|
131 | (java:java-exception (e) |
---|
132 | (unless (java:jinstance-of-p (java:java-exception-cause e) |
---|
133 | "java.lang.ClassNotFoundException") |
---|
134 | (error "Unexpected Java exception~&~A.~&" e)))) |
---|
135 | (if (find-mvn) |
---|
136 | (resolve-dependencies group-id artifact-id |
---|
137 | :version version |
---|
138 | :repository repository) |
---|
139 | (if alternate-uri |
---|
140 | (values (pathname alternate-uri) alternate-uri) |
---|
141 | (error "Failed to resolve MVN component name ~A." name))))) |
---|
142 | |
---|
143 | (defmethod resolve ((uri pathname)) |
---|
144 | (warn "Unimplemented.")) |
---|
145 | |
---|
146 | (defun as-classpath (classpath) |
---|
147 | "Break apart the JVM CLASSPATH string into a list of its consituents." |
---|
148 | (split-string classpath |
---|
149 | (java:jfield "java.io.File" "pathSeparator"))) |
---|
150 | |
---|
151 | (defun split-string (string split-char) |
---|
152 | (loop :for i = 0 :then (1+ j) |
---|
153 | :as j = (position split-char string :test #'string-equal :start i) |
---|
154 | :collect (subseq string i j) |
---|
155 | :while j)) |
---|