[clouchdb-cvs] CVS clouchdb/src

[peddy]

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

Modified Files:
	tests.lisp clouchdb.lisp 
Log Message:
Changes for (delete-document) and related tests


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/20 21:32:52	1.27
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/22 20:31:31	1.28
@@ -28,6 +28,9 @@
 
 (in-package :clouchdb-tests)
 
+(defvar *this-file* (load-time-value
+                     (or #.*compile-file-pathname* *load-pathname*)))
+
 (defparameter *people* 
   (list '((:name . "peter")
 	  (:city . "boston")
@@ -312,15 +315,15 @@
   (ensure (clouchdb::assoclp '((:a . nil) (:b . "froth")))))
 
 (addtest (clouchdb-general-tests)
-  (:documentation "test assoclp function for negative")
+  (:documentation "test assoclp function for non-matches")
   general-tests-assoclp-negative
   (ensure-null (clouchdb::assoclp '()))
   (ensure-null (clouchdb::assoclp '(:a . 3)))
   (ensure-null (clouchdb::assoclp '(:a (1 2 3))))
   (ensure-null (clouchdb::assoclp '(:a (:b . "sea"))))
-  (ensure-null (clouchdb::assoclp '(:a ((:b . "sea") (:d . "e")))))
-  (ensure-null (clouchdb::assoclp '((:aye :bee :sea))))
-  (ensure-null (clouchdb::assoclp '((:aye :bee (:a . 3) (:b . "froth"))))))
+  (ensure-null (clouchdb::assoclp '(:a ((:b . "sea") (:d . "e"))))))
+  ;;(ensure-null (clouchdb::assoclp '((:aye :bee :sea))))
+  ;;(ensure-null (clouchdb::assoclp '((:aye :bee (:a . 3) (:b . "froth"))))))
 
 (addtest (clouchdb-general-tests)
   (:documentation "*document0* query tests ")
@@ -568,6 +571,18 @@
   (ensure-condition 'document-missing (get-document "does-not-exist")))
 
 (addtest (clouchdb-doc-api-tests)
+  (:documentation "Get a non-existant document, ignore error")
+  get-non-existant-document-ignore1
+  (ensure-same nil
+               (get-document "does-not-exist" :if-missing :ignore)))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Get a non-existant document, use missing value")
+  get-non-existant-document-missing-value
+  (ensure-same "hi"
+               (get-document "does-not-exist" :if-missing "hi")))
+
+(addtest (clouchdb-doc-api-tests)
   (:documentation "Test revision info")
   get-document-revision-info
   (ensure-same 11 (progn 
@@ -661,6 +676,16 @@
   (ensure-condition 'document-missing (delete-document "specified")))
 
 (addtest (clouchdb-doc-api-tests)
+  (:documentation "Delete a non-existant document and ignore error")
+  delete-document-missing-ignore
+  (ensure-same nil (delete-document "specified" :if-missing :ignore)))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Delete a non-existant document and return custom value")
+  delete-document-missing-custom-value
+  (ensure-same "hi" (delete-document "specified" :if-missing "hi")))
+
+(addtest (clouchdb-doc-api-tests)
   (:documentation "Add a bunch of documents and ensure they get created.")
   create-document-test1
   (ensure-same (length (create-test-documents *people* :id-field :name))
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/20 21:32:53	1.44
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/22 20:31:31	1.45
@@ -718,7 +718,8 @@
 one."
   (unless id
     (error 'id-missing))
-  (let ((parameters))
+  (let ((parameters)
+        (doc-id (document-id id)))
     (when conflicts (push (cons "conflicts" "true") parameters))
     (when revision
       (push (cons "rev" (value-as-string revision)) parameters))
@@ -729,7 +730,7 @@
     (let ((res (ensure-db () (db-request (cat (url-encode 
                                                (db-name *couchdb*)) 
                                               "/" 
-                                              (url-encode id))
+                                              (url-encode doc-id))
 					 :method :get 
 					 :parameters parameters))))
       (if (document-property :|error| res)
@@ -738,7 +739,7 @@
                    nil)
                   ((and if-missing-p (not (eq if-missing :error)))
                    if-missing)
-                  (t (error 'document-missing :id id))))
+                  (t (error 'document-missing :id doc-id))))
 	  (document-update-notify 
            (db-document-fetch-fn *couchdb*) res)))))
 		      
@@ -918,7 +919,7 @@
                       (mapcar #'document-to-json docs))
 		     " ]}"))))
 
-(defun delete-document (doc-or-id &key revision if-missing)
+(defun delete-document (doc-or-id &key revision (if-missing :error))
   "Delete a document. The doc-or-id parameter may be either the
  document ID or the document itself. If the doc-or-id value is the
  document ID and no revision parameter is specified, then the document
@@ -939,19 +940,23 @@
                  (error 'doc-error :id id 
                         :reason (document-property :|reason| res)))
                res)))
-    (cond ((stringp doc-or-id)
-           (del doc-or-id 
-                (if revision 
-                    revision 
-                    (document-revision (get-document doc-or-id
-                                                     :if-missing
-                                                     (if (eq if-missing :ignore)
-                                                         :ignore
-                                                         :error))))))
-           ((and doc-or-id (listp doc-or-id))
-            (del (document-id doc-or-id) 
-                 (or revision
-                     (document-revision doc-or-id)))))))
+    (cond ((null doc-or-id)
+           (error 'id-missing))
+          ((stringp doc-or-id)
+           (let ((rev (or revision
+                          (document-revision 
+                           (get-document doc-or-id
+                                         :if-missing
+                                         (if (eq :error if-missing)
+                                             :error 
+                                             nil))))))
+             (if rev
+                 (del doc-or-id rev)
+                 (if (eq :ignore if-missing) nil if-missing))))
+          ((listp doc-or-id)
+           (delete-document (document-id doc-or-id)
+                             :revision (or revision (document-revision doc-or-id))
+                             :if-missing if-missing)))))
 
 ;;
 ;; Attachment API