diff --git a/compute/src/main/clojure/org/jclouds/compute.clj b/compute/src/main/clojure/org/jclouds/compute.clj index 691baed096..ae357d167c 100644 --- a/compute/src/main/clojure/org/jclouds/compute.clj +++ b/compute/src/main/clojure/org/jclouds/compute.clj @@ -1,6 +1,6 @@ ; ; -; Copyright (C) 2010 Cloud Conscious, LLC. +; Copyright (C) 2010, 2011 Cloud Conscious, LLC. ; ; ==================================================================== ; Licensed under the Apache License, Version 2.0 (the "License"); @@ -23,8 +23,8 @@ Current supported providers are: [aws-ec2, eucualyptus-partnercloud-ec2, elastichosts-lon-b, cloudservers-uk, cloudservers-us, byon, cloudsigma-zrh, stub, - trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus, - slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts, + trmk-ecloud, trmk-vcloudexpress, vcloud, bluelock, eucalyptus, + slicehost, elastichosts-lon-p, elastichosts-sat-p, elastichosts, openhosting-east1, serverlove-z1-man, skalicloud-sdg-my] Here's an example of getting some compute configuration from rackspace: @@ -372,50 +372,51 @@ See http://code.google.com/p/jclouds for details." (define-accessors Hardware processors ram volumes) (define-accessors NodeMetadata "node" credentials hardware state group) -(defn builder-options [builder] - (or - (get-field - org.jclouds.compute.domain.internal.TemplateBuilderImpl :options builder) - (TemplateOptions.))) +(def + ^{:doc "TemplateBuilder functions" :private true} + template-map + (merge + (make-option-map + kw-memfn-0arg [:smallest :fastest :biggest :any]) + (make-option-map + kw-memfn-1arg + [:os-family :location-id :architecture :image-id :hardware-id + :os-name-matches :os-version-matches :os-description-matches + :os-64-bit :image-version-matches :image-name-matches + :image-description-matches :min-cores :min-ram]))) -(defmacro option-option-fn-0arg [key] - `(fn [builder#] - (let [options# (builder-options builder#)] - (~(symbol (str "." (camelize-mixed (name key)))) options#) - (.options builder# options#)))) +(def + ^{:doc "TemplateOptions functions" :private true} + options-map + (merge + (make-option-map + kw-memfn-0arg + [:destroy-on-error :enable-monitoring :no-placement-group :no-key-pair + :with-details]) + (make-option-map + kw-memfn-1arg + [:run-script :install-private-key :authorize-public-key + ;; aws ec2 options + :spot-price :spot-options :placement-group :subnet-id + :block-device-mappings :unmapDeviceNamed :security-groups + :key-pair :user-data]) + (make-option-map kw-memfn-varargs [:inbound-ports]) + (make-option-map + kw-memfn-2arg + [:block-on-port + ;; aws ec2 options + :map-ephemeral-device-to-device-name]) + {:map-ebs-snapshot-to-device-name + (kw-memfn-apply :map-ebs-snapshot-to-device-name + device-name snapshot-id size-in-gib delete-on-termination) + :map-new-volume-to-device-name + (kw-memfn-apply :map-new-volume-to-device-name + device-name size-in-gib delete-on-termination)})) -(defn- seq-to-array [args] - (if (or (seq? args) (vector? args)) - (int-array args) - args)) - -(defmacro option-option-fn-1arg [key] - `(fn [builder# value#] - (let [options# (builder-options builder#)] - (~(symbol (str "." (camelize-mixed (name key)))) - options# (seq-to-array value#)) - (.options builder# options#)))) - -(def option-1arg-map - (apply array-map - (concat - (make-option-map - option-fn-1arg - [:os-family :location-id :architecture :image-id :hardware-id - :os-name-matches :os-version-matches :os-description-matches - :os-64-bit :image-version-matches :image-name-matches - :image-description-matches :min-cores :min-ram]) - (make-option-map - option-option-fn-1arg - [:run-script :install-private-key :authorize-public-key - :inbound-ports])))) -(def option-0arg-map - (apply hash-map - (concat - (make-option-map option-fn-0arg - [:smallest :fastest :biggest :any]) - (make-option-map option-option-fn-0arg - [:destroy-on-error])))) +(def + ^{:doc "All receognised options"} + known-template-options + (set (mapcat keys [options-map template-map]))) (defn os-families [] (. OsFamily values)) @@ -426,14 +427,8 @@ See http://code.google.com/p/jclouds for details." (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first) value)) -(defn add-nullary-option [builder option value] - (if-let [f (option-0arg-map option)] - (if value - (f builder) - builder))) - -(defn add-value-option [builder option value] - (if-let [f (option-1arg-map option)] +(defn apply-option [builder option-map option value] + (when-let [f (option-map option)] (f builder (translate-enum-value option value)))) ;; TODO look at clojure-datalog @@ -457,10 +452,31 @@ Options correspond to TemplateBuilder methods." :as options}] (let [builder (.. compute (templateBuilder))] (doseq [[option value] options] - (or - (add-value-option builder option value) - (add-nullary-option builder option value) - (condition/raise - :type :invalid-template-builder-option - :message (format "Invalid template builder option : %s" option)))) - (.build builder))) + (when-not (known-template-options option) + (condition/raise + :type :invalid-template-builder-option + :message (format "Invalid template builder option : %s" option))) + ;; apply template builder options + (try + (apply-option builder template-map option value) + (catch Exception e + (condition/raise + :type :invalid-template-builder + :message (format + "Problem applying template builder %s with value %s: %s" + option (pr-str value) (.getMessage e)) + :cause e)))) + (let [template (.build builder) + template-options (.getOptions template)] + (doseq [[option value] options] + ;; apply template option options + (try + (apply-option template-options options-map option value) + (catch Exception e + (condition/raise + :type :invalid-template-option + :message (format + "Problem applying template option %s with value %s: %s" + option (pr-str value) (.getMessage e)) + :cause e)))) + template))) diff --git a/core/src/main/clojure/org/jclouds/core.clj b/core/src/main/clojure/org/jclouds/core.clj index 5f532c55c5..b308630e3c 100644 --- a/core/src/main/clojure/org/jclouds/core.clj +++ b/core/src/main/clojure/org/jclouds/core.clj @@ -1,6 +1,6 @@ ; ; -; Copyright (C) 2010 Cloud Conscious, LLC. +; Copyright (C) 2010, 2011 Cloud Conscious, LLC. ; ; ==================================================================== ; Licensed under the Apache License, Version 2.0 (the "License"); @@ -65,32 +65,130 @@ Ensure the module is on the classpath. You are maybe missing a dependency on :else %) modules))))) +;;; Functions and macros to map keywords to java member functions (defn dashed [a] - (apply str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a))))) + (apply + str (interpose "-" (map string/lower-case (re-seq #"[A-Z][^A-Z]*" a))))) -(defn camelize [a] - (string/map-str string/capitalize (.split a "-"))) +(defn camelize + "Takes a string, or anything named, and converts it to camel case + (capitalised initial component" + [a] + (string/map-str string/capitalize (.split (name a) "-"))) -(defn camelize-mixed [a] - (let [c (.split a "-")] +(defn camelize-mixed + "Takes a string, or anything named, and converts it to mixed camel case + (lower case initial component)" + [a] + (let [c (.split (name a) "-")] (apply str (string/lower-case (first c)) (map string/capitalize (rest c))))) -(defmacro option-fn-0arg [key] - `(fn [builder#] - (~(symbol (str "." (camelize-mixed (name key)))) builder#))) +(defn kw-fn-symbol + "Converts a keyword into a camel cased symbol corresponding to a function + name" + [kw] + (symbol (camelize-mixed kw))) -(defmacro option-fn-1arg [key] - `(fn [builder# value#] - (~(symbol (str "." (camelize-mixed (name key)))) builder# value#))) +(defmacro kw-memfn + "Expands into code that creates a function that expects to be passed an + object and any args, and calls the instance method corresponding to + the camel cased version of the passed keyword, passing the arguments." + [kw & args] + `(memfn ~(kw-fn-symbol kw) ~@args)) -(defmacro make-option-map [f keywords] - `[ ~@(reduce (fn [v# k#] (conj (conj v# k#) `(~f ~k#))) [] keywords)]) +(defmacro kw-memfn-apply + "Expands into code that creates a function that expects to be passed an object + and an arg vector containing the args, and calls the instance method + corresponding to the camel cased version of the passed keyword, passing the + arguments." + [kw & args] + `(fn [target# [~@args]] + ((memfn ~(kw-fn-symbol kw) ~@args) target# ~@args))) + +(defmacro kw-memfn-0arg + "Expands into code that creates a function that expects to be passed an + object, and calls the instance method corresponding to the camel cased + version of the passed keyword if the argument is non-nil." + [kw] + `(fn [target# arg#] + (if arg# + ((kw-memfn ~kw) target#) + target#))) + +(defmacro kw-memfn-1arg + "Expands into code that creates a function that expects to be passed an object + and an arg, and calls the instance method corresponding to the camel cased + version of the passed keyword, passing the argument." + [kw] + `(kw-memfn ~kw a#)) + +(defmacro kw-memfn-2arg + "Expands into code that creates a function that expects to be passed an object + and an arg vector containing 2 args, and calls the instance method + corresponding to the camel cased version of the passed keyword, passing the + arguments." + [kw] + `(kw-memfn-apply ~kw a# b#)) + +;; (defmacro memfn-overloads +;; "Construct a function that applies arguments to the given member function." +;; [name] +;; `(fn [target# args#] +;; (condp = (count args#) +;; 0 (. target# (~name)) +;; 1 (. target# (~name (first args#))) +;; 2 (. target# (~name (first args#) (second args#))) +;; 3 (. target# (~name (first args#) (second args#) (nth args# 2))) +;; 4 (. target# +;; (~name (first args#) (second args#) (nth args# 2) (nth args# 3))) +;; 5 (. target# +;; (~name (first args#) (second args#) (nth args# 2) (nth args# 3) +;; (nth args# 4))) +;; (throw +;; (java.lang.IllegalArgumentException. +;; (str +;; "too many arguments passed. Limit 5, passed " (count args#))))))) + +;; (defmacro kw-memfn-overloads +;; "Expands into code that creates a function that expects to be passed an +;; object and an arg vector, and calls the instance method corresponding to +;; the camel cased version of the passed keyword, passing the arguments. +;; The function accepts different arities at runtime." +;; [kw] +;; `(memfn-overloads ~(kw-fn-symbol kw))) + +(defmacro memfn-varargs + "Construct a function that applies an argument sequence to the given member + function, which accepts varargs. array-fn should accept a sequence and + return a suitable array for passing as varargs." + [name array-fn] + `(fn [target# args#] + (. target# + (~name + (if (or (seq? args#) (vector? args#)) (~array-fn args#) args#))))) + +(defmacro kw-memfn-varargs + "Expands into code that creates a function that expects to be passed an + object and an arg vector, and calls the instance method corresponding to + the camel cased version of the passed keyword, passing the arguments. + The function accepts different arities at runtime." + ([kw] `(kw-memfn-varargs ~kw int-array)) + ([kw array-fn] `(memfn-varargs ~(kw-fn-symbol kw) ~array-fn))) + +(defmacro make-option-map + "Builds a literal map from keyword, to a call on macro f with the keyword + as an argument." + [f keywords] + `(hash-map + ~@(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)))) + (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 diff --git a/core/src/test/clojure/org/jclouds/core_test.clj b/core/src/test/clojure/org/jclouds/core_test.clj index dc0f2ba5bd..c8f7969021 100644 --- a/core/src/test/clojure/org/jclouds/core_test.clj +++ b/core/src/test/clojure/org/jclouds/core_test.clj @@ -1,6 +1,6 @@ ; ; -; Copyright (C) 2010 Cloud Conscious, LLC. +; Copyright (C) 2010, 2011 Cloud Conscious, LLC. ; ; ==================================================================== ; Licensed under the Apache License, Version 2.0 (the "License"); @@ -18,8 +18,9 @@ ; (ns org.jclouds.core-test - (:use [org.jclouds.core] :reload-all) - (:use clojure.test)) + (:use + org.jclouds.core + clojure.test)) (defmacro with-private-vars [[ns fns] & tests] "Refers private fns from ns and runs tests in context. From users mailing @@ -50,3 +51,25 @@ list, Alan Dipert and MeikelBrandmeyer." (assoc module-lookup :non-existing 'this.doesnt.Exist)] (is (.isEmpty (modules :non-existing))))) + +(deftest kw-fn-symbol-test + (is (= 'aB (kw-fn-symbol :a-b)))) + +(deftest kw-memfn-test + (is (= "a" ((kw-memfn :to-lower-case) "A"))) + (is (= "Ab" ((kw-memfn :concat s) "A" "b"))) + (is (= "Ab" ((kw-memfn-apply :concat s) "A" ["b"]))) + (is (= "Ac" ((kw-memfn-apply :replace a b) "Ab" ["b" "c"])))) + +(deftest kw-memfn-0arg-test + (is (= "a" ((kw-memfn-0arg :to-lower-case) "A" true))) + (is (= "A" ((kw-memfn-0arg :to-lower-case) "A" nil)))) + +(deftest kw-memfn-1arg-test + (is (= "Ab" ((kw-memfn-1arg :concat) "A" "b")))) + +(deftest kw-memfn-2arg-test + (is (= "Ac" ((kw-memfn-2arg :replace) "Ab" ["b" "c"])))) + +(deftest kw-memfn-varargs-test + (is (fn? (kw-memfn-varargs :replace)))) diff --git a/providers/aws-ec2/src/main/clojure/org/jclouds/aws/ec2.clj b/providers/aws-ec2/src/main/clojure/org/jclouds/aws/ec2.clj new file mode 100644 index 0000000000..8478344890 --- /dev/null +++ b/providers/aws-ec2/src/main/clojure/org/jclouds/aws/ec2.clj @@ -0,0 +1,45 @@ +(ns org.jclouds.aws.ec2 + "AWS EC2 specific functionality" + (:require + [org.jclouds.core :as core]) + (:import + org.jclouds.aws.ec2.domain.SpotInstanceRequest + org.jclouds.aws.ec2.options.RequestSpotInstancesOptions)) + +(def + ^{:doc "TemplateBuilder functions" :private true} + spot-option-map + (core/make-option-map + core/kw-memfn-1arg + [:valid-from :valid-until :type :launch-group :availability-zone-group])) + +(defn spot-types [] + (. org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type values)) + +(def enum-map {:type (spot-types)}) + +(defn translate-enum-value [kword value] + (or (-> (filter #(= (name value) (str %)) (kword enum-map)) first) + value)) + +(defn apply-option + [options [option value]] + (when-let [f (spot-option-map option)] + (f options (translate-enum-value option value))) + options) + +(defn spot-options + "Build a spot request options object, for passing to the :spot-options + key of the template builder options. + + Takes a hash-map of keys and values that correspond to the methods of + RequestSpotInstancesOptions. + + Options are: + :valid-from :valid-until :type :launch-group :availability-zone-group + + :type takes either :one-time or :persistent" + [request-map] + (reduce + apply-option + (RequestSpotInstancesOptions.) request-map)) diff --git a/providers/aws-ec2/src/test/clojure/org/jclouds/aws/ec2_test.clj b/providers/aws-ec2/src/test/clojure/org/jclouds/aws/ec2_test.clj new file mode 100644 index 0000000000..257fc2a985 --- /dev/null +++ b/providers/aws-ec2/src/test/clojure/org/jclouds/aws/ec2_test.clj @@ -0,0 +1,15 @@ +(ns org.jclouds.aws.ec2-test + (:use + org.jclouds.aws.ec2 + clojure.test)) + +(deftest translate-enum-value-test + (is (= org.jclouds.aws.ec2.domain.SpotInstanceRequest$Type/ONE_TIME + (org.jclouds.aws.ec2/translate-enum-value :type :one-time)))) + +(deftest spot-options-est + (is (spot-options {:type :one-time + :valid-from (java.util.Date.) + :valid-until (java.util.Date.) + :launch-group "lg" + :availability-zone-group "ag"})))