setting pattern-matched jboss/hornetq `address-settings` programmatically, using immutant

gistfile1.clj

(ns immutant.messaging.util
  (:import org.hornetq.core.settings.impl.AddressFullMessagePolicy
        org.hornetq.core.settings.impl.AddressSettings
        org.hornetq.api.core.SimpleString)
  (:require immutant.registry
            [immutant.messaging :as msg]
            [clojure.string :as str]))

(defn- set-bean-property
  [bean pname value]
  (let [setter (as-> (name pname) %
                 (str/split % #"-")
                 (map str/capitalize %)
                 (apply str ".set" %)
                 (symbol %))]
    ((eval `#(~setter % %2)) bean value)))

(defn- address-settings
  ([match-string]
  (-> (immutant.registry/get "jboss.messaging.default")
      .getAddressSettingsRepository
      (.getMatch match-string)))
  ([match-string new-settings]
  (-> (immutant.registry/get "jboss.messaging.default")
      .getAddressSettingsRepository
      (.addMatch match-string new-settings))))


(def ^:private address-settings-coercions
  (reduce
    (fn [m [k v]]
      (-> (assoc m k v)
          (assoc (symbol (name k)) v)
          (assoc (name k) v)))
    {}
    {:dead-letter-address #(SimpleString. %)
     :expiry-address #(SimpleString. %)
     :address-full-message-policy #(case (name %)
                                     "block" AddressFullMessagePolicy/BLOCK
                                     "drop" AddressFullMessagePolicy/DROP
                                     "page" AddressFullMessagePolicy/PAGE)}))

(defn start+
  "Same as `immutant.messaging/start`, but allows you to set queue parameters
  corresponding to those available via the `address-settings` elements in
  various hornetq and jboss XML configuration files.  See
  http://docs.jboss.org/hornetq/2.3.0.Final/docs/user-manual/html/configuration-index.html
  for more info.
  
  e.g.  (start \"your.queue.name\"
               :dead-letter-address \"WTF!\"
               :address-full-message-policy :block
               :redelivery-delay 2000)"
  [queue-name & {:as opts}]
  (let [global-opts (dissoc opts :durable :selector)
        queue-local-opts (select-keys opts [:durable :selector])
        ret (apply msg/start queue-name (flatten (seq queue-local-opts)))]
    (when (seq global-opts)
      ;; TODO should properly log using whatever immutant/jboss likes
      (println "Setting <address-settings> for queue" queue-name ": " global-opts)
      ;; assuming here that queue-name is the shortened style immutant
      ;; recommends; need to add the jboss/jms prefix so lookups happen properly
      (address-settings (str "jms.queue." queue-name)
                        (reduce
                          (fn [s [k v]]
                            (doto s
                              (set-bean-property
                                k ((address-settings-coercions k identity) v))))
                          (AddressSettings.)
                          global-opts)))
    ret))

using % with as-> is cute

Might as well, right? :-) Would get a little nasty if there was a fn literal in there.