Created
August 17, 2010 12:35
-
-
Save diogok/529721 to your computer and use it in GitHub Desktop.
couchdb.clj
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(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)))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment