source: trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp @ 14236

Last change on this file since 14236 was 14236, checked in by Mark Evenson, 8 years ago

abcl-asdf: Enable bypassing of loading from network if a given class already exists.

An ASDF:MVN component can now optionally specify a CLASSNAME that if
able to be found in the current jvm process, inhbits further loading
from the network.

An ASDF:MVN component may also optionally specify an ALTERNATE-URI
that will be added to the current jvm classpath if Maven cannot be
invoked. Most jvm implementations won't access such jar archives from
the network by default, so this is an intermediate step before
actually writing the code to download the jar to the local filesystem
to then be added.

Refresh documentation in README.markdown.

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