[clouchdb-cvs] CVS clouchdb/src
peddy
peddy at common-lisp.net
Sun Dec 9 16:03:21 UTC 2007
Update of /project/clouchdb/cvsroot/clouchdb/src
In directory clnet:/tmp/cvs-serv2019/src
Modified Files:
changelog.txt clouchdb.lisp examples.lisp tests.lisp
Log Message:
- Fixed ad-hoc-view and invoke-view functions so that they now use
all CouchDb view options
- Added generic keyword parameter to URL parameter translation code
- Changed default CouchDb port to IANA assigned 5984
- Added more comments
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt 2007/12/01 14:19:59 1.1.1.1
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt 2007/12/09 16:03:21 1.2
@@ -1,4 +1,12 @@
+0.0.4:
+
+ - Fixed ad-hoc-view and invoke-view functions so that they now use
+ all CouchDb view options
+ - Added generic keyword parameter to URL parameter translation code
+ - Changed default CouchDb port to IANA assigned 5984
+ - Added more comments
+
0.0.3:
- Changed 'scheme' parameter of set-connection to 'protocol'
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp 2007/12/08 15:16:21 1.2
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp 2007/12/09 16:03:21 1.3
@@ -25,7 +25,7 @@
(in-package :clouchdb)
(defvar *host* "localhost" "CouchDb server host name")
-(defvar *port* "8888" "CouchDb port")
+(defvar *port* "5984" "As of version 7.2, the IANA assigned CouchDb port (was 8888)")
(defvar *db-name* "default" "Default database name")
(defvar *protocol* "http" "http or https")
@@ -38,6 +38,47 @@
(defparameter *temp-db-counter* 0 "Used in the creation of temporary databases")
;;
+;; URL Parameter helpers
+;;
+
+(defun true-if-true (value)
+ "Return \"true\" if value is non-nil, otherwise nil"
+ (when value "true"))
+
+(defun false-if-false (value)
+ "Return \"false\" if value is nil, otherwise nil"
+ (unless value "false"))
+
+(defvar *view-options*
+ '((:key . ((:name . "key") (:fn . doublequote)))
+ (:start-key . ((:name . "startkey") (:fn . doublequote)))
+ (:start-key-docid . ((:name . "startkey_docid") (:fn . doublequote)))
+ (:end-key . ((:name . "endkey") (:fn . doublequote)))
+ (:count . ((:name . "count") (:fn . value-as-string)))
+ (:update . ((:name . "update") (:fn . false-if-false)))
+ (:descending . ((:name . "descending") (:fn . true-if-true)))
+ (:skip . ((:name . "skip") (:fn . value-as-integer))))
+ "Definitions for how invoke-view keyword parameters are translated
+ into CouchDb parameters")
+
+(defun transform-param (param value table)
+ "Use a keyword transformation table to traslate between function
+ keyword parameter names and values, and URL parameter names and
+ values."
+ (let ((transf (cdr (assoc param table))))
+ (when transf
+ (let ((value (funcall (cdr (assoc :fn transf)) value)))
+ (when value
+ (cons (cdr (assoc :name transf)) value))))))
+
+(defun transform-params (keyword-params options)
+ "Transform each keyword parameter using the specified set of
+options, use only those transformations that return a non-nil result."
+ (loop for param on keyword-params by #'cddr
+ when (transform-param (first param) (second param) options)
+ collect it))
+
+;;
;; Conditions
;;
@@ -92,6 +133,12 @@
((stringp value)
value)))
+(defun value-as-integer (value)
+ (cond ((numberp value)
+ value)
+ ((stringp value)
+ (parse-integer value))))
+
(defun string-join (list &optional (delim #\,))
"Join a bunch of strings into one with a delimiter. Implementation
by Russel McManus on c.l.l."
@@ -123,15 +170,6 @@
convert :db-name to *db-name*"
(intern (cat "*" (string-upcase (symbol-name key)) "*")))
-(defun make-lets (args)
- "Convert a list of keyword/value pairs to a form suitable for the
-innerds of a let. For example, convert '(:db-name (fn1 x x) :host
-'host') to ((*db-name* (fn1 x x) (*host* 'host'))"
- (if (null args)
- nil
- (cons (list (keyword-to-special (first args)) (second args))
- (make-lets (cddr args)))))
-
(defmacro ensure-db ((&key (db-name nil db-name-p)) &body body)
"Warp request in code to check for errors due to non-existant data
bases. Since in a document operation, CouchDb does not distinguish
@@ -192,10 +230,12 @@
(defun db-request (uri &rest keys &key &allow-other-keys)
"Used by all Couchdb APIs to make the actual REST request."
- ;;(format t "uri: ~S~% keys: ~S~%" (make-uri uri) keys)
+;; (format t "uri: ~S~% keys: ~S~%" (make-uri uri) keys)
(let ((*text-content-types* *text-types*))
(multiple-value-bind (body status headers uri stream must-close reason-phrase)
(apply #'drakma:http-request (make-uri uri) keys)
+;; (format t " -> uri: ~S~%" uri)
+;; (format t " -> headers: ~S~%" headers)
(if must-close
(json:decode-json-from-string body)
nil))))
@@ -206,7 +246,9 @@
(defun set-connection (&key (host nil host-p) (db-name nil db-name-p)
(protocol nil protocol-p) (port nil port-p))
- "Set top-level connection information."
+ "Set top-level connection information. The port may be specified as
+a string or number. As of CouchDb version 7.2 the default port is
+5984, prior to that it was 8888."
(when host-p (setf *host* host))
(when db-name-p (setf *db-name* db-name))
(when port-p (setf *port* (value-as-string port)))
@@ -216,9 +258,12 @@
(defmacro with-connection ((&rest args &key db-name port protocol host)
&body body)
"Execute body in the context of the optionally specified host,
-db-name, port or protocol."
+db-name, port or protocol. Port may be a string or a number, protocol
+is http or https. As of CouchDb version 7.2 the default port is 5984,
+prior to that it was 8888."
(declare (ignore db-name port protocol host))
- `(let (,@(make-lets args))
+ `(let (,@(loop for var on args
+ by #'cddr collect (list (keyword-to-special (car var)) (second var))))
, at body))
(defun document-properties (document)
@@ -362,8 +407,9 @@
;; If an ID was specified and that ID does not match the
;; :_id property of the current document, strip the document
;; of all special (CouchDb managed) properties, since these
- ;; are specific to the current document. This will create a
- ;; new document with the same contents as the old one.
+ ;; are specific to the current document. In this case, the
+ ;; presence of the ID parameter means 'create a new document
+ ;; with the same contents as the old one'.
((and id current-id (not (equal current-id id)))
(setf doc (document-properties doc))))
(let ((res (ensure-db ()
@@ -426,12 +472,14 @@
;; Views API
;;
-(defun ad-hoc-view (view)
+(defun ad-hoc-view (view &rest options &key key start-key start-key-docid
+ end-key count update descending skip)
"Execute query using an ad-hoc view."
(ensure-db ()
(db-request (cat *db-name* "/_temp_view")
:method :post
:content-type "text/javascript"
+ :parameters (transform-params options *view-options*)
:content view)))
(defun create-view (id &rest view-defs)
@@ -456,10 +504,18 @@
(ensure-db ()
(delete-document :id (cat "_design/" id) :revision revision)))
-(defun invoke-view (id view &key (key nil))
+(defun invoke-view (id view &rest options &key key start-key start-key-docid
+ end-key count update descending skip)
"Invoke a view by specifiying the document ID that contains the view
-and the name of the contained view."
+and the name of the contained view. The key parameter specifies an
+optional value to match against the view's mapped field. The start-key
+and end-key values specify the optional begin and end range of the
+mapped field(s) of each document to return. If descending is t,
+returns results in reverse order. If update is t, does not refresh
+view for query, use for higher performance but possible data
+inconsistency."
+ (declare (ignore key start-key start-key-docid end-key count update descending skip))
(ensure-db ()
(db-request (cat *db-name* "/_view/" id "/" view)
:method :get
- :parameters (if key `(("key" . ,(doublequote key)))))))
+ :parameters (transform-params options *view-options*))))
--- /project/clouchdb/cvsroot/clouchdb/src/examples.lisp 2007/12/01 14:19:59 1.1.1.1
+++ /project/clouchdb/cvsroot/clouchdb/src/examples.lisp 2007/12/09 16:03:21 1.2
@@ -33,7 +33,11 @@
;; represent the defaults.
;(defparameter *host* "localhost")
+
+;; Port for CouchDb versions prior to 7.2
;(defparameter *port* "8888")
+;; Port CouchDb 7.2 and later
+;(defparameter *port* "5984")
;(defparameter *scheme* "http")
;;
@@ -52,7 +56,7 @@
;; Create a document with ID of "haussmann"
(create-document '(;; Fields with scalar values:
(:name . "Georges-Eugene Haussmann")
- ;; Note: above should be "Georges-Eugène", but
+ ;; Note: above should be "Georges-Eugène" but
;; there's a character handling bug somewhere
(:aka . "Baron Haussmann")
(:born . "1809-03-27")
--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp 2007/12/01 14:19:59 1.1.1.1
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp 2007/12/09 16:03:21 1.2
@@ -111,7 +111,7 @@
(:dynamic-variables
(*db-name* nil)
(*host* "localhost")
- (*port* "8888")
+ (*port* "5984")
(*protocol* "http")))
;;
@@ -233,6 +233,11 @@
(ensure-condition 'id-missing (put-document '((:a "test")))))
(addtest (clouchdb-doc-api-tests)
+ (:documentation "Get a non-existant document (error)")
+ get-non-existant-document
+ (ensure-condition 'document-missing (get-document "does-not-exist")))
+
+(addtest (clouchdb-doc-api-tests)
(:documentation "Test revision info")
get-document-revision-info
(ensure-same 11 (progn
More information about the clouchdb-cvs
mailing list