[clouchdb-cvs] CVS clouchdb/src

[peddy]

Update of /project/clouchdb/cvsroot/clouchdb/src
In directory clnet:/tmp/cvs-serv869/src

Modified Files:
	package.lisp clouchdb.lisp 
Log Message:
Fixe bulk-document-update so it works with 7.3+ changes


--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2008/06/14 21:31:35	1.8
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2008/06/15 18:00:39	1.9
@@ -49,6 +49,7 @@
 	   :with-connection
 	   :document-properties
 	   :document-property
+           :couchdb-document-properties
            :document-id
            :query-document
            :set-document-property
@@ -65,6 +66,7 @@
 	   :post-document
 	   :create-document
 	   :bulk-document-update
+           :as-deleted-document
 	   :delete-document
 	   :create-view
 	   :create-ps-view
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2008/06/14 21:30:40	1.24
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2008/06/15 18:00:39	1.25
@@ -285,15 +285,6 @@
           (t (rplacd (assoc name doc) value)))
     doc))
 
-;; (defun set-document-property (doc name value)
-;;   "Set a property of a document. If the named property does not exist,
-;; add it to the document, otherwise change the existing value.  Does not
-;; destructively modify input document, so be sure to use return value."
-;;   (let ((doc (copy-tree doc)))
-;;     (if (assoc name doc)
-;;         (setf (document-property name doc) value)
-;;         (cons `(,(as-keyword-symbol name) . ,value) doc))))
-
 (defun set-document-property (doc &rest args)
   "Set a property of a document. If the named property does not exist,
 add it to the document, otherwise change the existing value.  Does not
@@ -384,7 +375,7 @@
 ;;      (format t "  -> uri: ~a~%" uri)
 ;;      (format t "  -> headers: ~S~%" headers)
       (cond (must-close
-;;             (format t "body: ~S~%" body)
+             ;;(format t "body: ~S~%" body)
              (json-to-document body))
             (t nil)))))
 
@@ -435,11 +426,11 @@
 (defun document-properties (document)
   "Return the document properties, filtering out any couchdb reserved
 properties (properties that start with an underscore)."
-  (let ((props))
-    (dolist (p document)
-      (unless (equal "_" (subseq (symbol-name (car p)) 0 1))
-	(push p props)))
-    props))
+  (remove-if #'(lambda (e) (equal "_" (subseq (symbol-name (car e)) 0 1))) document))
+
+(defun couchdb-document-properties (document)
+  "Return only CouchDb specific document properties (opposite of document-properties)."
+  (remove-if-not #'(lambda (e) (equal "_" (subseq (symbol-name (car e)) 0 1))) document))
 
 ;;
 ;; CouchDB Database Management API
@@ -660,19 +651,29 @@
       (put-document doc :id id :attachments attachments)
       (post-document doc)))
 
+(defun as-deleted-document (doc)
+  "Return specified document in a special document format used by
+bulk-document-update to indicate that the document should be deleted
+in the bulk operation."
+  (set-document-property (couchdb-document-properties doc)
+                         :|_deleted| t))
+
 (defun bulk-document-update (docs)
   "Update multiple documents in a single request. The docs parameter
-should be a list of documents."
+must be a list of documents. If the provided documents do not contain
+an :|_id| value, then a document is created with a CouchDb assigned
+ID. Any documents containing a (:|_deleted| . t) value will "
   (ensure-db () 
     (db-request (cat (url-encode *db-name*) "/_bulk_docs")
 		:method :post
-                :content-type "application/xml"
+                :content-type "text/javascript"
                 :external-format-out +utf-8+
                 :content-length nil
 		:content 
-                (cat "[ " 
-		     (string-join (mapcar #'document-to-json docs)) 
-		     " ] "))))
+                (cat "{ \"docs\": [ " 
+		     (string-join 
+                      (mapcar #'document-to-json docs))
+		     " ] }"))))
 
 (defun delete-document (&key document id revision if-missing)
   "Delete a revision of a document. If the id parameter is provided