major update to blobstore clojure binding. factored out core.clj

blobstore/pom.xml

@@ -149,6 +149,11 @@
 		  </goals>
 		</execution>
 	      </executions>
+	      <configuration>
+		<testNamespaces>
+		  <testNamespace>!clojure.*</testNamespace>
+		</testNamespaces>
+	      </configuration>
 	    </plugin>
         </plugins>
 	<resources>

blobstore/src/main/clojure/org/jclouds/blobstore.clj

@@ -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:
    [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 org.jclouds.blobstore)
+    (use 'clojure.contrib.pprint)
-  (:use clojure.contrib.pprint)
-)
 
     (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))
+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
-  ([{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
-
+  "List the blobs in a container:
-"
-http://code.google.com/p/jclouds
-
-list the blobs in a container:
 blobstore container -> blobs
 
 list the blobs in a container under a path:
 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]
      (.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
+(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 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))

blobstore/src/test/clojure/org/jclouds/blobstore_test.clj

@@ -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
+(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"))))))

compute/pom.xml

@@ -62,6 +62,11 @@
 	      </goals>
 	    </execution>
 	  </executions>
+	  <configuration>
+	    <testNamespaces>
+	      <testNamespace>!clojure.*</testNamespace>
+	    </testNamespaces>
+	  </configuration>
 	</plugin>
       </plugins>
     </build>

compute/src/main/clojure/org/jclouds/compute.clj

@@ -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:
    [ec2, rimuhosting, terremark, vcloud, hostingdotcom]
 
 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 password \"password\")
@@ -22,9 +20,9 @@ Here's an example of getting some compute configuration from rackspace:
   (pprint (nodes 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.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]
+  ([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
   "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

compute/src/test/clojure/org/jclouds/compute_test.clj

@@ -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)))))

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>

core/src/main/clojure/org/jclouds/core.clj

@@ -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)))))

core/src/test/clojure/org/jclouds/core_test.clj

@@ -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)))))