mirror of https://github.com/apache/jclouds.git
major update to blobstore clojure binding. factored out core.clj
This commit is contained in:
Hugo Duncan
parent
45c53489a2
commit
cb0928afae
|
|
@ -149,6 +149,11 @@
|
|||
</goals>
|
||||
</execution>
|
||||
</executions>
|
||||
<configuration>
|
||||
<testNamespaces>
|
||||
<testNamespace>!clojure.*</testNamespace>
|
||||
</testNamespaces>
|
||||
</configuration>
|
||||
</plugin>
|
||||
</plugins>
|
||||
<resources>
|
||||
|
|
|
|||
|
|
@ -1,76 +1,264 @@
|
|||
(ns
|
||||
#^{:doc
|
||||
"
|
||||
a lib for interacting with jclouds BlobStore.
|
||||
(ns org.jclouds.blobstore
|
||||
"A clojure binding for the jclouds BlobStore.
|
||||
|
||||
Current supported services are:
|
||||
[s3, azureblob, atmos, cloudfiles]
|
||||
|
||||
Here's a quick example of how to view blob resources in rackspace
|
||||
|
||||
(ns example.jclouds
|
||||
(:use org.jclouds.blobstore)
|
||||
(:use clojure.contrib.pprint)
|
||||
)
|
||||
(use 'org.jclouds.blobstore)
|
||||
(use 'clojure.contrib.pprint)
|
||||
|
||||
(def user \"rackspace_username\")
|
||||
(def password \"rackspace_password\")
|
||||
(def blobstore-name \"cloudfiles\")
|
||||
(def user \"rackspace_username\")
|
||||
(def password \"rackspace_password\")
|
||||
(def blobstore-name \"cloudfiles\")
|
||||
|
||||
(def blobstore (blobstore-context blobstore-name user password ))
|
||||
(with-blobstore [blobstore-name user password]
|
||||
(pprint (containers))
|
||||
(pprint (blobs blobstore your_container_name)))
|
||||
|
||||
(pprint (containers blobstore))
|
||||
(pprint (blobs blobstore "your_container_name" ))
|
||||
See http://code.google.com/p/jclouds for details."
|
||||
(:use org.jclouds.core)
|
||||
(:import java.io.File
|
||||
[org.jclouds.blobstore
|
||||
AsyncBlobStore BlobStore BlobStoreContext BlobStoreContextFactory
|
||||
domain.BlobMetadata domain.StorageMetadata domain.Blob
|
||||
options.ListContainerOptions]
|
||||
[com.google.common.collect ImmutableSet]))
|
||||
|
||||
"}
|
||||
org.jclouds.blobstore
|
||||
(:use clojure.contrib.duck-streams)
|
||||
(:import java.io.File)
|
||||
(:import org.jclouds.blobstore.BlobStore)
|
||||
(:import org.jclouds.blobstore.BlobStoreContext)
|
||||
(:import org.jclouds.blobstore.BlobStoreContextFactory)
|
||||
(:import org.jclouds.blobstore.domain.Blob)
|
||||
(:import org.jclouds.blobstore.options.ListContainerOptions))
|
||||
(defn blobstore
|
||||
"Create a logged in context.
|
||||
Options for communication style
|
||||
:sync and :async.
|
||||
Options can also be specified for extension modules
|
||||
:log4j :enterprise :httpnio :apachehc :bouncycastle :joda :gae
|
||||
"
|
||||
[#^String service #^String account #^String key & options]
|
||||
(let [context
|
||||
(.createContext
|
||||
(BlobStoreContextFactory.) service account key
|
||||
(apply modules (filter #(not #{:sync :async} %) options)))]
|
||||
(if (some #(= :async %) options)
|
||||
(.getAsyncBlobStore context)
|
||||
(.getBlobStore context))))
|
||||
|
||||
(defn blobstore-context
|
||||
([{service :service account :account key :key}]
|
||||
(blobstore-context service account key))
|
||||
([s a k] (.createContext (new BlobStoreContextFactory) s a k )))
|
||||
"Returns a blobstore context from a blobstore."
|
||||
[blobstore]
|
||||
(.getContext blobstore))
|
||||
|
||||
(defn containers [blobstore] (.list (.getBlobStore blobstore) ))
|
||||
(defn blobstore?
|
||||
[object]
|
||||
(or (instance? BlobStore object)
|
||||
(instance? AsyncBlobStore object)))
|
||||
|
||||
(defn blobstore-context?
|
||||
[object]
|
||||
(instance? BlobStoreContext object))
|
||||
|
||||
(defn as-blobstore
|
||||
"Tries hard to produce a blobstore from its input arguments"
|
||||
[& args]
|
||||
(cond
|
||||
(blobstore? (first args)) (first args)
|
||||
(blobstore-context? (first args)) (.getBlobStore (first args))
|
||||
:else (apply blobstore args)))
|
||||
|
||||
(def *blobstore*)
|
||||
|
||||
(defmacro with-blobstore [[& blobstore-or-args] & body]
|
||||
`(binding [*blobstore* (as-blobstore ~@blobstore-or-args)]
|
||||
~@body))
|
||||
|
||||
(defn- parse-args
|
||||
"Takes a seq of 'ssh' arguments and returns a map of option keywords
|
||||
to option values."
|
||||
[args]
|
||||
(loop [[arg :as args] args
|
||||
opts {:cmd [] :out "UTF-8"}]
|
||||
(if-not args
|
||||
opts
|
||||
(if (keyword? arg)
|
||||
(recur (nnext args) (assoc opts arg (second args)))
|
||||
(recur (next args) (update-in opts [:cmd] conj arg))))))
|
||||
|
||||
(defn- parse-args
|
||||
"Parses arguments, recognises keywords in the set single as boolean switches."
|
||||
[args single default]
|
||||
(loop [[arg :as args] args
|
||||
opts default]
|
||||
(if-not args
|
||||
opts
|
||||
(if (single arg)
|
||||
(recur (next args) (assoc opts arg true))
|
||||
(recur (nnext args) (assoc opts arg (second args)))))))
|
||||
|
||||
(def list-options
|
||||
(apply array-map
|
||||
(concat (make-option-map option-fn-0arg [:recursive])
|
||||
(make-option-map option-fn-1arg [:after-marker :in-directory :max-results]))))
|
||||
|
||||
(defn- list-options-apply
|
||||
[single target key value]
|
||||
(if (single key)
|
||||
((list-options key) target)
|
||||
((list-options key) target value))
|
||||
target)
|
||||
|
||||
(defn containers
|
||||
"List all containers in a blobstore."
|
||||
([] (containers *blobstore*))
|
||||
([blobstore] (.list blobstore)))
|
||||
|
||||
(defn list-container
|
||||
"List a container. Options are:
|
||||
:after-marker string
|
||||
:in-direcory path
|
||||
:max-results n
|
||||
:recursive"
|
||||
[blobstore & args]
|
||||
(if (blobstore? blobstore)
|
||||
(let [single-keywords #{:recursive}
|
||||
options (parse-args (next args) single-keywords {})
|
||||
list-options (reduce
|
||||
#(list-options-apply single-keywords %1 (first %2) (second %2))
|
||||
(ListContainerOptions.)
|
||||
options)]
|
||||
(.list blobstore (first args) list-options))
|
||||
(apply list-container *blobstore* blobstore args)))
|
||||
|
||||
(defn create-container
|
||||
"Create a container."
|
||||
([container-name]
|
||||
(create-container *blobstore* "default" container-name))
|
||||
([blobstore container-name]
|
||||
(if (blobstore? blobstore)
|
||||
(create-container blobstore "default" container-name)
|
||||
(create-container *blobstore* container-name blobstore)))
|
||||
([blobstore container-name location-name]
|
||||
(.createContainerInLocation blobstore container-name location-name)))
|
||||
|
||||
(defn clear-container
|
||||
"Clear a container."
|
||||
([container-name]
|
||||
(clear-container container-name))
|
||||
([blobstore container-name]
|
||||
(.clearContainer blobstore container-name)))
|
||||
|
||||
(defn delete-container
|
||||
"Delete a container."
|
||||
([container-name]
|
||||
(delete-container *blobstore* container-name))
|
||||
([blobstore container-name]
|
||||
(.deleteContainer blobstore container-name)))
|
||||
|
||||
(defn container-exists?
|
||||
"Predicate to check presence of a container"
|
||||
([container-name]
|
||||
(container-exists? *blobstore* container-name))
|
||||
([blobstore container-name]
|
||||
(.containerExists blobstore container-name)))
|
||||
|
||||
(defn directory-exists?
|
||||
"Predicate to check presence of a directory"
|
||||
([container-name path]
|
||||
(directory-exists? *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.directoryExists blobstore container-name path)))
|
||||
|
||||
(defn create-directory
|
||||
"Create a directory path."
|
||||
([container-name path]
|
||||
(create-directory *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.createDirectory blobstore container-name path)))
|
||||
|
||||
(defn delete-directory
|
||||
"Delete a directory path."
|
||||
([container-name path]
|
||||
(delete-directory *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.deleteDirectory blobstore container-name path)))
|
||||
|
||||
(defn blob-exists?
|
||||
"Predicate to check presence of a blob"
|
||||
([container-name path]
|
||||
(blob-exists? *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.blobExists blobstore container-name path)))
|
||||
|
||||
(defn put-blob
|
||||
"Put a blob. Metadata in the blob determines location."
|
||||
([container-name blob]
|
||||
(put-blob *blobstore* container-name blob))
|
||||
([blobstore container-name blob]
|
||||
(.putBlob blobstore container-name blob)))
|
||||
|
||||
(defn blob-metadata
|
||||
"Get blob metadata from given path"
|
||||
([container-name path]
|
||||
(blob-metadata *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.blobMetadata blobstore container-name path)))
|
||||
|
||||
(defn get-blob
|
||||
"Get blob from given path"
|
||||
([container-name path]
|
||||
(get-blob *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.getBlob blobstore container-name path)))
|
||||
|
||||
(defn remove-blob
|
||||
"Remove blob from given path"
|
||||
([container-name path]
|
||||
(remove-blob *blobstore* container-name path))
|
||||
([blobstore container-name path]
|
||||
(.removeBlob blobstore container-name path)))
|
||||
|
||||
(defn count-blobs
|
||||
"Count blobs"
|
||||
([container-name]
|
||||
(count-blobs *blobstore* container-name))
|
||||
([blobstore container-name]
|
||||
(.countBlob blobstore container-name)))
|
||||
|
||||
(defn blobs
|
||||
|
||||
"
|
||||
http://code.google.com/p/jclouds
|
||||
|
||||
list the blobs in a container:
|
||||
"List the blobs in a container:
|
||||
blobstore container -> blobs
|
||||
|
||||
list the blobs in a container under a path:
|
||||
blobstore container dir -> blobs
|
||||
|
||||
example: (pprint
|
||||
(blobs
|
||||
(blobstore-context flightcaster-creds)
|
||||
\"somecontainer\" \"some-dir\"))
|
||||
example:
|
||||
(pprint
|
||||
(blobs
|
||||
(blobstore-context flightcaster-creds)
|
||||
\"somecontainer\" \"some-dir\"))
|
||||
"
|
||||
([blobstore container-name]
|
||||
(.list (.getBlobStore blobstore) container-name ))
|
||||
|
||||
([blobstore container-name dir]
|
||||
(.list (.getBlobStore blobstore) container-name (.inDirectory (new ListContainerOptions) dir) ))
|
||||
)
|
||||
(.list (.getBlobStore blobstore) container-name
|
||||
(.inDirectory (new ListContainerOptions) dir))))
|
||||
|
||||
(defn put-blob
|
||||
|
||||
"
|
||||
http://code.google.com/p/jclouds
|
||||
|
||||
Create an blob representing text data:
|
||||
(defn create-blob
|
||||
"Create an blob representing text data:
|
||||
container, name, string -> etag
|
||||
"
|
||||
([container-name name data]
|
||||
(create-blob *blobstore* container-name name data))
|
||||
([blobstore container-name name data]
|
||||
(.putBlob (.getBlobStore blobstore) container-name (doto (.newBlob (.getBlobStore blobstore) name) (.setPayload data))))
|
||||
)
|
||||
(put-blob blobstore container-name
|
||||
(doto (.newBlob blobstore name)
|
||||
(.setPayload data)))))
|
||||
|
||||
|
||||
(define-accessors StorageMetadata "blob" type id name location-id uri last-modfied)
|
||||
(define-accessors BlobMetadata "blob" content-type)
|
||||
|
||||
(defn blob-etag [blob]
|
||||
(.getETag blob))
|
||||
|
||||
(defn blob-md5 [blob]
|
||||
(.getContentMD5 blob))
|
||||
|
|
|
|||
|
|
@ -1,6 +1,81 @@
|
|||
(ns org.jclouds.blobstore-test
|
||||
(:use [org.jclouds.blobstore] :reload-all)
|
||||
(:use clojure.test))
|
||||
(:use clojure.test)
|
||||
(:import org.jclouds.blobstore.integration.StubBlobStoreContextBuilder))
|
||||
|
||||
(deftest blobstore-test
|
||||
(is true))
|
||||
(def stub-context (.buildBlobStoreContext (StubBlobStoreContextBuilder.)))
|
||||
(def stub-blobstore (.getBlobStore stub-context))
|
||||
|
||||
(defn clean-stub-fixture [f]
|
||||
(doall
|
||||
(map
|
||||
#(.deleteContainer stub-blobstore (.getName %)) (.list stub-blobstore)))
|
||||
(f))
|
||||
|
||||
(use-fixtures :each clean-stub-fixture)
|
||||
|
||||
(deftest blobstore?-test
|
||||
(is (blobstore? stub-blobstore)))
|
||||
|
||||
(deftest blobstore-context?-test
|
||||
(is (blobstore-context? stub-context)))
|
||||
|
||||
(deftest blobstore-context-test
|
||||
(is (= stub-context (blobstore-context stub-blobstore))))
|
||||
|
||||
(deftest as-blobstore-test
|
||||
;(is (blobstore? (blobstore "stub" "user" "password")))
|
||||
(is (blobstore? (as-blobstore stub-blobstore)))
|
||||
(is (blobstore? (as-blobstore stub-context))))
|
||||
|
||||
(deftest with-blobstore-test
|
||||
(with-blobstore [stub-blobstore]
|
||||
(is (= stub-blobstore *blobstore*))))
|
||||
|
||||
(deftest create-container-test
|
||||
(is (not (container-exists? stub-blobstore "")))
|
||||
(with-blobstore [stub-blobstore]
|
||||
(is (not (container-exists? ""))))
|
||||
(is (create-container stub-blobstore "fred"))
|
||||
(is (container-exists? stub-blobstore "fred"))
|
||||
(with-blobstore [stub-blobstore]
|
||||
(is (container-exists? "fred"))))
|
||||
|
||||
(deftest create-container-test
|
||||
(is (create-container stub-blobstore "fred"))
|
||||
(is (container-exists? stub-blobstore "fred"))
|
||||
(with-blobstore [stub-blobstore]
|
||||
(is (create-container "fred"))
|
||||
(is (container-exists? "fred"))))
|
||||
|
||||
(deftest containers-test
|
||||
(is (empty? (containers stub-blobstore)))
|
||||
(is (create-container stub-blobstore "fred"))
|
||||
(is (= 1 (count (containers stub-blobstore)))))
|
||||
|
||||
(deftest list-container-test
|
||||
(is (create-container stub-blobstore "container"))
|
||||
(is (empty? (list-container stub-blobstore "container")))
|
||||
(is (create-blob stub-blobstore "container" "blob1" "blob1"))
|
||||
(is (create-blob stub-blobstore "container" "blob2" "blob2"))
|
||||
(is (= 2 (count (list-container stub-blobstore "container"))))
|
||||
(is (= 1 (count (list-container stub-blobstore "container" :max-results 1))))
|
||||
(create-directory stub-blobstore "container" "dir")
|
||||
(is (create-blob stub-blobstore "container" "dir/blob2" "blob2"))
|
||||
(is (= 3 (count (list-container stub-blobstore "container"))))
|
||||
(is (= 4 (count (list-container stub-blobstore "container" :recursive))))
|
||||
(is (= 1 (count (list-container stub-blobstore "container" :in-directory "dir")))))
|
||||
|
||||
(deftest list-container-with-blobstore-test
|
||||
(with-blobstore [stub-blobstore]
|
||||
(is (create-container "container"))
|
||||
(is (empty? (list-container "container")))
|
||||
(is (create-blob "container" "blob1" "blob1"))
|
||||
(is (create-blob "container" "blob2" "blob2"))
|
||||
(is (= 2 (count (list-container "container"))))
|
||||
(is (= 1 (count (list-container "container" :max-results 1))))
|
||||
(create-directory "container" "dir")
|
||||
(is (create-blob "container" "dir/blob2" "blob2"))
|
||||
(is (= 3 (count (list-container "container"))))
|
||||
(is (= 4 (count (list-container "container" :recursive))))
|
||||
(is (= 1 (count (list-container "container" :in-directory "dir"))))))
|
||||
|
|
|
|||
|
|
@ -62,6 +62,11 @@
|
|||
</goals>
|
||||
</execution>
|
||||
</executions>
|
||||
<configuration>
|
||||
<testNamespaces>
|
||||
<testNamespace>!clojure.*</testNamespace>
|
||||
</testNamespaces>
|
||||
</configuration>
|
||||
</plugin>
|
||||
</plugins>
|
||||
</build>
|
||||
|
|
|
|||
|
|
@ -1,15 +1,13 @@
|
|||
(ns
|
||||
#^{:doc "
|
||||
a lib for interacting with jclouds ComputeService.
|
||||
(ns org.jclouds.compute
|
||||
"A clojure binding to the jclouds ComputeService.
|
||||
|
||||
Current supported services are:
|
||||
[ec2, rimuhosting, terremark, vcloud, hostingdotcom]
|
||||
|
||||
Here's an example of getting some compute configuration from rackspace:
|
||||
|
||||
(ns example.jclouds
|
||||
(:use org.jclouds.compute
|
||||
clojure.contrib.pprint))
|
||||
(use 'org.jclouds.compute)
|
||||
(use 'clojure.contrib.pprint)
|
||||
|
||||
(def user \"username\")
|
||||
(def password \"password\")
|
||||
|
|
@ -22,9 +20,9 @@ Here's an example of getting some compute configuration from rackspace:
|
|||
(pprint (nodes compute))
|
||||
(pprint (sizes compute))
|
||||
|
||||
"}
|
||||
org.jclouds.compute
|
||||
(:use clojure.contrib.duck-streams
|
||||
See http://code.google.com/p/jclouds for details."
|
||||
(:use org.jclouds.core
|
||||
clojure.contrib.duck-streams
|
||||
clojure.contrib.logging
|
||||
[clojure.contrib.str-utils2 :only [capitalize lower-case map-str]]
|
||||
[clojure.contrib.java-utils :only [wall-hack-field]])
|
||||
|
|
@ -39,40 +37,12 @@ Here's an example of getting some compute configuration from rackspace:
|
|||
Architecture)
|
||||
(com.google.common.collect ImmutableSet)))
|
||||
|
||||
(def module-lookup
|
||||
{:log4j 'org.jclouds.logging.log4j.config.Log4JLoggingModule
|
||||
:ssh 'org.jclouds.ssh.jsch.config.JschSshClientModule
|
||||
:enterprise 'org.jclouds.enterprise.config.EnterpriseConfigurationModule})
|
||||
|
||||
(defn- instantiate [sym]
|
||||
(let [loader (.getContextClassLoader (Thread/currentThread))]
|
||||
(try
|
||||
(.newInstance #^Class (.loadClass loader (name sym)))
|
||||
(catch java.lang.ClassNotFoundException e
|
||||
(warn (str "Could not find " (name sym) " module.
|
||||
Ensure the module is on the classpath. You are maybe missing a dependency on
|
||||
org.jclouds/jclouds-jsch
|
||||
org.jclouds/jclouds-log4j
|
||||
or org.jclouds/jclouds-enterprise."))))))
|
||||
|
||||
(defn modules
|
||||
"Build a list of modules suitable for passing to compute-context"
|
||||
[& modules]
|
||||
(.build #^com.google.common.collect.ImmutableSet$Builder
|
||||
(reduce #(.add #^com.google.common.collect.ImmutableSet$Builder %1 %2)
|
||||
(com.google.common.collect.ImmutableSet/builder)
|
||||
(filter (complement nil?)
|
||||
(map (comp instantiate module-lookup) modules)))))
|
||||
|
||||
(defn compute-context
|
||||
"Create a logged in context."
|
||||
([s a k]
|
||||
(compute-context s a k (modules :log4j :ssh :enterprise)))
|
||||
([#^String s #^String a #^String k #^ImmutableSet m]
|
||||
(.createContext (new ComputeServiceContextFactory) s a k m)))
|
||||
|
||||
(defn- seq-from-immutable-set [#^ImmutableSet set]
|
||||
(map #(.getValue %) set))
|
||||
([service account key]
|
||||
(compute-context service account key (modules :log4j :ssh :enterprise)))
|
||||
([#^String service #^String account #^String key #^ImmutableSet modules]
|
||||
(.createContext (new ComputeServiceContextFactory) service account key modules)))
|
||||
|
||||
(defn locations
|
||||
"Retrieve the available compute locations for the compute context."
|
||||
|
|
@ -203,49 +173,11 @@ Ensure the module is on the classpath. You are maybe missing a dependency on
|
|||
[#^ComputeMetadata node]
|
||||
(.getName node))
|
||||
|
||||
(defn- dashed [a]
|
||||
(apply str (interpose "-" (map lower-case (re-seq #"[A-Z][^A-Z]*" a)))))
|
||||
|
||||
(defn- camelize [a]
|
||||
(apply str (map-str capitalize (.split a "-"))))
|
||||
|
||||
(defn camelize-mixed [a]
|
||||
(let [c (.split a "-")]
|
||||
(apply str (lower-case (first c)) (map capitalize (rest c)))))
|
||||
|
||||
(defmacro #^{:private true} define-accessor
|
||||
[class property obj-name]
|
||||
(list 'defn (symbol (str obj-name "-" (name property)))
|
||||
(vector (with-meta (symbol obj-name) {:tag (.getName class)}))
|
||||
(list (symbol (str ".get" (camelize (name property)))) (symbol obj-name))))
|
||||
|
||||
(defmacro #^{:private true} define-accessors
|
||||
"Defines read accessors, modelled on class-name-property-name. If the second
|
||||
argument is a string, it is used instead of the class-name prefix."
|
||||
[class & properties]
|
||||
(let [obj-name (if (string? (first properties))
|
||||
(first properties)
|
||||
(dashed (.getName class)))
|
||||
properties (if (string? (first properties))
|
||||
(rest properties)
|
||||
properties)]
|
||||
`(do
|
||||
~@(for [property properties]
|
||||
`(define-accessor ~class ~property ~obj-name)))))
|
||||
|
||||
(define-accessors Template image size location options)
|
||||
(define-accessors Image version os-family os-description architecture)
|
||||
(define-accessors Size cores ram disk)
|
||||
(define-accessors NodeMetadata "node" credentials extra state tag)
|
||||
|
||||
(defmacro option-fn-0arg [key]
|
||||
`(fn [builder#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder#)))
|
||||
|
||||
(defmacro option-fn-1arg [key]
|
||||
`(fn [builder# value#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder# value#)))
|
||||
|
||||
(defn builder-options [builder]
|
||||
(or (wall-hack-field org.jclouds.compute.internal.TemplateBuilderImpl :options builder)
|
||||
(TemplateOptions.)))
|
||||
|
|
@ -267,9 +199,6 @@ Ensure the module is on the classpath. You are maybe missing a dependency on
|
|||
(~(symbol (str "." (camelize-mixed (name key)))) options# (seq-to-array value#))
|
||||
(.options builder# options#))))
|
||||
|
||||
(defmacro make-option-map [f keywords]
|
||||
`[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)])
|
||||
|
||||
(def option-1arg-map
|
||||
(apply array-map
|
||||
(concat
|
||||
|
|
|
|||
|
|
@ -8,25 +8,6 @@ list, Alan Dipert and MeikelBrandmeyer."
|
|||
`(let ~(reduce #(conj %1 %2 `@(ns-resolve '~ns '~%2)) [] fns)
|
||||
~@tests))
|
||||
|
||||
(with-private-vars [org.jclouds.compute [instantiate]]
|
||||
(deftest instantiate-test
|
||||
(is (instance? String (instantiate 'java.lang.String)))))
|
||||
|
||||
(deftest os-families-test
|
||||
(is (some #{"centos"} (map str (os-families)))))
|
||||
|
||||
(deftest modules-empty-test
|
||||
(is (.isEmpty (modules))))
|
||||
|
||||
(deftest modules-instantiate-test
|
||||
(binding [org.jclouds.compute/module-lookup
|
||||
(assoc org.jclouds.compute/module-lookup
|
||||
:string 'java.lang.String)]
|
||||
(is (instance? String (first (modules :string))))
|
||||
(is (= 1 (count (modules :string))))))
|
||||
|
||||
(deftest modules-instantiate-fail-test
|
||||
(binding [org.jclouds.compute/module-lookup
|
||||
(assoc org.jclouds.compute/module-lookup
|
||||
:non-existing 'this.doesnt.Exist)]
|
||||
(is (.isEmpty (modules :non-existing)))))
|
||||
|
|
|
|||
50
core/pom.xml
50
core/pom.xml
|
|
@ -40,6 +40,38 @@
|
|||
<url>http://jclouds.googlecode.com/svn/trunk</url>
|
||||
</scm>
|
||||
|
||||
<build>
|
||||
<resources>
|
||||
<resource>
|
||||
<directory>src/main/clojure</directory>
|
||||
</resource>
|
||||
<resource>
|
||||
<directory>src/main/resources</directory>
|
||||
</resource>
|
||||
</resources>
|
||||
<plugins>
|
||||
<plugin>
|
||||
<groupId>com.theoryinpractise</groupId>
|
||||
<artifactId>clojure-maven-plugin</artifactId>
|
||||
<version>1.3.1</version>
|
||||
<executions>
|
||||
<execution>
|
||||
<id>test-clojure</id>
|
||||
<phase>test</phase>
|
||||
<goals>
|
||||
<goal>test</goal>
|
||||
</goals>
|
||||
</execution>
|
||||
</executions>
|
||||
<configuration>
|
||||
<testNamespaces>
|
||||
<testNamespace>!clojure.*</testNamespace>
|
||||
</testNamespaces>
|
||||
</configuration>
|
||||
</plugin>
|
||||
</plugins>
|
||||
</build>
|
||||
|
||||
<repositories>
|
||||
<repository>
|
||||
<id>gson</id>
|
||||
|
|
@ -93,6 +125,24 @@
|
|||
<artifactId>google-guava</artifactId>
|
||||
<version>1.0-r11</version>
|
||||
</dependency>
|
||||
<dependency>
|
||||
<groupId>org.clojure</groupId>
|
||||
<artifactId>clojure</artifactId>
|
||||
<version>1.1.0</version>
|
||||
<scope>test</scope>
|
||||
</dependency>
|
||||
<dependency>
|
||||
<groupId>org.clojure</groupId>
|
||||
<artifactId>clojure-contrib</artifactId>
|
||||
<version>1.1.0</version>
|
||||
<scope>test</scope>
|
||||
</dependency>
|
||||
<dependency>
|
||||
<groupId>swank-clojure</groupId>
|
||||
<artifactId>swank-clojure</artifactId>
|
||||
<version>1.1.0</version>
|
||||
<scope>test</scope>
|
||||
</dependency>
|
||||
</dependencies>
|
||||
|
||||
<profiles>
|
||||
|
|
|
|||
|
|
@ -0,0 +1,81 @@
|
|||
(ns org.jclouds.core
|
||||
"Core functionality used across blobstore and compute."
|
||||
(:use clojure.contrib.logging
|
||||
[clojure.contrib.str-utils2 :only [capitalize lower-case map-str]]
|
||||
[clojure.contrib.java-utils :only [wall-hack-field]])
|
||||
(:import java.io.File
|
||||
(com.google.common.collect ImmutableSet)))
|
||||
|
||||
(def module-lookup
|
||||
{:log4j 'org.jclouds.logging.log4j.config.Log4JLoggingModule
|
||||
:ssh 'org.jclouds.ssh.jsch.config.JschSshClientModule
|
||||
:enterprise 'org.jclouds.enterprise.config.EnterpriseConfigurationModule
|
||||
:httpnio 'org.jclouds.http.httpnio.config.NioTransformingHttpCommandExecutorServiceModule
|
||||
:apachehc 'org.jclouds.http.apachehc.config.ApacheHCHttpCommandExecutorServiceModule
|
||||
:bouncycastle 'org.jclouds.encryption.bouncycastle.config.BouncyCastleEncryptionServiceModule
|
||||
:joda 'org.jclouds.date.joda.config.JodaDateServiceModule
|
||||
:gae 'org.jclouds.gae.config.GoogleAppEngineConfigurationModule})
|
||||
|
||||
(defn- instantiate [sym]
|
||||
(let [loader (.getContextClassLoader (Thread/currentThread))]
|
||||
(try
|
||||
(.newInstance #^Class (.loadClass loader (name sym)))
|
||||
(catch java.lang.ClassNotFoundException e
|
||||
(warn (str "Could not find " (name sym) " module.
|
||||
Ensure the module is on the classpath. You are maybe missing a dependency on
|
||||
org.jclouds/jclouds-jsch
|
||||
org.jclouds/jclouds-log4j
|
||||
or org.jclouds/jclouds-enterprise."))))))
|
||||
|
||||
(defn modules
|
||||
"Build a list of modules suitable for passing to compute or blobstore context"
|
||||
[& modules]
|
||||
(.build #^com.google.common.collect.ImmutableSet$Builder
|
||||
(reduce #(.add #^com.google.common.collect.ImmutableSet$Builder %1 %2)
|
||||
(com.google.common.collect.ImmutableSet/builder)
|
||||
(filter (complement nil?)
|
||||
(map (comp instantiate module-lookup) modules)))))
|
||||
|
||||
(defn seq-from-immutable-set [#^ImmutableSet set]
|
||||
(map #(.getValue %) set))
|
||||
|
||||
(defn dashed [a]
|
||||
(apply str (interpose "-" (map lower-case (re-seq #"[A-Z][^A-Z]*" a)))))
|
||||
|
||||
(defn camelize [a]
|
||||
(map-str capitalize (.split a "-")))
|
||||
|
||||
(defn camelize-mixed [a]
|
||||
(let [c (.split a "-")]
|
||||
(apply str (lower-case (first c)) (map capitalize (rest c)))))
|
||||
|
||||
(defmacro option-fn-0arg [key]
|
||||
`(fn [builder#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder#)))
|
||||
|
||||
(defmacro option-fn-1arg [key]
|
||||
`(fn [builder# value#]
|
||||
(~(symbol (str "." (camelize-mixed (name key)))) builder# value#)))
|
||||
|
||||
(defmacro make-option-map [f keywords]
|
||||
`[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)])
|
||||
|
||||
(defmacro define-accessor
|
||||
[class property obj-name]
|
||||
(list 'defn (symbol (str obj-name "-" (name property)))
|
||||
(vector (with-meta (symbol obj-name) {:tag (.getName class)}))
|
||||
(list (symbol (str ".get" (camelize (name property)))) (symbol obj-name))))
|
||||
|
||||
(defmacro define-accessors
|
||||
"Defines read accessors, modelled on class-name-property-name. If the second
|
||||
argument is a string, it is used instead of the class-name prefix."
|
||||
[class & properties]
|
||||
(let [obj-name (if (string? (first properties))
|
||||
(first properties)
|
||||
(dashed (.getName class)))
|
||||
properties (if (string? (first properties))
|
||||
(rest properties)
|
||||
properties)]
|
||||
`(do
|
||||
~@(for [property properties]
|
||||
`(define-accessor ~class ~property ~obj-name)))))
|
||||
|
|
@ -0,0 +1,29 @@
|
|||
(ns org.jclouds.core-test
|
||||
(:use [org.jclouds.core] :reload-all)
|
||||
(:use clojure.test))
|
||||
|
||||
(defmacro with-private-vars [[ns fns] & tests]
|
||||
"Refers private fns from ns and runs tests in context. From users mailing
|
||||
list, Alan Dipert and MeikelBrandmeyer."
|
||||
`(let ~(reduce #(conj %1 %2 `@(ns-resolve '~ns '~%2)) [] fns)
|
||||
~@tests))
|
||||
|
||||
(with-private-vars [org.jclouds.core [instantiate]]
|
||||
(deftest instantiate-test
|
||||
(is (instance? String (instantiate 'java.lang.String)))))
|
||||
|
||||
(deftest modules-empty-test
|
||||
(is (.isEmpty (modules))))
|
||||
|
||||
(deftest modules-instantiate-test
|
||||
(binding [module-lookup
|
||||
(assoc module-lookup
|
||||
:string 'java.lang.String)]
|
||||
(is (instance? String (first (modules :string))))
|
||||
(is (= 1 (count (modules :string))))))
|
||||
|
||||
(deftest modules-instantiate-fail-test
|
||||
(binding [module-lookup
|
||||
(assoc module-lookup
|
||||
:non-existing 'this.doesnt.Exist)]
|
||||
(is (.isEmpty (modules :non-existing)))))
|
||||
Loading…
Reference in New Issue