couchdb.clj

couchdb.clj

(ns couchdb
 (:use clojure.data.json)
 (:refer-clojure :exclude [get key]))

    (defn server
     "Wraps a server"
     [host port] {:server (str "http://" host ":" port)}) 

    (defn db
     "Wraps a database on a server"
     [server db] (assoc server :db db)) 

    (defn- oops  [ex conn] 
     "Handle problems!"
     (read-json (slurp (.getErrorStream conn))))

    (defn- connect [url] 
     "Starts a connection to the server"
     (doto (.openConnection (java.net.URL. url)) 
       (.setRequestProperty "User-Agent" "Diogok-Clojure"))) 

    (defn- put-1 [url object]
     "Perform a PUT/POST on the url, sending a json and reading the response"
     (let [conn (doto (connect (str url (when (vector? (object :docs)) "/_bulk_docs")))
                 (.setDoOutput true) 
                 (.setRequestProperty "Content-Type" "application/json"))]
      (try (with-open [out (.getOutputStream conn)]
        (do
         (spit out  (json-str object))
         (read-json (slurp (.getInputStream conn)))))
       (catch Exception e (oops e conn))))) 

    (defn put 
     "Put a value on the database"
     ([{server :server db :db} value] (put-1 (str server "/" db) value )) 
     ([db key value] (put db (assoc value :_id key)))) 

    (defn- get-1 [url]
     "Read a json from url"
     (let [conn  (connect url)]
      (try 
         (read-json (slurp (.getInputStream conn)))
       (catch Exception e (oops e conn))))) 

    (defn get
     "Get a value from the database"
     [{server :server db :db} key] (get-1 (str server "/" db "/" key)))

    (defn view
     "Wraps view information"
     ([db design view-name] (assoc db :design design :view view-name)))

     (defn query 
      "Query a view"
     ([{server :server db :db design :design view-name :view-name}]
      (get-1 (str server "/" db "/_design/" design "/_view/" view-name)))
     ([{server :server db :db design :design view-name :view-name} key]
      (get-1 (str server "/" db "/_design/" design "/_view/" view-name
                  "?key=\"" key "\""))))

     (defn delete
      "Delete a value from database"
      ([{server :server db :db} obj]
       (let [conn (doto (connect (str server "/" db "/" (obj :_id)))
                   (.setRequestMethod "DELETE")
                   (.setRequestProperty "If-Match" (obj :_rev)))]
        (try 
         (read-json (slurp (.getInputStream conn)))
         (catch Exception e (oops e conn))))))