[clouchdb-cvs] CVS clouchdb/src

[peddy]

Update of /project/clouchdb/cvsroot/clouchdb/src
In directory cl-net:/tmp/cvs-serv7350/src

Modified Files:
	tests.lisp clouchdb.lisp changelog.txt 
Log Message:
Add property list option to (document-property) and (setf (document-property))


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/17 00:26:31	1.25
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/18 21:14:49	1.26
@@ -144,6 +144,20 @@
                      doc)))))
 
 (addtest (clouchdb-general-tests)
+  (:documentation "Test accessing document property with property list")
+  general-tests-document-property-list-access
+  (ensure-same "found"
+               (document-property '(:a :b :c)
+                                  '((:one . 2)(:a . ((:b . ((:c . "found")))))))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Test accessing document property with property list")
+  general-tests-document-property-list-modify
+  (let ((doc '((:one . 2) (:a . ((:b . ((:c . "not found"))))))))
+    (setf (document-property '(:a :b :c) doc) "found")
+    (ensure-same "found" (document-property '(:a :b :c) doc))))
+
+(addtest (clouchdb-general-tests)
   (:documentation "Test case-encoded field name functions")
   general-tests-case-encoded
   (ensure-same "lowercase" (as-field-name-string (as-keyword-symbol "lowercase")))
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/17 00:26:32	1.42
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/18 21:14:49	1.43
@@ -339,17 +339,34 @@
 (defun document-property (name doc)
   "Get the value associated with the document property or nil if there
 is no associated value. Note that name may be either a keyword symbol,
-a regular symbol or a string."
-  (let ((name (as-keyword-symbol name)))
-    (cond ((hash-table-p doc)
-           (gethash name doc))
-          (t (cdr (assoc name doc))))))
+a regular symbol or a string. The <b>name</b> parameter may be either
+a single keyword identifier (document property identifier) or it may
+be a list of identifiers."
+  (cond ((or (null name) (null doc))
+         doc)
+        ((listp name)
+         (if (> (length name) 1)
+             (document-property (rest name)
+                                (document-property (car name) doc))
+             (document-property (car name) doc)))
+        (t (let ((name (as-keyword-symbol name)))
+             (cond ((hash-table-p doc)
+                    (gethash name doc))
+                   (t (cdr (assoc name doc))))))))
 
 (defun (setf document-property) (value name doc)
   "Allows setting of existing document properties in
-place (destructively)."
+place (destructively). The name paramter may be either a single
+keyword identifier (document property identifier) or it may be a list
+of identifiers."
   (let ((name (as-keyword-symbol name)))
-    (cond ((hash-table-p doc)
+    (cond ((listp name)
+           (if (> (length name) 1)
+               (setf (document-property (rest name)
+                                        (document-property (car name) doc))
+                     value)
+               (setf (document-property (car name) doc) value)))
+          ((hash-table-p doc)
            (setf (gethash name doc) value))
           (t (rplacd (assoc name doc) value)))
     doc))
@@ -1116,6 +1133,25 @@
          (error 'ps-view-def-error :ps-view-def
                 "reduce takes two parameters, e.g.: (defun reduce (keys values) (...))"))))
 
+(defmacro ps-function (&body body)
+  "Create a view using parenscript"
+  `(with-output-to-string (out)
+     (write-string "{" out)
+     (write-string 
+      (string-join
+       (list 
+         ,@(mapcar #'(lambda (fn)
+                       (destructuring-bind (defun fn-name fn-param fn-body) fn
+                         (declare (ignore defun))
+                         `(cat "\"" 
+                               (string-downcase (symbol-name (quote ,fn-name)))
+                               "\": \""
+                               (parenscript::ps (lambda (, at fn-param) ,fn-body))
+                               "\"")))
+                   body))
+       :ignore-nil t) out)
+     (write-string "}" out)))
+
 (defmacro ps-view ((&optional view-name) &body body)
   "Create a view using parenscript"
   `(with-output-to-string (out)
@@ -1163,3 +1199,9 @@
                      (url-encode id) "/_view/" (url-encode view))
 		:method :get
                 :parameters (transform-params options *view-options*))))
+
+
+;; (defun add-ps-lists (id &rest list-defs)
+;;   (let ((doc (get-document id :if-missing '((:lists)))))
+;;     (put-document (set-document-property
+;;                    :id id
\ No newline at end of file
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/17 00:26:32	1.13
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/18 21:14:49	1.14
@@ -4,6 +4,7 @@
   - Added error handling in create-db for illegal database names
   - Added get-uuids function and related doc
   - Remembered to increment *couchdb-version* for the first time in a long time
+  - Made (document-property) and (setf (document-property)) accept list of property names
 
 0.0.11: