From 5a6989b5fd95f5876ccfff437eddab584b037395 Mon Sep 17 00:00:00 2001 From: Kevin Downey Date: Sat, 19 May 2012 16:51:13 -0700 Subject: [PATCH] init --- .gitignore | 8 +++ README.org | 25 ++++++++ project.clj | 6 ++ src/polycosm/primus.clj | 111 ++++++++++++++++++++++++++++++++++ test/polycosm/test/primus.clj | 15 +++++ 5 files changed, 165 insertions(+) create mode 100644 .gitignore create mode 100644 README.org create mode 100644 project.clj create mode 100644 src/polycosm/primus.clj create mode 100644 test/polycosm/test/primus.clj diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..114e85a --- /dev/null +++ b/.gitignore @@ -0,0 +1,8 @@ +/pom.xml +*jar +/lib +/classes +/native +/.lein-failures +/checkouts +/.lein-deps-sum diff --git a/README.org b/README.org new file mode 100644 index 0000000..785c05b --- /dev/null +++ b/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. diff --git a/project.clj b/project.clj new file mode 100644 index 0000000..2b6cad5 --- /dev/null +++ b/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"]]) diff --git a/src/polycosm/primus.clj b/src/polycosm/primus.clj new file mode 100644 index 0000000..7b3b734 --- /dev/null +++ b/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)))))) diff --git a/test/polycosm/test/primus.clj b/test/polycosm/test/primus.clj new file mode 100644 index 0000000..7dcb73c --- /dev/null +++ b/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})))