init

.gitignore

@@ -0,0 +1,8 @@
+/pom.xml
+*jar
+/lib
+/classes
+/native
+/.lein-failures
+/checkouts
+/.lein-deps-sum

README.org

@@ -0,0 +1,25 @@
+#+TITLE: polycosm
+* Description
+  - Loads code from maven as isolated modules via jboss-module
+  - Useful for loading a legacy Clojure runtime so you can keep using
+    that one old library
+
+* Usage
+#+BEGIN_SRC clojure
+*clojure-version*
+;=> {:major 1, :minor 4, :incremental 0, :qualifier nil}
+(require '[polycosm.primus :as pp])
+;=> nil
+(def loader (pp/maven-module-loader))
+;=> #'user/loader
+(def m (pp/load-module loader '[org.clojure/clojure "1.2.1"]))
+;=> #'user/m
+(pp/evil (.getClassLoader m) '*clojure-version*)
+;=> {:major 1, :minor 2, :incremental 1, :qualifier ""}
+#+END_SRC
+
+* License
+
+Copyright (C) 2012 Kevin Downey
+
+Distributed under the Eclipse Public License, the same as Clojure.

project.clj

@@ -0,0 +1,6 @@
+(defproject polycosm "0.0.1"
+  :description "expose maven dependencies via jboss modules"
+  :dependencies [[org.clojure/clojure "1.4.0"]
+                 [org.jboss.modules/jboss-modules "1.1.2.GA"]
+                 [clj-wallhack "1.0"]
+                 [com.cemerick/pomegranate "0.0.12"]])

src/polycosm/primus.clj

@@ -0,0 +1,111 @@
+(ns polycosm.primus
+  (:require [wall.hack :as wh]
+            [cemerick.pomegranate.aether :as pom])
+  (:import (org.jboss.modules ModuleIdentifier
+                              ModuleLoader
+                              ModuleSpec
+                              DependencySpec
+                              ModuleClassLoaderFactory
+                              JarFileResourceLoader
+                              ResourceLoaderSpec)
+           (java.util.jar Attributes$Name)))
+
+(defn jar-resource-loader [jar-file]
+  (first (for [c (.getDeclaredConstructors JarFileResourceLoader)]
+           (.newInstance
+            (doto c (.setAccessible true))
+            (into-array Object ["" jar-file])))))
+
+(def default-system-paths
+  #{"org/xml/sax"
+    "org/xml/sax/helpers"
+    "javax/xml/parsers"
+    "javax/transaction/xa"})
+
+(defn maven-module-loader
+  "system paths are similar to :provided scoping in maven, but for the
+  module system"
+  [& {:keys [system-paths]}]
+  (proxy [ModuleLoader] []
+    (findModule [module-id]
+      (let [mod-cord [(symbol (.getName module-id))
+                      (.getSlot module-id)]
+            dep-graph (pom/resolve-dependencies :coordinates
+                                                [mod-cord])
+            mod-spec-b (ModuleSpec/build module-id)
+            jar-file (java.util.jar.JarFile.
+                      (:file (meta (key (find dep-graph mod-cord)))))]
+        (.addDependency mod-spec-b
+                        (DependencySpec/createSystemDependencySpec
+                         (set (or system-paths default-system-paths))))
+        (doseq [[dep-name slot] (get dep-graph mod-cord)
+                :let [id (ModuleIdentifier/create
+                          (if (namespace dep-name)
+                            (str (namespace dep-name)
+                                 "/"
+                                 (name dep-name))
+                            (name dep-name)) slot)]]
+          (.addDependency
+           mod-spec-b
+           (DependencySpec/createModuleDependencySpec
+            id)))
+        (.addResourceRoot
+         mod-spec-b
+         (ResourceLoaderSpec/createResourceLoaderSpec
+          (jar-resource-loader jar-file)))
+        (when-let [manifest (.getManifest jar-file)]
+          (when-let [m-attr (.getMainAttributes manifest)]
+            (when-let [m-class (.getValue  m-attr
+                                           Attributes$Name/MAIN_CLASS)]
+              (.setMainClass mod-spec-b m-class))))
+        (.addDependency mod-spec-b
+                        (DependencySpec/createLocalDependencySpec))
+        (.create mod-spec-b)))
+    (toString []
+      (str "Maven Module Loader@" (.hashCode this)))))
+
+(defn load-module
+  "load a module using a loader. module is specified lein style"
+  [loader [id version]]
+  (.loadModule loader
+               (ModuleIdentifier/create
+                (if (namespace id)
+                  (str (namespace id)
+                       "/"
+                       (name id))
+                  (name id))
+                version)))
+
+(defn run
+  "runs the main class for a module, same thing as what would be run
+  from java -jar the-jar-file. args must be string"
+  [module & args]
+  (let [old-cl (.getContextClassLoader (Thread/currentThread))]
+        (try
+          (.setContextClassLoader (Thread/currentThread)
+                                  (.getClassLoader module))
+          (.run module (into-array String args))
+          (finally
+            (.setContextClassLoader (Thread/currentThread) old-cl)))))
+
+(defn evil [cl form]
+  (read-string
+   (let [form-str (pr-str form)
+         old-cl (.getContextClassLoader (Thread/currentThread))]
+       (try
+         (.setContextClassLoader (Thread/currentThread) cl)
+         (let [rt (.loadClass cl "clojure.lang.RT")
+               compiler (.loadClass cl "clojure.lang.Compiler")
+               var- (fn [s]
+                      (wh/method
+                       rt :var [String String] nil (namespace s) (name s)))
+               class (fn [x] (.loadClass cl (name x)))
+               deref (fn [x] (wh/method (.getClass x) :deref [] x))
+               invoke (fn [x &  args] (wh/method (.getClass x) :invoke []))
+               read-string (fn [s]
+                             (wh/method rt :readString [String] nil s))
+               eval (fn [f]
+                      (wh/method compiler :eval [Object] nil f))]
+           (eval (read-string (format "(pr-str %s)" form-str))))
+         (finally
+           (.setContextClassLoader (Thread/currentThread) old-cl))))))

test/polycosm/test/primus.clj

@@ -0,0 +1,15 @@
+(ns polycosm.test.primus
+  (:use [polycosm.primus]
+        [clojure.test]))
+
+(deftest t-stuff
+  (let [l (maven-module-loader)
+        c12 (load-module l '[org.clojure/clojure "1.2.0"])
+        c13 (load-module l '[org.clojure/clojure "1.3.0"])
+        c14 (load-module l '[org.clojure/clojure "1.4.0"])]
+    (are [module map] (= (evil (.getClassLoader module)
+                               '*clojure-version*)
+                         map)
+         c12 {:major 1, :minor 2, :incremental 0, :qualifier ""}
+         c13 {:major 1, :minor 3, :incremental 0, :qualifier nil}
+         c14 {:major 1, :minor 4, :incremental 0, :qualifier nil})))