mirror of https://github.com/apache/jclouds.git
major update to blobstore clojure binding. factored out core.clj
This commit is contained in:
parent
45c53489a2
commit
cb0928afae
|
@ -149,6 +149,11 @@
|
||||||
</goals>
|
</goals>
|
||||||
</execution>
|
</execution>
|
||||||
</executions>
|
</executions>
|
||||||
|
<configuration>
|
||||||
|
<testNamespaces>
|
||||||
|
<testNamespace>!clojure.*</testNamespace>
|
||||||
|
</testNamespaces>
|
||||||
|
</configuration>
|
||||||
</plugin>
|
</plugin>
|
||||||
</plugins>
|
</plugins>
|
||||||
<resources>
|
<resources>
|
||||||
|
|
|
@ -1,76 +1,264 @@
|
||||||
(ns
|
(ns org.jclouds.blobstore
|
||||||
#^{:doc
|
"A clojure binding for the jclouds BlobStore.
|
||||||
"
|
|
||||||
a lib for interacting with jclouds BlobStore.
|
|
||||||
|
|
||||||
Current supported services are:
|
Current supported services are:
|
||||||
[s3, azureblob, atmos, cloudfiles]
|
[s3, azureblob, atmos, cloudfiles]
|
||||||
|
|
||||||
Here's a quick example of how to view blob resources in rackspace
|
Here's a quick example of how to view blob resources in rackspace
|
||||||
|
|
||||||
(ns example.jclouds
|
(use 'org.jclouds.blobstore)
|
||||||
(:use org.jclouds.blobstore)
|
(use 'clojure.contrib.pprint)
|
||||||
(:use clojure.contrib.pprint)
|
|
||||||
)
|
|
||||||
|
|
||||||
(def user \"rackspace_username\")
|
(def user \"rackspace_username\")
|
||||||
(def password \"rackspace_password\")
|
(def password \"rackspace_password\")
|
||||||
(def blobstore-name \"cloudfiles\")
|
(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))
|
See http://code.google.com/p/jclouds for details."
|
||||||
(pprint (blobs blobstore "your_container_name" ))
|
(: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]))
|
||||||
|
|
||||||
"}
|
(defn blobstore
|
||||||
org.jclouds.blobstore
|
"Create a logged in context.
|
||||||
(:use clojure.contrib.duck-streams)
|
Options for communication style
|
||||||
(:import java.io.File)
|
:sync and :async.
|
||||||
(:import org.jclouds.blobstore.BlobStore)
|
Options can also be specified for extension modules
|
||||||
(:import org.jclouds.blobstore.BlobStoreContext)
|
:log4j :enterprise :httpnio :apachehc :bouncycastle :joda :gae
|
||||||
(:import org.jclouds.blobstore.BlobStoreContextFactory)
|
"
|
||||||
(:import org.jclouds.blobstore.domain.Blob)
|
[#^String service #^String account #^String key & options]
|
||||||
(:import org.jclouds.blobstore.options.ListContainerOptions))
|
(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
|
(defn blobstore-context
|
||||||
([{service :service account :account key :key}]
|
"Returns a blobstore context from a blobstore."
|
||||||
(blobstore-context service account key))
|
[blobstore]
|
||||||
([s a k] (.createContext (new BlobStoreContextFactory) s a k )))
|
(.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
|
(defn blobs
|
||||||
|
"List the blobs in a container:
|
||||||
"
|
|
||||||
http://code.google.com/p/jclouds
|
|
||||||
|
|
||||||
list the blobs in a container:
|
|
||||||
blobstore container -> blobs
|
blobstore container -> blobs
|
||||||
|
|
||||||
list the blobs in a container under a path:
|
list the blobs in a container under a path:
|
||||||
blobstore container dir -> blobs
|
blobstore container dir -> blobs
|
||||||
|
|
||||||
example: (pprint
|
example:
|
||||||
(blobs
|
(pprint
|
||||||
(blobstore-context flightcaster-creds)
|
(blobs
|
||||||
\"somecontainer\" \"some-dir\"))
|
(blobstore-context flightcaster-creds)
|
||||||
|
\"somecontainer\" \"some-dir\"))
|
||||||
"
|
"
|
||||||
([blobstore container-name]
|
([blobstore container-name]
|
||||||
(.list (.getBlobStore blobstore) container-name ))
|
(.list (.getBlobStore blobstore) container-name ))
|
||||||
|
|
||||||
([blobstore container-name dir]
|
([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
|
(defn create-blob
|
||||||
|
"Create an blob representing text data:
|
||||||
"
|
|
||||||
http://code.google.com/p/jclouds
|
|
||||||
|
|
||||||
Create an blob representing text data:
|
|
||||||
container, name, string -> etag
|
container, name, string -> etag
|
||||||
"
|
"
|
||||||
|
([container-name name data]
|
||||||
|
(create-blob *blobstore* container-name name data))
|
||||||
([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
|
(ns org.jclouds.blobstore-test
|
||||||
(:use [org.jclouds.blobstore] :reload-all)
|
(:use [org.jclouds.blobstore] :reload-all)
|
||||||
(:use clojure.test))
|
(:use clojure.test)
|
||||||
|
(:import org.jclouds.blobstore.integration.StubBlobStoreContextBuilder))
|
||||||
|
|
||||||
(deftest blobstore-test
|
(def stub-context (.buildBlobStoreContext (StubBlobStoreContextBuilder.)))
|
||||||
(is true))
|
(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>
|
</goals>
|
||||||
</execution>
|
</execution>
|
||||||
</executions>
|
</executions>
|
||||||
|
<configuration>
|
||||||
|
<testNamespaces>
|
||||||
|
<testNamespace>!clojure.*</testNamespace>
|
||||||
|
</testNamespaces>
|
||||||
|
</configuration>
|
||||||
</plugin>
|
</plugin>
|
||||||
</plugins>
|
</plugins>
|
||||||
</build>
|
</build>
|
||||||
|
|
|
@ -1,15 +1,13 @@
|
||||||
(ns
|
(ns org.jclouds.compute
|
||||||
#^{:doc "
|
"A clojure binding to the jclouds ComputeService.
|
||||||
a lib for interacting with jclouds ComputeService.
|
|
||||||
|
|
||||||
Current supported services are:
|
Current supported services are:
|
||||||
[ec2, rimuhosting, terremark, vcloud, hostingdotcom]
|
[ec2, rimuhosting, terremark, vcloud, hostingdotcom]
|
||||||
|
|
||||||
Here's an example of getting some compute configuration from rackspace:
|
Here's an example of getting some compute configuration from rackspace:
|
||||||
|
|
||||||
(ns example.jclouds
|
(use 'org.jclouds.compute)
|
||||||
(:use org.jclouds.compute
|
(use 'clojure.contrib.pprint)
|
||||||
clojure.contrib.pprint))
|
|
||||||
|
|
||||||
(def user \"username\")
|
(def user \"username\")
|
||||||
(def password \"password\")
|
(def password \"password\")
|
||||||
|
@ -22,9 +20,9 @@ Here's an example of getting some compute configuration from rackspace:
|
||||||
(pprint (nodes compute))
|
(pprint (nodes compute))
|
||||||
(pprint (sizes compute))
|
(pprint (sizes compute))
|
||||||
|
|
||||||
"}
|
See http://code.google.com/p/jclouds for details."
|
||||||
org.jclouds.compute
|
(:use org.jclouds.core
|
||||||
(:use clojure.contrib.duck-streams
|
clojure.contrib.duck-streams
|
||||||
clojure.contrib.logging
|
clojure.contrib.logging
|
||||||
[clojure.contrib.str-utils2 :only [capitalize lower-case map-str]]
|
[clojure.contrib.str-utils2 :only [capitalize lower-case map-str]]
|
||||||
[clojure.contrib.java-utils :only [wall-hack-field]])
|
[clojure.contrib.java-utils :only [wall-hack-field]])
|
||||||
|
@ -39,40 +37,12 @@ Here's an example of getting some compute configuration from rackspace:
|
||||||
Architecture)
|
Architecture)
|
||||||
(com.google.common.collect ImmutableSet)))
|
(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
|
(defn compute-context
|
||||||
"Create a logged in context."
|
"Create a logged in context."
|
||||||
([s a k]
|
([service account key]
|
||||||
(compute-context s a k (modules :log4j :ssh :enterprise)))
|
(compute-context service account key (modules :log4j :ssh :enterprise)))
|
||||||
([#^String s #^String a #^String k #^ImmutableSet m]
|
([#^String service #^String account #^String key #^ImmutableSet modules]
|
||||||
(.createContext (new ComputeServiceContextFactory) s a k m)))
|
(.createContext (new ComputeServiceContextFactory) service account key modules)))
|
||||||
|
|
||||||
(defn- seq-from-immutable-set [#^ImmutableSet set]
|
|
||||||
(map #(.getValue %) set))
|
|
||||||
|
|
||||||
(defn locations
|
(defn locations
|
||||||
"Retrieve the available compute locations for the compute context."
|
"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]
|
[#^ComputeMetadata node]
|
||||||
(.getName 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 Template image size location options)
|
||||||
(define-accessors Image version os-family os-description architecture)
|
(define-accessors Image version os-family os-description architecture)
|
||||||
(define-accessors Size cores ram disk)
|
(define-accessors Size cores ram disk)
|
||||||
(define-accessors NodeMetadata "node" credentials extra state tag)
|
(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]
|
(defn builder-options [builder]
|
||||||
(or (wall-hack-field org.jclouds.compute.internal.TemplateBuilderImpl :options builder)
|
(or (wall-hack-field org.jclouds.compute.internal.TemplateBuilderImpl :options builder)
|
||||||
(TemplateOptions.)))
|
(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#))
|
(~(symbol (str "." (camelize-mixed (name key)))) options# (seq-to-array value#))
|
||||||
(.options builder# options#))))
|
(.options builder# options#))))
|
||||||
|
|
||||||
(defmacro make-option-map [f keywords]
|
|
||||||
`[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)])
|
|
||||||
|
|
||||||
(def option-1arg-map
|
(def option-1arg-map
|
||||||
(apply array-map
|
(apply array-map
|
||||||
(concat
|
(concat
|
||||||
|
|
|
@ -8,25 +8,6 @@ list, Alan Dipert and MeikelBrandmeyer."
|
||||||
`(let ~(reduce #(conj %1 %2 `@(ns-resolve '~ns '~%2)) [] fns)
|
`(let ~(reduce #(conj %1 %2 `@(ns-resolve '~ns '~%2)) [] fns)
|
||||||
~@tests))
|
~@tests))
|
||||||
|
|
||||||
(with-private-vars [org.jclouds.compute [instantiate]]
|
|
||||||
(deftest instantiate-test
|
|
||||||
(is (instance? String (instantiate 'java.lang.String)))))
|
|
||||||
|
|
||||||
(deftest os-families-test
|
(deftest os-families-test
|
||||||
(is (some #{"centos"} (map str (os-families)))))
|
(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)))))
|
|
||||||
|
|
52
core/pom.xml
52
core/pom.xml
|
@ -40,6 +40,38 @@
|
||||||
<url>http://jclouds.googlecode.com/svn/trunk</url>
|
<url>http://jclouds.googlecode.com/svn/trunk</url>
|
||||||
</scm>
|
</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>
|
<repositories>
|
||||||
<repository>
|
<repository>
|
||||||
<id>gson</id>
|
<id>gson</id>
|
||||||
|
@ -93,8 +125,26 @@
|
||||||
<artifactId>google-guava</artifactId>
|
<artifactId>google-guava</artifactId>
|
||||||
<version>1.0-r11</version>
|
<version>1.0-r11</version>
|
||||||
</dependency>
|
</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>
|
</dependencies>
|
||||||
|
|
||||||
<profiles>
|
<profiles>
|
||||||
<profile>
|
<profile>
|
||||||
<id>distribution</id>
|
<id>distribution</id>
|
||||||
|
|
|
@ -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