From peddy at common-lisp.net  Mon Jul  6 22:24:45 2009
From: peddy at common-lisp.net (peddy)
Date: Mon, 06 Jul 2009 18:24:45 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MNwc9-0002Cu-EH@common-lisp.net>

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

Modified Files:
	changelog.txt clouchdb.lisp package.lisp tests.lisp 
Log Message:
Lots of updates, including storing of db info in structure, support for attachments and replication.


--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2008/06/28 22:55:07	1.9
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/06 22:24:45	1.10
@@ -1,4 +1,36 @@
 
+0.0.11:
+
+  - Switched to using a structure to hold the database connection
+    information that was previously contained in special
+    variables. The structure is itself now a single special variable
+    called *db*
+
+  - Added support for stand-alone attachements
+
+  - Added get-couchdb-info for getting CouchDb server information,
+    previously this was available via get-db-info when no DB was
+    specified.
+
+  - Added database compaction support with the function compact-db
+
+  - Added replication support with the replicate function
+
+  - Added all-docs-by-seq function
+
+  - Changed delete-document to take a required parameter which is
+    either the document ID or the document, removed the keyword
+    parameters :id and :document.
+
+  - Updated various functions to use recently added CouchDb
+    parameters:
+
+    bulk-document-update:
+     - added all-or-nothing parameter
+
+        
+
+
 0.0.10:
 
   - Views now use the new map/reduce/emit style JavaScript definitions
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/06/27 13:05:23	1.35
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/06 22:24:45	1.36
@@ -24,12 +24,26 @@
 
 (in-package :clouchdb)
 
-(defvar *host* "localhost" "CouchDb server host name")
-(defvar *port* "5984" "The IANA assigned CouchDb port")
-(defvar *db-name* "default" "Default database name")
-(defvar *protocol* "http" "http or https")
-(defvar *document-update-fn* nil)
-(defvar *document-fetch-fn* nil)
+(defvar *default-host* "localhost" "CouchDb server host name")
+(defvar *default-port* "5984" "The IANA assigned CouchDb port")
+(defvar *default-db-name* "default" "Default database name")
+(defvar *default-protocol* "http" "http or https")
+(defvar *default-content-type* "application/octet-stream")
+
+(defvar *debug-requests* nil)
+
+(defstruct db
+  host port name protocol 
+  user password
+  document-fetch-fn document-update-fn)
+
+(defun make-default-db ()
+  (make-db :host *default-host*
+           :port *default-port*
+           :name *default-db-name*
+           :protocol *default-protocol*))
+
+(defvar *db* (make-default-db) "A db struct object")
 
 (defvar *text-types* 
   '(("text" . nil) 
@@ -106,21 +120,21 @@
 
 (define-condition db-existential-error (error)
   ((text :initarg :uri :reader uri)
-   (db-name :initarg :db-name :reader db-name)
+   (db :initarg :db :reader db)
    (result :initarg :result :reader result)))
 
 (define-condition db-does-not-exist (db-existential-error) 
   ()
   (:report (lambda (condition stream)
 	     (format stream "Database \"~A\" at \"~A\" does not exist" 
-		     (db-name condition)
+		     (db-name (db condition))
 		     (uri condition)))))
 
 (define-condition db-already-exists (db-existential-error) 
   ()
   (:report (lambda (condition stream)
 	     (format stream "Database \"~A\" at \"~A\" already exists" 
-		     (db-name condition)
+		     (db-name (db condition))
 		     (uri condition)))))
 
 (define-condition doc-error (error) 
@@ -151,6 +165,17 @@
 		     (id condition))))
   (:documentation "Error raised when no document matching ID is found"))
 
+(define-condition attachment-missing (doc-error)
+  ((attachment-name :initarg :attachment-name :reader att-name)
+   (attachments :initarg :attachments :reader attachments))
+  (:report (lambda (condition stream)
+             (format stream "No attachment named \"~A\" found for
+             document ID \"~A\", known attachments: ~s"
+                     (att-name condition)
+                     (id condition)
+                     (attachments condition))))
+  (:documentation "Error raised when specified attachment is not found"))
+
 (define-condition ps-view-def-error (error)
   ((ps-view-def :initarg :ps-view-def :reader ps-view-def))
   (:report (lambda (condition stream)
@@ -158,6 +183,13 @@
                      (ps-view-def condition))))
   (:documentation "Error raised for invalid ps-view definition"))
 
+(define-condition invalid-input (error)
+  ((input :initarg :input :reader input)
+   (description :initarg :description :reader description))
+  (:report (lambda (condition stream)
+	     (format stream "Invalid input \"~A\", Description=~S"
+		     (input condition) (description condition)))))
+
 ;;
 ;; Unexported utility functions
 ;;
@@ -212,17 +244,26 @@
                      (write-string "%20" s))
                    (t (format s "%~2,'0x" (char-code c)))))))
 
+(defun couchdb-host-url (db)
+  (cat (db-protocol db) "://" (db-host db) ":" (db-port db)))
+
+(defun couchdb-database-url (db)
+  (cat (couchdb-host-url db) "/" (db-name db)))
+
+(defun make-db-identifier (input)
+  "Make a database identifier from either a string or db structure."
+  (cond ((stringp input) input)
+        ((db-p input) (couchdb-database-url input))
+        (t (error 'invalid-input 
+                  :input input
+                  :description "Database must be a string or a database structure"))))
+
 (defun make-uri (&rest rest)
-  "Return a URI containing *protocol*://*host*:*port*/ and the
-concatenation of the remaining parameters."
-  (concatenate 'string *protocol* "://" *host* ":" *port* "/"
+  "Return a URI containing protocol://host:port/ and the concatenation
+of the remaining parameters."
+  (concatenate 'string (couchdb-host-url *db*) "/"
 	       (apply #'concatenate 'string rest)))
 
-(defun keyword-to-special (key)
-  "Convert a keyword symbol to a special symbol. For example,
-  convert :db-name to *db-name*"
-  (intern (cat "*" (string-upcase (symbol-name key)) "*")))
-
 (defmacro ensure-db ((&key (db-name nil db-name-p)) &body body)
   "Wrap request in code to check for errors due to non-existant data
 bases. This is necessary because in a document operation, CouchDb does
@@ -230,12 +271,12 @@
 missing database."
   (let ((result (gensym)))
     `(let ((,result (progn , at body)))
-       (when (equal "not_found" (document-property :|error| ,result))
-	 (let ((dbn (if ,db-name-p ,db-name *db-name*)))
-	   (if (document-property :|error|  (get-db-info :db-name dbn))
+       (when (and (listp ,result) 
+                  (equal "not_found" (document-property :|error| ,result)))
+	 (let ((*db* (if ,db-name-p (db-from-env :name ,db-name) *db*)))
+	   (if (document-property :|error| (get-db-info))
 	       (error 'db-does-not-exist
-		      :result ,result :db-name dbn
-		      :uri (make-uri dbn)))))
+		      :result ,result :db *db* :uri (make-uri)))))
        ,result)))
 
 (defun document-as-hash (doc)
@@ -309,6 +350,15 @@
   (or (document-property :|_id| doc)
       (document-property :|id| doc)))
 
+(defun document-revision (doc-or-id)
+  "Return the revision number for the document, identified by either
+the document ID, the actual document, or the result of an add or
+update that returns the revision as :|rev|"
+  (cond ((stringp doc-or-id)
+         (document-revision (get-document doc-or-id)))
+        (t (or (document-property :|_rev| doc-or-id)
+               (document-property :|rev| doc-or-id)))))
+
 (defun query-document (query doc)
   "Return a list of all values in the document matching the query. For
 example, given the document:
@@ -373,125 +423,134 @@
 ;;
 
 (defun db-request (uri &rest args &key &allow-other-keys)
-  "Used by all Couchdb APIs to make the actual REST request."
+  "Used by most Clouchdb APIs to make the actual REST request."
   (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) args)
-      (declare (ignore reason-phrase stream uri headers status))
-      (cond (must-close
-             (json-to-document body))
-            (t nil)))))
-
-;; (defun cached-db-request (cache uri &rest args &key parameters &allow-other-keys)
-;;   "If a cache is supplied try it first before reqesting from
-;; server. Cache result if cache is not nil."
-;;   (cond (cache
-;;          (let ((cache-key (if parameters (cons uri parameters) uri)))
-;;            (format t "cache key: ~s~%" cache-key)
-;;            (let ((cached (get-cached cache-key cache)))
-;;              (cond (cached
-;;                     cached)
-;;                    (t
-;;                     (setf (get-cached cache-key cache) (apply #'db-request uri args)))))))
-;;         (t (apply #'db-request uri args))))
+      ;;(declare (ignore must-close reason-phrase stream uri headers status))
+      (when *debug-requests*
+        (format t "uri: ~s~%args: ~s~%must-close:~s~%reason-phrase:
+        ~s~%status: ~s~%headers: ~s~%stream:~s~%body:~s~%" uri args
+        must-close reason-phrase status headers stream body))
+      (if (stringp body) 
+          (json-to-document body)
+          (values body status reason-phrase)))))
+
+(defun db-from-env (&key host port name protocol user password
+                    document-fetch-fn document-update-fn (db *db*))
+  "Create, populate and return a database structure from the current
+special variables and any supplied keyword parameters, the latter take
+precendence over the special vars."
+  (make-db :host (or host (db-host db) *default-host*)
+           :port (or port (db-port db) *default-port*)
+           :name (or name (db-name db) *default-db-name*)
+           :protocol (or protocol (db-protocol db) *default-protocol*)
+           :user (or user (db-user db))
+           :password (or password (db-password db))
+           :document-fetch-fn (or document-fetch-fn (db-document-fetch-fn db))
+           :document-update-fn (or document-update-fn (db-document-update-fn db))))
 
-;;
-;;
-;;
-
-(defun set-connection (&key (host nil host-p) (db-name nil db-name-p) 
-		       (protocol nil protocol-p) (port nil port-p)
-                       (document-update-fn nil document-update-fn-p)
-                       (document-fetch-fn nil document-fetch-fn-p))
+(defun set-connection (&key host db-name protocol port
+                       (db *db*) document-update-fn document-fetch-fn)
   "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)))
-  (when protocol-p (setf *protocol* protocol))
-  (when document-update-fn-p (setf *document-update-fn* document-update-fn))
-  (when document-fetch-fn-p (setf *document-fetch-fn* document-fetch-fn))
-  (values))
+  (setf *db* (db-from-env :db db :host host :name db-name 
+                          :protocol protocol :port port
+                          :document-update-fn document-update-fn
+                          :document-fetch-fn document-fetch-fn)))
 
-(defmacro with-connection ((&rest args &key db-name port protocol host
-                                  document-update-fn document-fetch-fn)
+(defmacro with-connection ((&key db-name port protocol host
+                                 document-update-fn document-fetch-fn)
 			   &body body)
   "Execute body in the context of the optionally specified host,
 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,
+qis 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 document-update-fn document-fetch-fn))
-  `(let (,@(loop for var on args 
-              by #'cddr collect (list (keyword-to-special (car var)) (second var))))
-     , at body))
+  `(let ((*db* (db-from-env :name ,db-name :port ,port 
+                            :protocol ,protocol :host ,host 
+                            :document-fetch-fn ,document-fetch-fn
+                            :document-update-fn ,document-update-fn)))
+     (progn , at body)))
 
 (defun document-properties (document)
   "Return the document properties, filtering out any couchdb reserved
 properties (properties that start with an underscore)."
-  (remove-if #'(lambda (e) (equal "_" (subseq (symbol-name (car e)) 0 1))) document))
+  (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))
+  "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
 ;;
 
 (defun list-dbs ()
-  "Return a list of all databases for the current host and port."
+  "Return a list of all databases managed by the current CouchDb
+host."
   (db-request "_all_dbs" :method :get))
 
-(defun create-db (&key (db-name nil db-name-p) (if-exists :fail))
-  "Create database. If db-name is unspecified, uses *db-name*. If
+(defun create-db (&key (db *db*) (db-name nil db-name-p) (if-exists :fail))
+  "Create database. If db and db-name are unspecified, uses *db*. If
 database already exists an error condition is raised. This condition
 can be avoided by specifying :ingore for if-exists. In this case no
 error condition is generated. Specify :recreate to potentially delete
 and create a new database."
-  (let* ((name (if db-name-p db-name *db-name*))
-	 (res (db-request (cat (url-encode name) "/") 
-                          :method :put :content "")))
-    (if (equal "file_exists" (document-property :|error| res))
-      (ecase if-exists
-	((:ignore) (list (cons :|ok| t) (cons :|ignored| t)))
-	((:recreate) 
-	 (delete-db :db-name name) 
-	 (create-db :db-name name))
-	((:fail)
-	 (restart-case
-	     (error 'db-already-exists
-		    :result res :db-name name
-		    :uri (make-uri name))
-	   (ignore () :report "Ignore error and continue" nil))))
-      res)))
-
-(defun delete-db (&key (db-name nil db-name-p) if-missing)
-  "Delete database. If db-name is unspecified, deletes database named
-in *db-name*. Normally deletion of non-existent databases generates an
-error condition, but this can be avoided by specifying :ignore in the
-if-missing parameter."
-  (let* ((name (if db-name-p db-name *db-name*))
+  (let ((*db* (if db-name-p (db-from-env :db db :name db-name) db)))
+    (let ((res (db-request (cat (url-encode (db-name *db*)) "/")
+                           :method :put :content "")))
+      (if (equal "file_exists" (document-property :|error| res))
+          (ecase if-exists
+            ((:ignore) 
+             (list (cons :|ok| t) (cons :|ignored| t)))
+            ((:recreate) 
+             (delete-db)
+             (create-db))
+            ((:fail)
+             (restart-case
+                 (error 'db-already-exists
+                        :result res 
+                        :db *db*
+                        :uri (make-uri (db-name *db*)))
+               (ignore () :report "Ignore error and continue" nil))))
+          res))))
+
+(defun delete-db (&key (db *db*) (db-name nil db-name-p) if-missing)
+  "Delete database. If db and db-name are unspecified, deletes
+database named in *db*. Normally deletion of non-existent databases
+generates an error condition, but this can be avoided by
+specifying :ignore in the if-missing parameter."
+  (let* ((name (if db-name-p db-name (db-name db)))
 	 (res (db-request (cat (url-encode name) "/") :method :delete)))
     (if (and (document-property :|error| res) (not (eq :ignore if-missing)))
 	(restart-case 
 	    (error 'db-does-not-exist
-		   :result res :db-name name
-		   :uri (make-uri name))
+		   :result res :db db :uri (make-uri))
 	  (ignore () :report "Ignore error and continue" nil)))
     res))
 
-(defun compact-db (&key (db-name *db-name*))
+(defun compact-db (&key (db *db*))
   "Start compaction on current database, or specified database if
 supplied."
-  (ensure-db (:db-name db-name)
-    (db-request (cat db-name "/_compact") :method :post)))
+  (let ((*db* db))
+    (ensure-db ()
+      (db-request (cat (db-name *db*) "/_compact") :method :post))))
 
-(defun get-db-info (&key (db-name nil db-name-p))
-  "Get information for named database, or couchdb server if no
-database specified."
-  (let ((dbn (if db-name-p db-name *db-name*)))
-    (db-request (if dbn (cat (url-encode dbn) "/"))
+(defun get-couchdb-info (&key (db *db*))
+  "Get information from the couchdb server."
+  (let ((*db* db))
+    (db-request nil :method :get)))
+
+(defun get-db-info (&key (db *db*) db-name)
+  "Get information for named database, return ((:|error|
+  . \"not_found\") (:|reason| . \"no_db_file\")) if database does not
+  exist."
+  (let ((*db* (db-from-env :db db :name db-name)))
+    (db-request (cat (url-encode (db-name *db*)) "/")
                 :method :get)))
 
 (defun create-temp-db-name ()
@@ -503,40 +562,60 @@
 
 (defun create-temp-db (&key (db-name-creator #'create-temp-db-name))
   "Create a temporary database."
-  (let ((db-name (funcall db-name-creator)))
-    (let ((res (create-db :db-name db-name)))
+  (let ((db (db-from-env :name (funcall db-name-creator))))
+    (let ((res (create-db :db db)))
       (if (document-property :|error| res)
 	  (error (format t "Error ~S creating database: ~A"
-		       (document-property :|error| res) db-name))))
-    db-name))
+		       (document-property :|error| res) (db-name db)))))
+    db))
 
 (defmacro with-temp-db (&body body)
   "Execute body in context of newly created, temporary
 database. Delete database before return."
-  (let ((temp-db-name (gensym))
-	(result (gensym)))
-    `(let* ((,temp-db-name (create-temp-db))
-	    (,result (with-connection (:db-name ,temp-db-name)
-		      , at body)))
-       (delete-db ,temp-db-name)
+  (let ((result (gensym)))

[429 lines skipped]
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/04/19 22:48:32	1.11
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/06 22:24:45	1.12
@@ -26,51 +26,81 @@
 
 (defpackage :clouchdb
   (:use :cl :drakma :flexi-streams :s-base64 :parenscript)
-  (:export :*scheme*
-	   :*host*
-	   :*port*
-	   :*db-name*
-           :*document-update-fn*
-           :*document-fetch-fn*
-           :as-keyword-symbol
-           :as-field-name-string
-	   :db-existential-error
-	   :db-does-not-exist
-	   :db-already-exists
-	   :doc-error
-	   :id-or-revision-conflict
-	   :id-missing
-	   :document-missing
-	   :document-to-json
-           :json-to-document
-	   :document-as-hash
-           :encode-document
-	   :set-connection
-	   :with-connection
-	   :document-properties
-	   :document-property
-           :couchdb-document-properties
-           :document-id
-           :query-document
-           :set-document-property
-	   :list-dbs
-	   :create-db
-	   :delete-db
-	   :create-temp-db
-	   :create-temp-db-name
-	   :with-temp-db
-	   :get-db-info
-	   :get-all-documents
-	   :get-document
-	   :put-document
-	   :post-document
-	   :create-document
-	   :bulk-document-update
-           :as-deleted-document
-	   :delete-document
-	   :create-view
-	   :create-ps-view
-	   :ps-view
-	   :delete-view
-	   :invoke-view
-	   :ad-hoc-view))
+  (:export 
+   :ad-hoc-view
+   :attachment-name
+   :bulk-document-update
+   :create-db
+   :create-document
+   :create-ps-view
+   :create-temp-db
+   :create-temp-db-name
+   :create-view
+   :db-already-exists
+   :db-does-not-exist
+   :db-existential-error
+   :delete-db
+   :delete-document
+   :delete-view
+   :doc-error
+   :document-as-hash
+   :document-missing
+   :document-properties
+   :document-property
+   :document-to-json
+
+
+
+
+
+
+   :get-all-documents
+   :get-couchdb-info
+   :get-db-info
+   :get-document
+   :id-missing
+   :id-or-revision-conflict
+   :invoke-view
+   :list-dbs
+   :post-document
+   :ps-view
+   :put-document
+   :set-connection
+   :with-connection
+   :with-temp-db
+   :*db*
+   :*db*
+   :*document-fetch-fn*
+   :*document-update-fn*
+   :add-attachment
+   :all-docs-by-seq
+   :as-deleted-document
+   :as-field-name-string
+   :as-keyword-symbol
+   :attachment-list
+   :attachment-missing
+   :compact-db
+   :couchdb-document-properties
+   :database
+   :db-document-fetch-fn
+   :db-document-update-fn
+   :db-from-env
+   :db-host
+   :db-name
+   :db-password
+   :db-port
+   :db-user
+   :delete-attachment
+   :document-id
+   :document-revision
+   :encode-document
+   :get-attachment-name
+   :get-attachment-stream
+   :invalid-input
+   :json-to-document
+   :make-db
+   :query-document
+   :replicate
+   :save-attachment
+   :set-document-property
+   :with-attachment))
--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/06/06 19:15:18	1.17
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/06 22:24:45	1.18
@@ -1,5 +1,4 @@
 ;;; -*- Mode: LISP; Syntax: COMMON-LISP; Package: CLOUCHDB-EXAMPLES; Base: 10 -*-
-
 ;;; Copyright (c) 2007 Peter Eddy. All rights reserved.
 
 ;;; Permission is hereby granted, free of charge, to any person
@@ -127,19 +126,11 @@
 ;; CouchDb server information.
 ;;
 
-(deftestsuite clouchdb-tests () 
-  ()
-  (:dynamic-variables 
-   (*db-name* nil) 
-;   (*host* "localhost") 
-   (*port* "5984") 
-   (*protocol* "http")))
-
 ;;
 ;; General tests that do not require a db connection
 ;;
 
-(deftestsuite clouchdb-general-tests (clouchdb-tests) () ())
+(deftestsuite clouchdb-general-tests () ())
 
 (addtest (clouchdb-general-tests)
   (:documentation "Ensure document-property gets correct value from document")
@@ -157,8 +148,10 @@
   general-tests-case-encoded
   (ensure-same "lowercase" (as-field-name-string (as-keyword-symbol "lowercase")))
   (ensure-same "MixedCase" (as-field-name-string (as-keyword-symbol "MixedCase")))
-  (ensure-same "Mixed-Case-Hyphen" (as-field-name-string (as-keyword-symbol "Mixed-Case-Hyphen")))
-  (ensure-same "UPPER-CASE" (as-field-name-string (as-keyword-symbol "UPPER-CASE"))))
+  (ensure-same "Mixed-Case-Hyphen" 
+               (as-field-name-string (as-keyword-symbol "Mixed-Case-Hyphen")))
+  (ensure-same "UPPER-CASE" 
+               (as-field-name-string (as-keyword-symbol "UPPER-CASE"))))
 
 (addtest (clouchdb-general-tests)
   (:documentation "test keyword-assocp for positive match")
@@ -279,29 +272,32 @@
 ;; databases or the server.
 ;;
 
-(deftestsuite clouchdb-db-admin-tests (clouchdb-tests) () ())
+(deftestsuite clouchdb-db-admin-tests () ())
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Look for the welcome message and version info from server")
   generic-server-info-query
-  (ensure-same "Welcome" (document-property :|couchdb| (get-db-info)))
-  (ensure (document-property :|version| (get-db-info))))
+  (ensure-same "Welcome" (document-property :|couchdb| (get-couchdb-info)))
+  (ensure (document-property :|version| (get-couchdb-info))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Ensure get-db-info reports non-existant databases")
   db-non-existance-test
-  (ensure (setf *db-name* (create-temp-db-name)))
-  (ensure-same "not_found" (document-property :|error| (get-db-info)))
-  (ensure-same "no_db_file" (document-property :|reason|  (get-db-info))))
+  (let ((*db* (db-from-env :name (create-temp-db-name))))
+    (ensure-same "not_found" (document-property :|error| 
+                                                (get-db-info)))
+    (ensure-same "no_db_file" (document-property :|reason|  (get-db-info)))))
 
 (addtest (clouchdb-db-admin-tests)
-  (:documentation "Create a database and ensure it's there, ensure it's deleted too")
+  (:documentation "Create a database and ensure it gets created")
   db-creation-test
-  (ensure (setf *db-name* (create-temp-db)))
-  (ensure-same (document-property :|db_name| (get-db-info)) *db-name*)
-  (ensure-same 0 (document-property :|doc_count| (get-db-info)))
-  (ensure-same 0 (document-property :|update_seq| (get-db-info)))
-  (ensure (document-property :|ok| (delete-db))))
+  (with-temp-db
+    (ensure-same (document-property :|db_name| (get-db-info))
+                 (db-name *db*))
+    (ensure-same (document-property :|db_name| (get-db-info :db *db*))
+                 (db-name *db*))
+    (ensure-same 0 (document-property :|doc_count| (get-db-info :db *db*)))
+    (ensure-same 0 (document-property :|update_seq| (get-db-info :db *db*)))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Make sure deleting a nonexistant db generates an error")
@@ -319,49 +315,55 @@
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Creating a db that already exists is an error")
   db-create-existant-db
-  (ensure (setf *db-name* (create-temp-db)))
-  (ensure-condition 'db-already-exists (create-db))
-  (ensure (delete-db)))
+  (ensure-condition 'db-already-exists 
+    (with-temp-db 
+      (create-db))))
+
+(addtest (clouchdb-db-admin-tests)
+  (:documentation "Creating a db that already exists is an error")
+  db-create-existant-db-name
+  (ensure-condition 'db-already-exists 
+    (with-temp-db
+      (db-name (create-db :db-name (db-name *db*))))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Ignore the duplicate db create error")
   db-ignore-create-existant-db
-  (ensure (setf *db-name* (create-temp-db)))
-  (ensure (document-property :|ok| (create-db :if-exists :ignore)))
-  (ensure (delete-db)))
+  (ensure (document-property :|ok|
+                             (with-temp-db
+                               (create-db :if-exists :ignore)))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "recreate option for create-db on existing db")
   db-recreate-db
-  (ensure (setf *db-name* (create-temp-db)))
-  (ensure (document-property :|ok| (create-db :if-exists :recreate)))
-  (ensure (delete-db)))
+  (ensure (document-property :|ok|
+                             (with-temp-db
+                               (create-db :if-exists :recreate)))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "recreate option for create-db on non-existant db")
   db-recreate-nonexistant-db
-  (ensure (document-property :|ok| (create-db :if-exists :recreate)))
-  (ensure (delete-db)))
-
-;;
-;; Test suite that runs each test in a newly created database and
-;; deletes that database after each test.
-;;
-
-(deftestsuite clouchdb-freshdb-tests (clouchdb-tests) ()
-  (:setup (set-connection :db-name (create-temp-db)))
-  (:teardown (delete-db)))
+  (with-temp-db
+    (ensure (document-property :|ok| (create-db :if-exists :recreate)))))
 
 ;;
 ;; Document API Tests
 ;;
 
-(deftestsuite clouchdb-doc-api-tests (clouchdb-freshdb-tests) () ())
+(deftestsuite clouchdb-doc-api-tests ()
+  ()
+  (:dynamic-variables
+   (*db* (db-from-env :db *db*)))
+  (:setup
+   (set-connection :db (create-temp-db)))
+  (:teardown 
+   (delete-db)))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Ensures the temporary db for these tests is succesfully created.")
   empty-test
-  (ensure-same (document-property :|db_name| (get-db-info)) *db-name*))
+  (ensure-same (document-property :|db_name| (get-db-info)) 
+               (db-name *db*)))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Create a document with create-document")
@@ -371,12 +373,16 @@
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Create document with create-document, specify document ID")
   create-document-specified-id
-  (ensure (document-property :|ok| (create-document '((:a . "test")) :id "specified"))))
+  (ensure (document-property 
+           :|ok| 
+           (create-document '((:a . "test")) :id "specified"))))
 
 (addtest (clouchdb-doc-api-tests)
-  (:documentation "Create a document with a duplicate ID")
+  (:documentation 
+   "Create a document with a duplicate ID and ensure revision conflict")
   create-document-specified-id-conflict
-  (ensure (document-property :|ok| (create-document '((:a . "test")) :id "specified")))
+  (ensure (document-property :|ok| (create-document '((:a . "test")) 
+                                                    :id "specified")))
   (ensure-condition 'id-or-revision-conflict
     (create-document '((:a "test")) :id "specified")))
 
@@ -414,7 +420,7 @@
   (:documentation "Delete a document by ID")
   delete-document-by-id
   (ensure (document-property :|ok| (create-document '((:a "test")) :id "specified")))
-  (ensure (document-property :|ok| (delete-document :id "specified"))))
+  (ensure (document-property :|ok| (delete-document "specified"))))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Delete a document by ID and revision")
@@ -422,8 +428,10 @@
   (ensure (progn
 	    (create-document '((:a . "document")) :id "specified")
 	    (let ((doc (get-document "specified")))
-	      (document-property :|ok| (delete-document :id (document-property :|_id| doc)
-						      :revision (document-property :|_rev| doc)))))))
+	      (document-property :|ok| 
+                                 (delete-document (document-id doc)
+                                                  :revision 
+                                                  (document-revision doc)))))))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Delete a document by document")
@@ -431,12 +439,12 @@
   (ensure (progn
 	    (create-document '((:a . "document")) :id "polly")
 	    (document-property :|ok| 
-			       (delete-document :document (get-document "polly"))))))
+			       (delete-document (get-document "polly"))))))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Delete a non-existant document")
   delete-document-bad-id
-  (ensure-condition 'document-missing (delete-document :id "specified")))
+  (ensure-condition 'document-missing (delete-document "specified")))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Add a bunch of documents and ensure they get created.")
@@ -491,8 +499,11 @@
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Test document ID encoding")
   encode-document-id
-  (ensure (document-property :|ok| (create-document '((:a "test")) :id "http://google.com")))
-  (ensure-same (document-property :|_id| (get-document "http://google.com")) "http://google.com"))
+  (ensure (document-property :|ok| 
+                             (create-document '((:a "test")) 
+                                              :id "http://google.com")))
+  (ensure-same (document-id (get-document "http://google.com")) 
+               "http://google.com"))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Test encoding and decoding of utf-8 document IDs")
@@ -544,12 +555,119 @@
                                 (equal (cdr e)
                                        (document-property (car e) doc)))
                             doc)))))))
+
+;;
+;; Attachments 
+;;
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Test adding attachment 0")
+  add-attachment-0
+  (ensure (document-property :|ok|
+                             (add-attachment "doc" 
+                                             (pathname "tests.lisp"))))
+  (let ((attachments (attachment-list "doc")))
+    (ensure-same 1 (length attachments))
+    (ensure-same "tests.lisp" (attachment-name (car attachments)))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Test adding attachment using name other than file name")
+  add-attachment-1
+  (ensure (document-property :|ok|
+                             (add-attachment "doc" 
+                                             (pathname "tests.lisp")
+                                             :name "something.lisp")))
+  (let ((attachments (attachment-list "doc")))
+    (ensure-same 1 (length attachments))
+    (ensure-same "something.lisp" (attachment-name (car attachments)))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Test adding multiple attachments")
+  add-attachment-2
+  (ensure (document-property :|ok|
+                             (add-attachment "doc" 
+                                             (pathname "tests.lisp")
+                                             :name "something.lisp")))
+  (ensure (document-property :|ok|
+                             (add-attachment "doc" 
+                                             (pathname "tests.lisp")
+                                             :name "something.else")))
+  (let ((attachments (attachment-list "doc")))
+    (ensure-same 2 (length attachments))
+    (ensure-same "something.lisp" (attachment-name (car attachments)))))
+
+;; 
+;; Replication Tests.
+;;
+
+(deftestsuite clouchdb-replication-tests () 
+  ()
+  (:dynamic-variables
+   (*db* (db-from-env)))
+  (:setup
+   (progn
+     (set-connection :db (create-temp-db))
+     (create-test-documents *people* :id-field :name)))
+  (:teardown 
+   (progn 
+     (delete-db)
+     (set-connection :db-name "default"))))
+
+(addtest (clouchdb-replication-tests)
+  (:documentation "test local replication of current db to new db using string identifier")
+  db-replicate-local-1
+  (let ((db *db*))
+    (with-temp-db
+      (let ((target *db*)
+            (*db* db))
+        (ensure (document-property :|ok| (replicate target)))))))
+
+(addtest (clouchdb-replication-tests)
+  (:documentation "test local replication of current db to new db using string identifiers")
+  db-replicate-local-2
+  (ensure (document-property :|ok| 
+                             (let ((source *db*))
+                               (with-temp-db
+                                 (let ((target *db*))
+                                   (replicate (db-name target) 
+                                              :source (db-name source))))))))
+
+(addtest (clouchdb-replication-tests)
+  (:documentation 
+   "test local and remote replication of current db to new db using db and string identifiers")
+  db-replicate-mixed-1
+  (ensure (document-property :|ok| 
+                             (let ((source *db*))
+                               (with-temp-db
+                                 (let ((target *db*))
+                                   (replicate target
+                                              :source (db-name source))))))))
+
+(addtest (clouchdb-replication-tests)
+  (:documentation 
+   "test remote API replication of current db to new db using database identifiers")
+  db-replicate-dbs
+  (ensure (document-property :|ok| 
+                             (let ((source *db*))
+                               (with-temp-db
+                                 (let ((target *db*))
+                                   (replicate target :source source)))))))
+
 ;;
 ;; View API Tests
 ;;
 
-(deftestsuite clouchdb-view-tests (clouchdb-freshdb-tests) ()
-  (:setup (create-test-documents *people* :id-field :name)))
+(deftestsuite clouchdb-view-tests () 
+  ()
+  (:dynamic-variables
+   (*db* (db-from-env :db *db*)))
+  (:setup
+   (progn
+     (set-connection :db (create-temp-db))
+     (create-test-documents *people* :id-field :name)))
+  (:teardown 
+   (progn 
+     (delete-db))))
 
 (addtest (clouchdb-view-tests)
   (:documentation "Create an ad-hoc view and verify the returned count")
@@ -697,13 +815,14 @@
                                       :start-key '("boston" "c")
                                       :end-key '("boston" "d"))))))
 
-;;
-;;
-;;
+
+
+
 
 (defun run-all-tests ()
   (dolist (suite '(clouchdb-general-tests
                    clouchdb-db-admin-tests
 		   clouchdb-doc-api-tests
-		   clouchdb-view-tests))
+		   clouchdb-view-tests
+                   clouchdb-replication-tests))
     (format t "~S~%" (run-tests :suite suite))))




From peddy at common-lisp.net  Tue Jul  7 01:28:21 2009
From: peddy at common-lisp.net (peddy)
Date: Mon, 06 Jul 2009 21:28:21 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MNzTp-0005P6-Dr@common-lisp.net>

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

Modified Files:
	tests.lisp 
Log Message:
Added more tests, added content-type to view method


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/06 22:24:45	1.18
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/07 01:28:20	1.19
@@ -594,7 +594,19 @@
                                              :name "something.else")))
   (let ((attachments (attachment-list "doc")))
     (ensure-same 2 (length attachments))
-    (ensure-same "something.lisp" (attachment-name (car attachments)))))
+    (ensure (find :|something.lisp| attachments :key #'car))
+    (ensure (find :|something.else| attachments :key #'car))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Test creating attachment with stream")
+  add-attachment-stream
+  (ensure (document-property :|ok|
+                             (add-attachment "doc" 
+                                             (pathname "tests.lisp"))))
+  (ensure (document-property 
+           :|ok| 
+           (with-attachment (stream "doc" "tests.lisp")
+             (add-attachment "doc2" stream :name "tests2.lisp")))))
 
 ;; 
 ;; Replication Tests.




From peddy at common-lisp.net  Tue Jul  7 19:50:20 2009
From: peddy at common-lisp.net (peddy)
Date: Tue, 07 Jul 2009 15:50:20 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MOGgG-0007LO-4E@common-lisp.net>

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

Modified Files:
	clouchdb.lisp package.lisp tests.lisp 
Log Message:
Renamed db-from-env to make-db


--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/06 22:24:45	1.36
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/07 19:50:19	1.37
@@ -32,16 +32,16 @@
 
 (defvar *debug-requests* nil)
 
-(defstruct db
+(defstruct (db (:constructor new-db))
   host port name protocol 
   user password
   document-fetch-fn document-update-fn)
 
 (defun make-default-db ()
-  (make-db :host *default-host*
-           :port *default-port*
-           :name *default-db-name*
-           :protocol *default-protocol*))
+  (new-db :host *default-host*
+          :port *default-port*
+          :name *default-db-name*
+          :protocol *default-protocol*))
 
 (defvar *db* (make-default-db) "A db struct object")
 
@@ -273,7 +273,7 @@
     `(let ((,result (progn , at body)))
        (when (and (listp ,result) 
                   (equal "not_found" (document-property :|error| ,result)))
-	 (let ((*db* (if ,db-name-p (db-from-env :name ,db-name) *db*)))
+	 (let ((*db* (if ,db-name-p (make-db :name ,db-name) *db*)))
 	   (if (document-property :|error| (get-db-info))
 	       (error 'db-does-not-exist
 		      :result ,result :db *db* :uri (make-uri)))))
@@ -436,29 +436,29 @@
           (json-to-document body)
           (values body status reason-phrase)))))
 
-(defun db-from-env (&key host port name protocol user password
+(defun make-db (&key host port name protocol user password
                     document-fetch-fn document-update-fn (db *db*))
   "Create, populate and return a database structure from the current
 special variables and any supplied keyword parameters, the latter take
-precendence over the special vars."
-  (make-db :host (or host (db-host db) *default-host*)
-           :port (or port (db-port db) *default-port*)
-           :name (or name (db-name db) *default-db-name*)
-           :protocol (or protocol (db-protocol db) *default-protocol*)
-           :user (or user (db-user db))
-           :password (or password (db-password db))
-           :document-fetch-fn (or document-fetch-fn (db-document-fetch-fn db))
-           :document-update-fn (or document-update-fn (db-document-update-fn db))))
+precedence over the special variables."
+  (new-db :host (or host (db-host db) *default-host*)
+          :port (or port (db-port db) *default-port*)
+          :name (or name (db-name db) *default-db-name*)
+          :protocol (or protocol (db-protocol db) *default-protocol*)
+          :user (or user (db-user db))
+          :password (or password (db-password db))
+          :document-fetch-fn (or document-fetch-fn (db-document-fetch-fn db))
+          :document-update-fn (or document-update-fn (db-document-update-fn db))))
 
 (defun set-connection (&key host db-name protocol port
                        (db *db*) document-update-fn document-fetch-fn)
   "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."
-  (setf *db* (db-from-env :db db :host host :name db-name 
-                          :protocol protocol :port port
-                          :document-update-fn document-update-fn
-                          :document-fetch-fn document-fetch-fn)))
+  (setf *db* (make-db :db db :host host :name db-name 
+                      :protocol protocol :port port
+                      :document-update-fn document-update-fn
+                      :document-fetch-fn document-fetch-fn)))
 
 (defmacro with-connection ((&key db-name port protocol host
                                  document-update-fn document-fetch-fn)
@@ -467,10 +467,10 @@
 db-name, port or protocol. Port may be a string or a number, protocol
 qis http or https. As of CouchDb version 7.2 the default port is 5984,
 prior to that it was 8888."
-  `(let ((*db* (db-from-env :name ,db-name :port ,port 
-                            :protocol ,protocol :host ,host 
-                            :document-fetch-fn ,document-fetch-fn
-                            :document-update-fn ,document-update-fn)))
+  `(let ((*db* (make-db :name ,db-name :port ,port 
+                        :protocol ,protocol :host ,host 
+                        :document-fetch-fn ,document-fetch-fn
+                        :document-update-fn ,document-update-fn)))
      (progn , at body)))
 
 (defun document-properties (document)
@@ -500,7 +500,7 @@
 can be avoided by specifying :ingore for if-exists. In this case no
 error condition is generated. Specify :recreate to potentially delete
 and create a new database."
-  (let ((*db* (if db-name-p (db-from-env :db db :name db-name) db)))
+  (let ((*db* (if db-name-p (make-db :db db :name db-name) db)))
     (let ((res (db-request (cat (url-encode (db-name *db*)) "/")
                            :method :put :content "")))
       (if (equal "file_exists" (document-property :|error| res))
@@ -549,7 +549,7 @@
   "Get information for named database, return ((:|error|
   . \"not_found\") (:|reason| . \"no_db_file\")) if database does not
   exist."
-  (let ((*db* (db-from-env :db db :name db-name)))
+  (let ((*db* (make-db :db db :name db-name)))
     (db-request (cat (url-encode (db-name *db*)) "/")
                 :method :get)))
 
@@ -562,7 +562,7 @@
 
 (defun create-temp-db (&key (db-name-creator #'create-temp-db-name))
   "Create a temporary database."
-  (let ((db (db-from-env :name (funcall db-name-creator))))
+  (let ((db (make-db :name (funcall db-name-creator))))
     (let ((res (create-db :db db)))
       (if (document-property :|error| res)
 	  (error (format t "Error ~S creating database: ~A"
@@ -580,7 +580,7 @@
          (delete-db))
        ,result)))
 
-(defun replicate (target &key (source (db-from-env)))
+(defun replicate (target &key (source (make-db)))
   "Replicate current database to target, or source to target if source
 is specified. Source and target database values must either be strings
 or database structures. Use strings to specify simple local database
@@ -849,7 +849,7 @@
   (document-property :|_attachments| 
                      (cond ((stringp doc-or-id)
                             (get-document doc-or-id))
-                           ((and doc-or-id (listp doc-or-id))
+                           ((listp doc-or-id)
                             doc-or-id)
                            (t nil))))
 
@@ -920,12 +920,19 @@
 (defun save-attachment (doc-or-id attachment path &key
                         (if-does-not-exist :create)
                         (if-exists :supersede))
-  "Save specified attachement in document to path on file system. The
-doc-or-id parameter must either be a string that identifies the
-document or the actual document that contains the attachment. The
-attachment parameter is either the string value of the attachment
-name, a keyword symbol as returned in the list of attachments or one
-of the elements of a document's attachment list."
+  "Save specified attachement from specified document to path on file
+system. The doc-or-id parameter must either be a document ID string or
+the actual document. The attachment parameter is either the string
+value of the attachment name, e.g. \"file.jpg\", a keyword symbol as
+returned in the car of the list of attachments, .e.g. :|file.jsp|, or
+one of the elements of a document's attachment list,
+e.g: (:|file.jsp| (:|stub| . T) (:|content_type|
+. \"image/jpeg\") (:|length| . 3543434)).
+
+If the path identifies a directory then the target file will be
+created in that directory with the same name as the attachment in the
+document. If the path ends with a file name the attachment will be
+created with that name."
   (let ((in (get-attachment-stream doc-or-id attachment))
         (output-path (if (> 0 (length (file-namestring path)))
                          path
@@ -982,6 +989,7 @@
     (db-request (cat (url-encode (db-name *db*)) "/_design/" (url-encode id))
                 :method :put
                 :external-format-out +utf-8+
+		:content-type "application/json"
                 :content-length nil
                 :content
                 (cat "{\"language\" : \"" language "\"," 
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/06 22:24:45	1.12
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/07 19:50:20	1.13
@@ -84,7 +84,6 @@
    :database
    :db-document-fetch-fn
    :db-document-update-fn
-   :db-from-env
    :db-host
    :db-name
    :db-password
--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/07 01:28:20	1.19
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/07 19:50:20	1.20
@@ -283,7 +283,7 @@
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Ensure get-db-info reports non-existant databases")
   db-non-existance-test
-  (let ((*db* (db-from-env :name (create-temp-db-name))))
+  (let ((*db* (make-db :name (create-temp-db-name))))
     (ensure-same "not_found" (document-property :|error| 
                                                 (get-db-info)))
     (ensure-same "no_db_file" (document-property :|reason|  (get-db-info)))))
@@ -353,7 +353,7 @@
 (deftestsuite clouchdb-doc-api-tests ()
   ()
   (:dynamic-variables
-   (*db* (db-from-env :db *db*)))
+   (*db* (make-db :db *db*)))
   (:setup
    (set-connection :db (create-temp-db)))
   (:teardown 
@@ -615,7 +615,7 @@
 (deftestsuite clouchdb-replication-tests () 
   ()
   (:dynamic-variables
-   (*db* (db-from-env)))
+   (*db* (make-db)))
   (:setup
    (progn
      (set-connection :db (create-temp-db))
@@ -672,7 +672,7 @@
 (deftestsuite clouchdb-view-tests () 
   ()
   (:dynamic-variables
-   (*db* (db-from-env :db *db*)))
+   (*db* (make-db :db *db*)))
   (:setup
    (progn
      (set-connection :db (create-temp-db))




From peddy at common-lisp.net  Sat Jul 11 23:34:06 2009
From: peddy at common-lisp.net (peddy)
Date: Sat, 11 Jul 2009 19:34:06 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MPm50-0007S9-C2@common-lisp.net>

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

Modified Files:
	tests.lisp 
Log Message:
- Renamed *db* to *couchdb* to make it easier to import this value in other apps

- Updated copy-document and other functions to allow documents to be
  specified by id or by document

- Added more test cases


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/07 19:50:20	1.20
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/11 23:34:06	1.21
@@ -283,7 +283,7 @@
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Ensure get-db-info reports non-existant databases")
   db-non-existance-test
-  (let ((*db* (make-db :name (create-temp-db-name))))
+  (let ((*couchdb* (make-db :name (create-temp-db-name))))
     (ensure-same "not_found" (document-property :|error| 
                                                 (get-db-info)))
     (ensure-same "no_db_file" (document-property :|reason|  (get-db-info)))))
@@ -293,16 +293,16 @@
   db-creation-test
   (with-temp-db
     (ensure-same (document-property :|db_name| (get-db-info))
-                 (db-name *db*))
-    (ensure-same (document-property :|db_name| (get-db-info :db *db*))
-                 (db-name *db*))
-    (ensure-same 0 (document-property :|doc_count| (get-db-info :db *db*)))
-    (ensure-same 0 (document-property :|update_seq| (get-db-info :db *db*)))))
+                 (db-name *couchdb*))
+    (ensure-same (document-property :|db_name| (get-db-info :db *couchdb*))
+                 (db-name *couchdb*))
+    (ensure-same 0 (document-property :|doc_count| (get-db-info :db *couchdb*)))
+    (ensure-same 0 (document-property :|update_seq| (get-db-info :db *couchdb*)))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Make sure deleting a nonexistant db generates an error")
   db-delete-non-existant-db
-  (ensure-condition 'db-does-not-exist (delete-db :db-name (create-temp-db-name))))
+  (ensure-condition 'db-does-not-exist (delete-db :db (create-temp-db-name))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Make sure deleting a nonexistant db error is ignoreable")
@@ -310,7 +310,7 @@
   (ensure
    (document-property 
     :|error| 
-    (delete-db :if-missing :ignore :db-name (create-temp-db-name)))))
+    (delete-db :if-missing :ignore :db (create-temp-db-name)))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Creating a db that already exists is an error")
@@ -324,7 +324,7 @@
   db-create-existant-db-name
   (ensure-condition 'db-already-exists 
     (with-temp-db
-      (db-name (create-db :db-name (db-name *db*))))))
+      (db-name (create-db :db (db-name *couchdb*))))))
 
 (addtest (clouchdb-db-admin-tests)
   (:documentation "Ignore the duplicate db create error")
@@ -353,7 +353,7 @@
 (deftestsuite clouchdb-doc-api-tests ()
   ()
   (:dynamic-variables
-   (*db* (make-db :db *db*)))
+   (*couchdb* (make-db :db *couchdb*)))
   (:setup
    (set-connection :db (create-temp-db)))
   (:teardown 
@@ -363,7 +363,7 @@
   (:documentation "Ensures the temporary db for these tests is succesfully created.")
   empty-test
   (ensure-same (document-property :|db_name| (get-db-info)) 
-               (db-name *db*)))
+               (db-name *couchdb*)))
 
 (addtest (clouchdb-doc-api-tests)
   (:documentation "Create a document with create-document")
@@ -417,6 +417,54 @@
 		      (length (document-property :|_revs_info| docinf))))))
 	    
 (addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, creating destination with source ID")
+  copy-document-create-dest-id
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (copy-document "source" "dest")))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, creating destination with source document")
+  copy-document-create-dest-doc
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (copy-document (get-document "source") "dest")))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, overwrite destination by specifying revision")
+  copy-document-overwrite-dest-1
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (create-document '((:dest . "data")) :id "dest")) 
+  (ensure (copy-document "source" "dest" 
+                         :revision (document-revision (get-document "dest")))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, overwrite destination by specifying current revision")
+  copy-document-overwrite-dest-2
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (create-document '((:dest . "data")) :id "dest")) 
+  (ensure (copy-document "source" "dest" :revision :current)))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, overwrite destination by specifying dest document")
+  copy-document-overwrite-dest-3
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (create-document '((:dest . "data")) :id "dest")) 
+  (ensure (copy-document "source" (get-document "dest"))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, overwrite destination by specifying current revision")
+  copy-document-overwrite-revision-conflict
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (create-document '((:dest . "data")) :id "dest")) 
+  (ensure-condition 'id-or-revision-conflict (copy-document "source" "dest")))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Copy document, overwrite destination by specifying current revision")
+  copy-document-source-id-missing
+  (ensure (create-document '((:source . "data")) :id "source"))
+  (ensure (create-document '((:dest . "data")) :id "dest")) 
+  (ensure-condition 'doc-error (copy-document "doesnotexist" "dest")))
+
+(addtest (clouchdb-doc-api-tests)
   (:documentation "Delete a document by ID")
   delete-document-by-id
   (ensure (document-property :|ok| (create-document '((:a "test")) :id "specified")))
@@ -606,7 +654,10 @@
   (ensure (document-property 
            :|ok| 
            (with-attachment (stream "doc" "tests.lisp")
-             (add-attachment "doc2" stream :name "tests2.lisp")))))
+             (add-attachment "doc2" stream :name "tests2.lisp"))))
+  (let ((attachments (attachment-list "doc2")))
+    (ensure-same 1 (length attachments))
+    (ensure (find :|tests2.lisp| attachments :key #'car))))
 
 ;; 
 ;; Replication Tests.
@@ -615,7 +666,7 @@
 (deftestsuite clouchdb-replication-tests () 
   ()
   (:dynamic-variables
-   (*db* (make-db)))
+   (*couchdb* (make-db)))
   (:setup
    (progn
      (set-connection :db (create-temp-db))
@@ -628,19 +679,19 @@
 (addtest (clouchdb-replication-tests)
   (:documentation "test local replication of current db to new db using string identifier")
   db-replicate-local-1
-  (let ((db *db*))
+  (let ((db *couchdb*))
     (with-temp-db
-      (let ((target *db*)
-            (*db* db))
+      (let ((target *couchdb*)
+            (*couchdb* db))
         (ensure (document-property :|ok| (replicate target)))))))
 
 (addtest (clouchdb-replication-tests)
   (:documentation "test local replication of current db to new db using string identifiers")
   db-replicate-local-2
   (ensure (document-property :|ok| 
-                             (let ((source *db*))
+                             (let ((source *couchdb*))
                                (with-temp-db
-                                 (let ((target *db*))
+                                 (let ((target *couchdb*))
                                    (replicate (db-name target) 
                                               :source (db-name source))))))))
 
@@ -649,9 +700,9 @@
    "test local and remote replication of current db to new db using db and string identifiers")
   db-replicate-mixed-1
   (ensure (document-property :|ok| 
-                             (let ((source *db*))
+                             (let ((source *couchdb*))
                                (with-temp-db
-                                 (let ((target *db*))
+                                 (let ((target *couchdb*))
                                    (replicate target
                                               :source (db-name source))))))))
 
@@ -660,9 +711,9 @@
    "test remote API replication of current db to new db using database identifiers")
   db-replicate-dbs
   (ensure (document-property :|ok| 
-                             (let ((source *db*))
+                             (let ((source *couchdb*))
                                (with-temp-db
-                                 (let ((target *db*))
+                                 (let ((target *couchdb*))
                                    (replicate target :source source)))))))
 
 ;;
@@ -672,7 +723,7 @@
 (deftestsuite clouchdb-view-tests () 
   ()
   (:dynamic-variables
-   (*db* (make-db :db *db*)))
+   (*couchdb* (make-db :db *couchdb*)))
   (:setup
    (progn
      (set-connection :db (create-temp-db))
@@ -828,9 +879,6 @@
                                       :end-key '("boston" "d"))))))
 
 
-
-
-
 (defun run-all-tests ()
   (dolist (suite '(clouchdb-general-tests
                    clouchdb-db-admin-tests




From peddy at common-lisp.net  Sat Jul 11 23:35:57 2009
From: peddy at common-lisp.net (peddy)
Date: Sat, 11 Jul 2009 19:35:57 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MPm6n-0007Ux-UQ@common-lisp.net>

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

Modified Files:
	package.lisp examples.lisp clouchdb.lisp 
Log Message:
(this time marking all changed files)

- Renamed *db* to *couchdb* to make it easier to import this value in other apps

- Updated copy-document and other functions to allow documents to be
 specified by id or by document

- Added more test cases


--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/07 19:50:20	1.13
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/11 23:35:57	1.14
@@ -27,79 +27,71 @@
 (defpackage :clouchdb
   (:use :cl :drakma :flexi-streams :s-base64 :parenscript)
   (:export 
+   :*couchdb*
    :ad-hoc-view
+   :add-attachment
+   :all-docs-by-seq
+   :as-deleted-document
+   :as-field-name-string
+   :as-keyword-symbol
+   :attachment-list
+   :attachment-missing
    :attachment-name
    :bulk-document-update
+   :compact-db
+   :copy-document
+   :couchdb-document-properties
    :create-db
    :create-document
    :create-ps-view
    :create-temp-db
    :create-temp-db-name
    :create-view
+   :database
    :db-already-exists
+   :db-document-fetch-fn
+   :db-document-update-fn
    :db-does-not-exist
    :db-existential-error
+   :db-host
+   :db-name
+   :db-password
+   :db-port
+   :db-user
+   :delete-attachment
    :delete-db
    :delete-document
    :delete-view
    :doc-error
    :document-as-hash
+   :document-id
    :document-missing
    :document-properties
    :document-property
+   :document-revision
    :document-to-json
-
-
-
-
-
-
+   :encode-document
    :get-all-documents
+   :get-attachment-name
+   :get-attachment-stream
    :get-couchdb-info
    :get-db-info
    :get-document
    :id-missing
    :id-or-revision-conflict
+   :invalid-input
    :invoke-view
+   :json-to-document
    :list-dbs
+   :make-db
    :post-document
    :ps-view
    :put-document
-   :set-connection
-   :with-connection
-   :with-temp-db
-   :*db*
-   :*db*
-   :*document-fetch-fn*
-   :*document-update-fn*
-   :add-attachment
-   :all-docs-by-seq
-   :as-deleted-document
-   :as-field-name-string
-   :as-keyword-symbol
-   :attachment-list
-   :attachment-missing
-   :compact-db
-   :couchdb-document-properties
-   :database
-   :db-document-fetch-fn
-   :db-document-update-fn
-   :db-host
-   :db-name
-   :db-password
-   :db-port
-   :db-user
-   :delete-attachment
-   :document-id
-   :document-revision
-   :encode-document
-   :get-attachment-name
-   :get-attachment-stream
-   :invalid-input
-   :json-to-document
-   :make-db
    :query-document
    :replicate
    :save-attachment
+   :set-connection
    :set-document-property
-   :with-attachment))
+   :with-attachment
+   :with-connection
+   :with-temp-db))
--- /project/clouchdb/cvsroot/clouchdb/src/examples.lisp	2009/04/19 22:48:32	1.10
+++ /project/clouchdb/cvsroot/clouchdb/src/examples.lisp	2009/07/11 23:35:57	1.11
@@ -29,17 +29,6 @@
 
 (in-package :clouchdb-examples)
 
-;; Set the following to point to your CouchDb server. These values
-;; 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")
-
 ;;
 ;;
 ;;
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/07 19:50:19	1.37
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/11 23:35:57	1.38
@@ -43,7 +43,7 @@
           :name *default-db-name*
           :protocol *default-protocol*))
 
-(defvar *db* (make-default-db) "A db struct object")
+(defvar *couchdb* (make-default-db) "A db struct object")
 
 (defvar *text-types* 
   '(("text" . nil) 
@@ -158,6 +158,17 @@
              (declare (ignore condition))
              (format stream "No ID specified"))))
 
+(define-condition invalid-id (doc-error)
+  ((id-value :initarg :id-value :reader id-value))
+  (:report (lambda (condition stream) 
+             (format stream "Invalid ID: ~a" (id-value condition)))))
+
+(define-condition invalid-document (doc-error)
+  ((value :initarg :value :reader value))
+  (:report (lambda (condition stream)
+             (format stream "Value ~s is not a Document"
+                     (value condition)))))
+
 (define-condition document-missing (doc-error) 
   ()
   (:report (lambda (condition stream)
@@ -261,7 +272,7 @@
 (defun make-uri (&rest rest)
   "Return a URI containing protocol://host:port/ and the concatenation
 of the remaining parameters."
-  (concatenate 'string (couchdb-host-url *db*) "/"
+  (concatenate 'string (couchdb-host-url *couchdb*) "/"
 	       (apply #'concatenate 'string rest)))
 
 (defmacro ensure-db ((&key (db-name nil db-name-p)) &body body)
@@ -273,10 +284,10 @@
     `(let ((,result (progn , at body)))
        (when (and (listp ,result) 
                   (equal "not_found" (document-property :|error| ,result)))
-	 (let ((*db* (if ,db-name-p (make-db :name ,db-name) *db*)))
+	 (let ((*couchdb* (if ,db-name-p (make-db :name ,db-name) *couchdb*)))
 	   (if (document-property :|error| (get-db-info))
 	       (error 'db-does-not-exist
-		      :result ,result :db *db* :uri (make-uri)))))
+		      :result ,result :db *couchdb* :uri (make-uri)))))
        ,result)))
 
 (defun document-as-hash (doc)
@@ -347,8 +358,16 @@
 (defun document-id (doc)
   "Shortcut for getting the ID from the specified document. First
   checks for :|_id| property, then :|id|"
-  (or (document-property :|_id| doc)
-      (document-property :|id| doc)))
+  (cond ((stringp doc)
+         doc)
+        ((or (null doc) (not (listp doc)))
+         (error 'invalid-document :value doc))
+        (t
+         (let ((id (or (document-property :|_id| doc)
+                       (document-property :|id| doc))))
+           (unless id
+             (error 'invalid-document :value doc))
+           id))))
 
 (defun document-revision (doc-or-id)
   "Return the revision number for the document, identified by either
@@ -437,7 +456,7 @@
           (values body status reason-phrase)))))
 
 (defun make-db (&key host port name protocol user password
-                    document-fetch-fn document-update-fn (db *db*))
+                document-fetch-fn document-update-fn (db *couchdb*))
   "Create, populate and return a database structure from the current
 special variables and any supplied keyword parameters, the latter take
 precedence over the special variables."
@@ -451,26 +470,26 @@
           :document-update-fn (or document-update-fn (db-document-update-fn db))))
 
 (defun set-connection (&key host db-name protocol port
-                       (db *db*) document-update-fn document-fetch-fn)
+                       (db *couchdb*) document-update-fn
+                       document-fetch-fn)
   "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."
-  (setf *db* (make-db :db db :host host :name db-name 
+  (setf *couchdb* (make-db :db db :host host :name db-name 
                       :protocol protocol :port port
                       :document-update-fn document-update-fn
                       :document-fetch-fn document-fetch-fn)))
 
-(defmacro with-connection ((&key db-name port protocol host
+(defmacro with-connection ((&key db db-name port protocol host
                                  document-update-fn document-fetch-fn)
-			   &body body)
-  "Execute body in the context of the optionally specified host,
-db-name, port or protocol. Port may be a string or a number, protocol
-qis http or https. As of CouchDb version 7.2 the default port is 5984,
-prior to that it was 8888."
-  `(let ((*db* (make-db :name ,db-name :port ,port 
-                        :protocol ,protocol :host ,host 
-                        :document-fetch-fn ,document-fetch-fn
-                        :document-update-fn ,document-update-fn)))
+                           &body body)
+  "Execute body in the context of the specified database connection
+information.."
+  `(let ((*couchdb* (make-db :db ,db
+                     :name ,db-name :port ,port 
+                     :protocol ,protocol :host ,host 
+                     :document-fetch-fn ,document-fetch-fn
+                     :document-update-fn ,document-update-fn)))
      (progn , at body)))
 
 (defun document-properties (document)
@@ -485,6 +504,13 @@
   (remove-if-not #'(lambda (e) (equal "_" (subseq (symbol-name (car e)) 0 1))) 
                  document))
 
+(defmacro db-or-db-name (db)
+  ""
+  `(cond ((stringp ,db)
+          (make-db :name ,db))
+         ((db-p ,db) ,db)
+         (t nil)))
+
 ;;
 ;; CouchDB Database Management API
 ;;
@@ -494,14 +520,16 @@
 host."
   (db-request "_all_dbs" :method :get))
 
-(defun create-db (&key (db *db*) (db-name nil db-name-p) (if-exists :fail))
-  "Create database. If db and db-name are unspecified, uses *db*. If
-database already exists an error condition is raised. This condition
-can be avoided by specifying :ingore for if-exists. In this case no
-error condition is generated. Specify :recreate to potentially delete
-and create a new database."
-  (let ((*db* (if db-name-p (make-db :db db :name db-name) db)))
-    (let ((res (db-request (cat (url-encode (db-name *db*)) "/")
+(defun create-db (&key (db *couchdb*) (if-exists :fail))
+  "Create database. The db parameter may be either a string which is
+the name of the database to create or an instance of a db
+structure. If db is unspecified, uses *couchdb*. If database already
+exists an error condition is raised. This condition can be avoided by
+specifying :ingore for if-exists. In this case no error condition is
+generated. Specify :recreate to potentially delete and create a new
+database."
+  (let ((*couchdb* (db-or-db-name db)))
+    (let ((res (db-request (cat (url-encode (db-name *couchdb*)) "/")
                            :method :put :content "")))
       (if (equal "file_exists" (document-property :|error| res))
           (ecase if-exists
@@ -514,43 +542,46 @@
              (restart-case
                  (error 'db-already-exists
                         :result res 
-                        :db *db*
-                        :uri (make-uri (db-name *db*)))
+                        :db *couchdb*
+                        :uri (make-uri (db-name *couchdb*)))
                (ignore () :report "Ignore error and continue" nil))))
           res))))
 
-(defun delete-db (&key (db *db*) (db-name nil db-name-p) if-missing)
+(defun delete-db (&key (db *couchdb*) if-missing)
   "Delete database. If db and db-name are unspecified, deletes
-database named in *db*. Normally deletion of non-existent databases
+database named in *couchdb*. Normally deletion of non-existent databases
 generates an error condition, but this can be avoided by
 specifying :ignore in the if-missing parameter."
-  (let* ((name (if db-name-p db-name (db-name db)))
-	 (res (db-request (cat (url-encode name) "/") :method :delete)))
+  (let* ((*couchdb* (db-or-db-name db))
+         (res (db-request (cat (url-encode (db-name *couchdb*)) "/")
+                          :method :delete)))
     (if (and (document-property :|error| res) (not (eq :ignore if-missing)))
 	(restart-case 
 	    (error 'db-does-not-exist
-		   :result res :db db :uri (make-uri))
+		   :result res :db *couchdb* :uri (make-uri))
 	  (ignore () :report "Ignore error and continue" nil)))
     res))
 
-(defun compact-db (&key (db *db*))
+(defun compact-db (&key (db *couchdb*))
   "Start compaction on current database, or specified database if
-supplied."
-  (let ((*db* db))
+supplied. The db parameter, if supplied, is either a local database
+name string or a db struct."
+  (let ((*couchdb* (db-or-db-name db)))
     (ensure-db ()
-      (db-request (cat (db-name *db*) "/_compact") :method :post))))
+      (db-request (cat (db-name *couchdb*) "/_compact") :method :post))))
 
-(defun get-couchdb-info (&key (db *db*))
+(defun get-couchdb-info (&key (db *couchdb*))
   "Get information from the couchdb server."
-  (let ((*db* db))
+  (let ((*couchdb* db))
     (db-request nil :method :get)))
 
-(defun get-db-info (&key (db *db*) db-name)
+(defun get-db-info (&key (db *couchdb*))
   "Get information for named database, return ((:|error|
   . \"not_found\") (:|reason| . \"no_db_file\")) if database does not
-  exist."
-  (let ((*db* (make-db :db db :name db-name)))
-    (db-request (cat (url-encode (db-name *db*)) "/")
+  exist. The db parameter, if supplied, is either a local database
+  name string or a db struct."
+  (let ((*couchdb* (db-or-db-name db)))
+    (db-request (cat (url-encode (db-name *couchdb*)) "/")
                 :method :get)))
 
 (defun create-temp-db-name ()
@@ -573,7 +604,7 @@
   "Execute body in context of newly created, temporary
 database. Delete database before return."
   (let ((result (gensym)))
-    `(let* ((*db* (create-temp-db))
+    `(let* ((*couchdb* (create-temp-db))
             (,result))
        (unwind-protect
             (setf ,result (progn , at body))
@@ -608,7 +639,7 @@
                    limit stale descending skip group group-level
                    reduce include-docs))
   (ensure-db ()
-    (db-request (cat (url-encode (db-name *db*)) "/_all_docs") 
+    (db-request (cat (url-encode (db-name *couchdb*)) "/_all_docs") 
 		:method (if keys :post :get)
                 :content-type "application/json"
 		:parameters (transform-params options *view-options*)
@@ -633,7 +664,9 @@
       (push (cons "revs" "true") parameters))
     (when revision-info
       (push (cons "revs_info" "true") parameters))
-    (let ((res (ensure-db () (db-request (cat (url-encode (db-name *db*)) "/" 
+    (let ((res (ensure-db () (db-request (cat (url-encode 
+                                               (db-name *couchdb*)) 
+                                              "/" 
                                               (url-encode id))
 					 :method :get 
 					 :parameters parameters))))
@@ -644,8 +677,8 @@
                   ((and if-missing-p (not (eq if-missing :error)))
                    if-missing)
                   (t (error 'document-missing :id id))))
-	  (document-update-notify (db-document-fetch-fn *db*) res)))))
-      
+	  (document-update-notify 
+           (db-document-fetch-fn *couchdb*) res)))))
 		      
 (defun encode-file (file)
   ""
@@ -690,18 +723,20 @@
 	   (setf doc (document-properties doc))))
     (when attachments
       (setf doc (cons (encode-attachments attachments) doc)))
-    (let ((res (ensure-db () (db-request (cat (url-encode (db-name *db*)) "/" 
+    (let ((res (ensure-db () (db-request (cat (url-encode (db-name *couchdb*)) "/" 
                                               (url-encode (if id id current-id)))
                                          :content-type "text/javascript"
                                          :external-format-out +utf-8+
                                          :content-length nil
                                          :content (document-to-json 
                                                    (document-update-notify 
-                                                    (db-document-update-fn *db*) doc))
+                                                    (db-document-update-fn *couchdb*) 
+                                                    doc))
                                          :method :put))))
       (when (document-property :|error| res)
         (error (if (equal "conflict" (document-property :|error| res)) 
-                   'id-or-revision-conflict 'doc-error)
+                   'id-or-revision-conflict 
+                   'doc-error)
                :id (if id id current-id)
                :reason (document-property :|reason| res)))
       res)))
@@ -713,14 +748,15 @@
 copying documents. The return value includes the document ID in
 the :ID property."
   (let ((res (ensure-db ()
-               (db-request (cat (url-encode (db-name *db*)) "/")
+               (db-request (cat (url-encode (db-name *couchdb*)) "/")
                            :content-type "text/javascript"
                            :external-format-out +utf-8+
                            :content-length nil
                            :method :post
                            :content (document-to-json 
                                      (document-update-notify 
-                                      (db-document-update-fn *db*) doc))))))
+                                      (db-document-update-fn *couchdb*) 
+                                      doc))))))
     (when (document-property :|error| res)
       (error 'doc-error :id nil :reason (document-property :|reason| res)))
     res))
@@ -732,20 +768,47 @@
       (put-document doc :id id :attachments attachments)
       (post-document doc)))
 
-(defun copy-document (from-id to-id &key revision)
-  "Copy one document to another document. If the destination already
-exists, and the intention is to overwrite the destination, then the
-revision parameter must be specified and must be the revision of the
-destination document."
-  (let ((id (if revision (cat to-id "?rev=" revision) to-id)))
+(defun copy-document (source destination &key revision)
+  "Copy source document to destination. The source parameter may be
+  either a document ID or a document from which the ID will be
+  obtained. The destination parameter may also be a document ID or
+  document. If the destination document does not already exist it will
+  be created. 
+
+  If the destination document does exist and the intention is to
+  overwrite that document, then the destination document revision must
+  be specified. If the destination parameter is a document then the
+  revision information will be taken from that document unless
+  the :revision parameter is specified. The revision parameter must be
+  the current revision of the destination document. Alternatively the
+  revision parameter may be the keyword
+  :current which will cause this function to fetch the current
+  revision number from the database."
+  (let ((rev (cond ((eq :current revision)
+                    (document-revision (get-document destination)))
+                   ((and (not revision) (listp destination))
+                    (document-revision destination))
+                   (t revision)))
+        (dest-id (document-id destination)))
     (ensure-db ()
-      (db-request (cat (url-encode (db-name *db*)) "/" 
-                       (url-encode from-id))
-                  :content-type "text/plain"
-                  :external-format-out +utf-8+
-                  :content-length nil
-                  :method :copy
-                  :additional-headers `(("Destination" . ,id))))))
+      (let ((res (db-request (cat (url-encode (db-name *couchdb*)) "/" 
+                                  (url-encode (document-id source)))
+                             :content-type "text/plain"
+                             :external-format-out +utf-8+
+                             :content-length nil
+                             :method :copy
+                             :additional-headers 
+                             `(("Destination" . 
+                                              ,(if rev
+                                                   (cat dest-id "?rev=" rev) 
+                                                   dest-id))))))
+ (when (document-property :|error| res)
+          (error (if (equal "conflict" (document-property :|error| res))
+                     'id-or-revision-conflict 
+                     'doc-error)
+                 :id dest-id
+                 :reason (document-property :|reason| res)))
+        res))))
                 
 (defun all-docs-by-seq (&rest options &key key keys start-key
                         start-key-docid end-key end-key-docid limit
@@ -757,7 +820,7 @@
                    limit stale descending skip group group-level
                    reduce include-docs))
   (ensure-db ()
-    (db-request (cat (url-encode (db-name *db*)) "/_all_docs_by_seq")
+    (db-request (cat (url-encode (db-name *couchdb*)) "/_all_docs_by_seq")
                 :method (if keys :post :get)
                 :content-type "application/json"
                 :parameters (transform-params options *view-options*)
@@ -776,7 +839,7 @@
 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 *db*)) "/_bulk_docs")
+    (db-request (cat (url-encode (db-name *couchdb*)) "/_bulk_docs")
 		:method :post
                 :content-type "text/javascript"
                 :external-format-out +utf-8+
@@ -801,7 +864,7 @@
   (labels ((del (id rev)
              (let ((res (ensure-db () 
                           (db-request 
-                           (cat (url-encode (db-name *db*)) "/" 
+                           (cat (url-encode (db-name *couchdb*)) "/" 
                                 (url-encode id)
                                 "?rev=" 
                                 (url-encode (value-as-string rev)))
@@ -840,24 +903,30 @@
          (attachment-name (car attachment)))
         (t attachment)))
 
-(defun attachment-list (doc-or-id)
+(defun attachment-list (doc-or-id &key fetch)
   "List attachments associated with document. If the document id is
 specified in the first parameter then this function will fetch the
 corresponding document from the server in order to get the attachment

[117 lines skipped]




From peddy at common-lisp.net  Sun Jul 12 18:46:53 2009
From: peddy at common-lisp.net (peddy)
Date: Sun, 12 Jul 2009 14:46:53 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MQ44b-0005tU-PH@common-lisp.net>

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

Modified Files:
	tests.lisp clouchdb.lisp 
Log Message:
Doc updates and added top-level clouchdb-error signal type as base type for all other errors


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/11 23:34:06	1.21
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/12 18:46:53	1.22
@@ -300,6 +300,15 @@
     (ensure-same 0 (document-property :|update_seq| (get-db-info :db *couchdb*)))))
 
 (addtest (clouchdb-db-admin-tests)
+  (:documentation "Be sure differnt get-db-info function invocations return the same results")
+  get-db-info-test
+  (with-temp-db
+    (ensure (tree-equal (get-db-info) (get-db-info :db *couchdb*) 
+                        :test #'equal))
+    (ensure (tree-equal (get-db-info) (get-db-info :db (db-name *couchdb*))
+                        :test #'equal))))
+
+(addtest (clouchdb-db-admin-tests)
   (:documentation "Make sure deleting a nonexistant db generates an error")
   db-delete-non-existant-db
   (ensure-condition 'db-does-not-exist (delete-db :db (create-temp-db-name))))
@@ -346,6 +355,23 @@
   (with-temp-db
     (ensure (document-property :|ok| (create-db :if-exists :recreate)))))
 
+(addtest (clouchdb-db-admin-tests)
+  (:documentation "initation compaction")
+  db-compact
+  (with-temp-db
+    (ensure (document-property :|ok| (compact-db)))))
+
+(addtest (clouchdb-db-admin-tests)
+  (:documentation "initation compaction specifying db name")
+  db-compact-name
+  (with-temp-db
+    (ensure (document-property :|ok| (compact-db :db (db-name *couchdb*))))))
+
+(addtest (clouchdb-db-admin-tests)
+  (:documentation "initation compaction specifying structure")
+  db-compact-db-struct
+  (with-temp-db
+    (ensure (document-property :|ok| (compact-db :db *couchdb*)))))
 ;;
 ;; Document API Tests
 ;;
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/11 23:35:57	1.38
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/12 18:46:53	1.39
@@ -33,8 +33,7 @@
 (defvar *debug-requests* nil)
 
 (defstruct (db (:constructor new-db))
-  host port name protocol 
-  user password
+  host port name protocol user password
   document-fetch-fn document-update-fn)
 
 (defun make-default-db ()
@@ -118,7 +117,11 @@
 ;; Conditions
 ;;
 
-(define-condition db-existential-error (error)
+(define-condition clouchdb-error (error)
+  ()
+  (:documentation "The base type of all errors signaled by clouchdb"))
+
+(define-condition db-existential-error (clouchdb-error)
   ((text :initarg :uri :reader uri)
    (db :initarg :db :reader db)
    (result :initarg :result :reader result)))
@@ -137,7 +140,7 @@
 		     (db-name (db condition))
 		     (uri condition)))))
 
-(define-condition doc-error (error) 
+(define-condition doc-error (clouchdb-error) 
   ((text :initarg :uri :reader text)
    (reason :initarg :reason :reader reason)
    (id :initarg :id :reader id))
@@ -187,14 +190,14 @@
                      (attachments condition))))
   (:documentation "Error raised when specified attachment is not found"))
 
-(define-condition ps-view-def-error (error)
+(define-condition ps-view-def-error (clouchdb-error)
   ((ps-view-def :initarg :ps-view-def :reader ps-view-def))
   (:report (lambda (condition stream)
              (format stream "Invalid ps-view definition: ~s"
                      (ps-view-def condition))))
   (:documentation "Error raised for invalid ps-view definition"))
 
-(define-condition invalid-input (error)
+(define-condition invalid-type (clouchdb-error)
   ((input :initarg :input :reader input)
    (description :initarg :description :reader description))
   (:report (lambda (condition stream)
@@ -265,7 +268,7 @@
   "Make a database identifier from either a string or db structure."
   (cond ((stringp input) input)
         ((db-p input) (couchdb-database-url input))
-        (t (error 'invalid-input 
+        (t (error 'invalid-type
                   :input input
                   :description "Database must be a string or a database structure"))))
 
@@ -480,13 +483,13 @@
                       :document-update-fn document-update-fn
                       :document-fetch-fn document-fetch-fn)))
 
-(defmacro with-connection ((&key db db-name port protocol host
-                                 document-update-fn document-fetch-fn)
-                           &body body)
+(defmacro with-connection ((&key (db *couchdb*) name port protocol
+                                 host document-update-fn
+                                 document-fetch-fn) &body body)
   "Execute body in the context of the specified database connection
 information.."
   `(let ((*couchdb* (make-db :db ,db
-                     :name ,db-name :port ,port 
+                     :name ,name :port ,port 
                      :protocol ,protocol :host ,host 
                      :document-fetch-fn ,document-fetch-fn
                      :document-update-fn ,document-update-fn)))
@@ -515,10 +518,11 @@
 ;; CouchDB Database Management API
 ;;
 
-(defun list-dbs ()
+(defun list-dbs (&optional (db *couchdb*))
   "Return a list of all databases managed by the current CouchDb
 host."
-  (db-request "_all_dbs" :method :get))
+  (let ((*couchdb* db))
+    (db-request "_all_dbs" :method :get)))
 
 (defun create-db (&key (db *couchdb*) (if-exists :fail))
   "Create database. The db parameter may be either a string which is
@@ -611,7 +615,7 @@
          (delete-db))
        ,result)))
 
-(defun replicate (target &key (source (make-db)))
+(defun replicate (target &key (source *couchdb*))
   "Replicate current database to target, or source to target if source
 is specified. Source and target database values must either be strings
 or database structures. Use strings to specify simple local database
@@ -834,10 +838,13 @@
                          :|_deleted| t))
 
 (defun bulk-document-update (docs &key all-or-nothing)
-  "Update multiple documents in a single request. The docs parameter
-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 "
+  "Update multiple documents in a single request. The <b>docs</b>
+  parameter is a list of documents. Any document in the list that does
+  not contain an :|_id| value is created with a CouchDb assigned
+  ID. Documents that contain a '(:|_deleted| . t) top-level property
+  will be deleted. Documents that contain an :|_id| property will be
+  updated. If all-or-nothing is true then all operations must succeed
+  for any to succeed, default is false."
   (ensure-db () 
     (db-request (cat (url-encode (db-name *couchdb*)) "/_bulk_docs")
 		:method :post




From peddy at common-lisp.net  Sun Jul 12 18:59:04 2009
From: peddy at common-lisp.net (peddy)
Date: Sun, 12 Jul 2009 14:59:04 -0400
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1MQ4GO-0006A4-Ly@common-lisp.net>

Update of /project/clouchdb/cvsroot/clouchdb/public_html
In directory cl-net:/tmp/cvs-serv23658/public_html

Modified Files:
	index.html 
Log Message:

Substantial documentation update, added attachment API and conditions



--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2008/10/11 18:55:48	1.5
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/12 18:59:04	1.6
@@ -15,89 +15,43 @@
    CouchDb databases.
  </div>
 
+<h2>Overview</h2> 
+
+<p>
+Clouchdb is a Common Lisp library for interacting
+with <a href="http://couchdb.org">CouchDb</a>
+databases. <a href="http://couchdb.org">CouchDb</a> is a document
+based database server. Clouchdb comes with
+a <a href="http://www.opensource.org/licenses/bsd-license.php">BSD
+Style License</a> for maximum agreeableness.
+</p>
+
 <p>
   Author: Peter Eddy (peter.eddy at gmail.com)
 </p>
 
 <h2>Contents</h2>
 <ul>
-  <li><h3><a href="#overview">Overview</a></h3></li>
   <li><h3><a href="#news">News</a></h3></li>
   <li><h3><a href="#download">Download and Installation</a></h3></li>
-  <li><h3><a href="#examples">Examples</a></h3></li>
   <li><h3><a href="#support">Support and mailing lists</a></h3></li>
+  <li><h3><a href="#examples">Examples</a></h3></li>
   <li><h3><a href="#reference">API Reference</a></h3>
     <ul>
       <li><h4><a href="#db-api-reference">Connection and Database API</a></h4></li>
       <li><h4><a href="#doc-api-reference">Document API</a></h4></li>
+      <li><h4><a href="#attachment-api-reference">Atachment API</a></h4></li>
       <li><h4><a href="#views-api-reference">Views API</a></h4></li>
+      <li><h4><a href="#conditions-reference">Conditions Defined by Clouchdb</a></h4></li>
     </ul>
   </li>
   <li><h3><a href="#symbols">Symbol Index</a></h3></li>
   <li><h3><a href="#issues-and-bugs">Issues and Bugs</a></h3></li>
 </ul>
 
-<h2><a name="overview">Overview</a></h2>
-
-<p>
-  Clouchdb is a Common Lisp library for interacting
-  with <a href="http://couchdb.org">CouchDb</a>
-  databases. <a href="http://couchdb.org">CouchDb</a> is a document
-  based, schema-less database server.
-</p>
-
-<h3>Design Goals</h3>
-
-<p> The library was written with the goals that it be: </p>
-
-<ul>
-  <li><strong>Lightweight</strong> This library is designed to be an
-    as lightweight as possible wrapper of the CouchDb REST API while
-    still providing a resonable level of comfort for to the Lisp
-    developer. In support of the latter goal, the library
-    automatically translates between CouchDb's native Json
-    (JavaScript) data representation language and simple Lisp data
-    structures.
-  </li>
-
-  <li><strong>Interoperable</strong> CouchDb is a schema-less,
-    document-oriented database in which no two documents need share a
-    common structure. Clouchdb does not currently provide structure or
-    object database mapping functionality in order not to negate the
-    unique nature of the CouchDb database and also in order not to
-    impose any library-specific requirements on database documents. In
-    other words, documents created with the Clouchdb library should be
-    fully interoperable with database documents created via other
-    means.
-  </li>
-
-  <li><strong>Simple</strong> Clouchdb is intended to be used easily
-    from the Lisp REPL in order to facilitate experimentation and
-    prototyping. Towards this end the API is designed to be as
-    expressive and economical as possible. Simple document inspection
-    and modification functions have been provided in substitution for
-    an object database mapping scheme. These simple tools might serve
-    as the basis for more elaborate custom mapping schemes.
-  </li>
-
-</ul>
-
-<h3>License</h3>
-<p>
-  Clouchdb, comes with
-  a <a href="http://www.opensource.org/licenses/bsd-license.php">BSD
-  Style License</a> for maximum agreeableness.
-</p>
-
 <h2><a name="news">News</a></h2>
 
 <ul>
-  <li><b>Jun 28, 2008</b> Released version 0.0.10 to support CouchDb
-    version 0.8+ and updated this documentation to reflect those
-    changes. This new release is compatible only with CouchDb
-    0.8.0-incubating (and hopefully later releases). For CouchDb
-    releases prior to 0.8 please use clouchdb release 0.0.9.
-  </li>
   <li><b>Jun 15, 2008</b> Added function create-ps-view and macro
     ps-view to support the new CouchDb 8.0 style views (which use
     map/reduce and emit). This code is checked into source control but
@@ -116,67 +70,6 @@
     values. See <a href="#views-api-reference">Views API</a>
     documentaion and <a href="#example-3">Example 3</a> for details.
   </li>
-  <li><b>Feb 16, 2008</b> Released version 0.0.8 with the following
-    significant changes. Please read if you're updating from prior
-    versions.
-    <ul>
-      <li>Changed document field name encoding to get rid of
-        cl-json/parenscript style * and - case encoding. Now using the
-        less irritating CL symbol quoting, i.e.: <b>:|MixedCase|</b>
-        instead of <b>:-mixed-case</b> (or whatever it was, I could
-        never get it right on the first try). <strong>Note:</strong>
-        This will break existing code wherever there is this case
-        sensitivity, especially in standard CouchDb property names
-        like :ID, :_ID, :REV, and :_REV, which are now :|id|, :|_id|,
-        :|rev| and :|_rev|. Sorry about this. On the bright side you
-        should never have to deal with field names like
-        :*A-L-L-U-P-P-E-R-C-A-S-E again.
-      </li>
-      <li> Changed (set-document-property) so that it no longer
-        modifies its document, but instead returns a copy with
-        specified changes. Also now allows multiple properties to be
-        set in one invocation. Be sure any existing code uses the
-        return value from this function.
-      </li>
-      <li>Added <a href="#sym-query-document">query-document</a>
-        function to make it easier to extract data from complex
-        documents.
-      </li>
-      <li>
-        Removed dependence on cl-json.
-      </li>
-    </ul>
-  </li>
-  <li><b>Dec 20, 2007</b> Released version 0.0.7 with fixes for what
-    had been cl-json's inability to distinguish certain database field
-    value types in the document associative list.
-  </li>
-  <li><b>Dec 19, 2007</b> Released version 0.0.6 with full support for
-    utf-8 character encoding. This change includes support for
-    non-Latin characters in document IDs and in document
-    content. Additionally the encoding of spaces in document IDs has
-    been changed from "+" to "%20", this fixes a problem where the "+"
-    characters were not removed from document IDs when they were
-    decoded.
-  </li>
-  <li><b>Dec 17, 2007</b> Released version 0.0.5 with fixes for
-    encoding of URL parameters. This fix allows use of legal CouchDb
-    characters for database names and document IDs which must be
-    escaped in urls.
-  </li>
-  <li><b>Dec 9, 2007</b> - Version 0.0.4: Updated
-    (<a href="#sym-invoke-view">invoke-view</a>) and
-    (<a href="#sym-ad-hoc-view">ad-hoc-view</a>) to use all options
-    supported by corresponding CouchDb API. Somehow I'd missed these
-    before.
-  </li>
-  <li><b>Nov 28, 2007</b> -
-    CouchDb 7.2 now uses IANA assigned port 5984 instead of 8888.
-    As of release 0.0.4, clouchdb's default has been changed to
-    reflect this fact. If you're using pre-7.2 CouchDb versions with
-    clouchdb 0.0.4, be sure to set your port to 8888. There should
-    be no other compatibility issues.
-  </li>
 </ul>
 
 <h2><a name="download">Download and Installation</a></h2>
@@ -191,16 +84,9 @@
 <ul>
   <li><a href="http://www.weitz.de/drakma/">Drakma</a></li>
   <li><a href="http://www.cliki.net/Parenscript/">Parenscript</a></li>
+  <li><a href="http://www.cliki.net/LIFT/">LIFT</a> testing framework</li>
   <li>An available <a href="http://couchdb.org">CouchDb</a> server,
-  minimum version is 0.7 (in clouchdb pre-0.0.10 releases), the
-  current release is compatible with CouchDb 0.8+.
-  </li>
-</ul>
-
-<h3>Optional</h3>
-<ul>
-  <li><a href="http://www.cliki.net/LIFT/">LIFT</a> testing
-  framework. Required only to run the unit tests.</li>
+  minimum supported version is 0.7, now tested on 7.3a</li>
 </ul>
 
 <h3>ASDF Install</h3>
@@ -212,30 +98,35 @@
 
 <pre class="code">
 (asdf-install:install 'clouchdb)  
-(asdf:oos 'asdf:load-op '#:clouchdb)
+(asdf:operate 'asdf:load-op '#:clouchdb)
 </pre>
 
-<p> ASDF-INSTALL will install library dependencies, though you must
-  install
-  a <a href="http://couchdb.org/CouchDB/CouchDBWeb.nsf/direct/Downloads">CouchDb
-  server</a> separately.
+<p>
+ ASDF-INSTALL will install library dependencies, though you must of
+ course install the <a
+ href="http://couchdb.org/CouchDB/CouchDBWeb.nsf/direct/Downloads">CouchDb
+ server</a> separately.
 </p>
 
 <h3>Unit tests</h3>
 
 <p>
   The clouchdb distribution comes with a unit test suite which uses
-  the LIFT testing framework. To run the tests, follow the following steps:
+  the LIFT testing framework. To run the tests, follow the following
+  steps:
 </p>
 
 <pre class="code">
 (asdf:oos 'asdf:load-op '#:clouchdb-tests)
 (in-package :clouchdb-tests)
-;; If CouchDb is running on a different host
-(set-connection :host "db-host")
 (run-all-tests)
 </pre>
 
+<p> 
+  Note that if the CouchDb server is not running on the same host you
+  will have to modify tests.lisp to point it to the appropriate host.
+</p>
+
 <h3>Examples</h3>
 
 <p>
@@ -264,34 +155,37 @@
 <h2><a name="support">Support and mailing lists</a></h2>
 
 <p>
-  The following email lists have been provided
-  by the <a href="http://common-lisp.net">common-lisp.net</a> for
-  clouchdb development and information:
+  The following email lists have been provided by the <a
+  href="http://common-lisp.net">common-lisp.net</a> for clouchdb
+  development and information:
 </p>
 <ul>
-  <li> <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/clouchdb-announce">
-         clouchdb-announce
-       </a>
-  </li>
-  <li> <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/clouchdb-devel">
-         clouchdb-devel
-       </a>
+  <li> 
+    <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/clouchdb-announce">
+      clouchdb-announce
+    </a>
+  </li>
+  <li>
+    <a href="http://common-lisp.net/cgi-bin/mailman/listinfo/clouchdb-devel">
+      clouchdb-devel
+    </a>
   </li>
 </ul>
 
 <h2><a name="examples">Examples</a></h2>
 
-<p> The following
-  clouchdb <a href="http://common-lisp.net/project/slime/">SLIME</a>
-  sessions demonstrate various aspects of the three major functional
-  areas of the CouchDb API: Database API, Document API and View API.
+<p> 
+  The following clouchdb REPL sessions demonstrate various aspects of
+  the three major functional areas of the CouchDb API: Database API,
+  Document API and View API.
 </p>
-<p>
+
+<p> 
   NB: If you try these examples I suggest also viewing the results via
-  CouchDb's bulit-in HTML UI
-  at <a href="http://localhost:5984/_utils/browse/index.html">http://localhost:5894/_utils/browse/index.html</a>,
-  adjust the URL host and port for the actual CouchDb server and port
-  in use.
+  CouchDb's bulit-in HTML UI at <a
+  href="http://localhost:5984/_utils/">http://localhost:5894/_utils/</a>.
+  Of course adjust the URL for the actual CouchDb server and port in
+  use.
 </p>
 
 <h4>Example 1</h4>
@@ -306,41 +200,62 @@
 
 <pre class="code">
 ;; Create a package to try out clouchdb
-CL-USER> <b>(defpackage :clouchdb-user (:use :cl :clouchdb))</b>
-#&lt;Package "CLOUCHDB-USER"&gt;
+CL-USER> <b>(defpackage :clouchdb-user (:use :cl :clouchdb :parenscript))</b>
+#&lt;PACKAGE "CLOUCHDB-USER"&gt;
 
 CL-USER> <b>(in-package :clouchdb-user)</b>
 #&lt;Package "CLOUCHDB-USER"&gt;
 
-;; If CouchDb is running on a different host set that host
-;; name (default is "localhost"), also set the database name
-;; to be used in this session (default database name is "default")
-CLOUCHDB-USER> <b>(set-connection :host "odeon" :db-name "test-db")</b> 
-; No value
-
-;; Get CouchDb Server Information by specifying a nil DB name
-CLOUCHDB-USER> <b>(get-db-info :db-name nil)</b>
-((:|couchdb| . "Welcome") (:|version| . "0.8.0-incubating"))
+;; View the current (default) CouchDb connection configuration
+CLOUCHDB-USER> <b>*couchdb*</b>
+#S(CLOUCHDB::DB
+   :HOST "localhost"
+   :PORT "5984"
+   :NAME "default"
+   :PROTOCOL "http"
+   :USER NIL
+   :PASSWORD NIL
+   :DOCUMENT-FETCH-FN NIL
+   :DOCUMENT-UPDATE-FN NIL)
+
+;; The current database name is "default". Set appropriate values, for
+;; example, if the CouchDb server is running on host "odeon" set that 
+;; value like so:
+CLOUCHDB-USER> <b>(set-connection :host "odeon")</b>
+#S(CLOUCHDB::DB
+   :HOST "odeon"
+   :PORT "5984"
+   :NAME "default"
+   :PROTOCOL "http"
+   :USER NIL
+   :PASSWORD NIL
+   :DOCUMENT-FETCH-FN NIL
+   :DOCUMENT-UPDATE-FN NIL)
+
+;; Get CouchDb Server Information. This is the first communication
+;; with the CouchDb server.
+CLOUCHDB-USER> <b>(get-couchdb-info)</b>
+((:|couchdb| . "Welcome") (:|version| . "0.10.0a788899"))
 
-;; Create database "test-db", which we named above
+;; Create database named "default", (as configured in *couchdb*)
 CLOUCHDB-USER> <b>(create-db)</b>
 ((:|ok| . T))
 
 ;; Create a document with one field, and give it an ID of "gjc"
 CLOUCHDB-USER> <b>(create-document '((:name . "Gaius Julius Caesar")) :id "gjc")</b>
-((:|ok| . T) (:|id| . "gjc") (:|rev| . "1479031852"))
+((:|ok| . T) (:|id| . "gjc") (:|rev| . "1-1009420200"))
 
 ;; Fetch the document we just created 
 CLOUCHDB-USER> <b>(get-document "gjc")</b>
-((:|_id| . "gjc") (:|_rev| . "1479031852") (:NAME . "Gaius Julius Caesar"))
+((:|_id| . "gjc") (:|_rev| . "1-1009420200") (:NAME . "Gaius Julius Caesar"))
 
-;; Add a field to "gjc"
+;; Add a field to this new document
 CLOUCHDB-USER> <b>(put-document (cons '(:lover . "Servilia Caepionis") *))</b>
-((:|ok| . T) (:|id| . "gjc") (:|rev| . "1460552879"))
+((:|ok| . T) (:|id| . "gjc") (:|rev| . "2-3501332342"))
 
-;; Get the updated document
+;; Get the updated document to verify that the new field stuck
 CLOUCHDB-USER> <b>(get-document "gjc")</b>
-((:|_id| . "gjc") (:|_rev| . "1460552879") (:LOVER . "Servilia Caepionis") 
+((:|_id| . "gjc") (:|_rev| . "2-3501332342") (:LOVER . "Servilia Caepionis")
  (:NAME . "Gaius Julius Caesar"))
 </pre>
 
@@ -349,11 +264,8 @@
 <ul>
   <li> Recreating a database</li>
   <li> Creating a document that uses a CouchDb generated ID</li>
-  <li> Updating a document value using set-document-property</li>
-  <li> Viewing document revision information</li>
-  <li> Fetching an old document revision</li>
+  <li> Updating a the value of a document field</li>
   <li> Creating a document with array and map field values</li>
-  <li> Getting a list of all documents, and filtering that list</li>
 </ul>
 
 <pre class="code">
@@ -363,37 +275,29 @@
 
 ;; Create a document that will have it's ID assigned by the CouchDb server
 CLOUCHDB-USER> <b>(create-document '((:size . "medium") (:color . "blue")))</b>
-((:|ok| . T) (:|id| . "C731D3A3698DA144FB35EDA9737917F2") (:|rev| . "3363852140"))
+((:|ok| . T) (:|id| . "37173e3a844a342414272daa733e1302")
+ (:|rev| . "1-3111744915"))
 
 ;; CouchDb generated IDs are too large to use easily in an
 ;; interactive example like this, so create another document
 ;; with a shorter ID to demonstrate property value updates
 CLOUCHDB-USER> <b>(create-document '((:size . "large") (:color . "blue")) 

[1964 lines skipped]




From peddy at common-lisp.net  Wed Jul 15 01:32:28 2009
From: peddy at common-lisp.net (peddy)
Date: Tue, 14 Jul 2009 21:32:28 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MQtMC-0005kE-JZ@common-lisp.net>

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

Modified Files:
	tests.lisp clouchdb.lisp changelog.txt 
Log Message:
Added conflicts keyword parameter to get-document, tests


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/12 18:46:53	1.22
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/15 01:32:28	1.23
@@ -685,6 +685,12 @@
     (ensure-same 1 (length attachments))
     (ensure (find :|tests2.lisp| attachments :key #'car))))
 
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Make shure conflicts don't appear when they shouldn't")
+  test-no-conflicts
+  (ensure (create-document '((:name . "hi")) :id "hi"))
+  (ensure-null (document-property :|_conflicts| (get-document "hi"))))
+
 ;; 
 ;; Replication Tests.
 ;;
@@ -742,6 +748,22 @@
                                  (let ((target *couchdb*))
                                    (replicate target :source source)))))))
 
+(addtest (clouchdb-replication-tests)
+  (:documentation "test abilty to get document merge conflicts")
+  db-replicate-doc-conflict
+  (let ((db1 *couchdb*))
+    (with-temp-db
+      (create-document '((name . "foo")) :id "x")
+      (replicate db1)
+      (put-document (set-document-property 
+                     (get-document "x") :name "bar"))
+      (let ((*couchdb* db1))
+        (put-document (set-document-property 
+                       (get-document "x") :name "baz")))
+      (replicate db1)
+      (replicate *couchdb* :source db1)
+      (ensure (document-property :|_conflicts| (get-document "x" :conflicts t))))))
+
 ;;
 ;; View API Tests
 ;;
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/12 18:46:53	1.39
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/15 01:32:28	1.40
@@ -483,16 +483,16 @@
                       :document-update-fn document-update-fn
                       :document-fetch-fn document-fetch-fn)))
 
-(defmacro with-connection ((&key (db *couchdb*) name port protocol
+(defmacro with-connection ((&key db name port protocol
                                  host document-update-fn
                                  document-fetch-fn) &body body)
   "Execute body in the context of the specified database connection
 information.."
-  `(let ((*couchdb* (make-db :db ,db
-                     :name ,name :port ,port 
-                     :protocol ,protocol :host ,host 
-                     :document-fetch-fn ,document-fetch-fn
-                     :document-update-fn ,document-update-fn)))
+  `(let ((*couchdb* (make-db :db ,(or db *couchdb*)
+                             :name ,name :port ,port 
+                             :protocol ,protocol :host ,host 
+                             :document-fetch-fn ,document-fetch-fn
+                             :document-update-fn ,document-update-fn)))
      (progn , at body)))
 
 (defun document-properties (document)
@@ -649,7 +649,7 @@
 		:parameters (transform-params options *view-options*)
                 :content (if keys (document-to-json `((:|keys| . ,keys)))))))
 
-(defun get-document (id &key revision revisions
+(defun get-document (id &key revision revisions conflicts
                      revision-info (if-missing nil if-missing-p))
   "Get a document by ID. Returns nil if the document does not exist.
 The revision property specifies an optional revision number, if
@@ -662,6 +662,7 @@
   (unless id
     (error 'id-missing))
   (let ((parameters))
+    (when conflicts (push (cons "conflicts" "true") parameters))
     (when revision
       (push (cons "rev" (value-as-string revision)) parameters))
     (when revisions
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/06 22:24:45	1.10
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/15 01:32:28	1.11
@@ -1,4 +1,7 @@
 
+0.0.12: 
+  - Added missing conflicts keyword parameter to get-document, tests
+
 0.0.11:
 
   - Switched to using a structure to hold the database connection




From peddy at common-lisp.net  Wed Jul 15 01:37:28 2009
From: peddy at common-lisp.net (peddy)
Date: Tue, 14 Jul 2009 21:37:28 -0400
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1MQtR1-0005o5-Vb@common-lisp.net>

Update of /project/clouchdb/cvsroot/clouchdb/public_html
In directory cl-net:/tmp/cvs-serv22321

Modified Files:
	index.html 
Log Message:
Update doc with get-document conflicts parameter


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/12 18:59:04	1.6
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/15 01:37:25	1.7
@@ -52,23 +52,22 @@
 <h2><a name="news">News</a></h2>
 
 <ul>
-  <li><b>Jun 15, 2008</b> Added function create-ps-view and macro
-    ps-view to support the new CouchDb 8.0 style views (which use
-    map/reduce and emit). This code is checked into source control but
-    not yet in a release. See examples.lisp and test.lisp for usage
-    examples.
-  </li>
-  <li><b>Jun 7, 2008</b> Note: CouchDb's views API has changed in
-   source control, breaking this library. If you want to use CouchDb
-   and this library, you'll have better luck sticking to the 7.2
-   pre-release version of CouchDb.
-  </li>
-  <li><b>Mar 1, 2008</b> Released version 0.0.9 with proper support
-    for complex keys in views. The functions ad-hoc-view and
-    invoke-view's :key, :start-end and :end-key parameters now accept
-    s-exprs in addtion to string
-    values. See <a href="#views-api-reference">Views API</a>
-    documentaion and <a href="#example-3">Example 3</a> for details.
+  <li>
+    <b>July 12, 2009</b> Significant updates with breaking
+    changes. Major changes include:
+    <ul>
+      <li>
+        Support for Attachments. This is the first release with
+        attachment support.
+      </li>
+      <li>
+        Moved all database connection information into database
+        structure.
+      </li>
+      <li>
+        Major documentation updates and a few API simplications.
+      </li>
+    </ul>
   </li>
 </ul>
 
@@ -86,7 +85,7 @@
   <li><a href="http://www.cliki.net/Parenscript/">Parenscript</a></li>
   <li><a href="http://www.cliki.net/LIFT/">LIFT</a> testing framework</li>
   <li>An available <a href="http://couchdb.org">CouchDb</a> server,
-  minimum supported version is 0.7, now tested on 7.3a</li>
+  minimum supported version is 0.9.1</li>
 </ul>
 
 <h3>ASDF Install</h3>
@@ -1267,7 +1266,7 @@
 
 <p>[Function]<br />
 <a name="sym-get-document"><b>get-document</b></a> id &amp;key revision
-revisions revision-info if-missing</p>
+revisions revision-info if-missing conflicts</p>
 <blockquote>
 <p>
   Get document by <b>id</b>. If <b>revision</b> is specified attempts
@@ -1275,7 +1274,8 @@
   non-nil, returns brief revision information for identified
   document. If <b>revision-info</b> is non-nil, returns more detailed
   revision information for document. The revision, revisions, and
-  revision-info parameters are mutually exclusive.
+  revision-info parameters are mutually exclusive. If <b>conflicts</b>
+  is true, return document replication conflicts if they exist.
 </p>
 <p>
   If the specified document is not found in the database this function




From peddy at common-lisp.net  Wed Jul 15 02:23:00 2009
From: peddy at common-lisp.net (peddy)
Date: Tue, 14 Jul 2009 22:23:00 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MQu96-0000WW-22@common-lisp.net>

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

Modified Files:
	tests.lisp package.lisp clouchdb.lisp changelog.txt 
Log Message:
Added handling of illegal database names in create-db, doc and tests


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/15 01:32:28	1.23
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/15 02:22:59	1.24
@@ -356,7 +356,13 @@
     (ensure (document-property :|ok| (create-db :if-exists :recreate)))))
 
 (addtest (clouchdb-db-admin-tests)
-  (:documentation "initation compaction")
+  (:documentation "Test handling of illegal db name")
+  db-create-illegal-db-name
+  (ensure-condition 'illegal-database-name
+    (db-name (create-db :db (make-db :name "FOO")))))
+
+(addtest (clouchdb-db-admin-tests)
+  (:documentation "initate compaction")
   db-compact
   (with-temp-db
     (ensure (document-property :|ok| (compact-db)))))
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/11 23:35:57	1.14
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/15 02:22:59	1.15
@@ -79,6 +79,7 @@
    :get-document
    :id-missing
    :id-or-revision-conflict
+   :illegal-database-name
    :invalid-input
    :invoke-view
    :json-to-document
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/15 01:32:28	1.40
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/15 02:22:59	1.41
@@ -140,6 +140,13 @@
 		     (db-name (db condition))
 		     (uri condition)))))
 
+(define-condition illegal-database-name (db-existential-error) 
+  ()
+  (:report (lambda (condition stream)
+	     (format stream "Illegal database name \"~A\" at \"~A\"" 
+		     (db-name (db condition))
+		     (uri condition)))))
+
 (define-condition doc-error (clouchdb-error) 
   ((text :initarg :uri :reader text)
    (reason :initarg :reason :reader reason)
@@ -455,7 +462,7 @@
         ~s~%status: ~s~%headers: ~s~%stream:~s~%body:~s~%" uri args
         must-close reason-phrase status headers stream body))
       (if (stringp body) 
-          (json-to-document body)
+          (values (json-to-document body) status)
           (values body status reason-phrase)))))
 
 (defun make-db (&key host port name protocol user password
@@ -533,23 +540,27 @@
 generated. Specify :recreate to potentially delete and create a new
 database."
   (let ((*couchdb* (db-or-db-name db)))
-    (let ((res (db-request (cat (url-encode (db-name *couchdb*)) "/")
-                           :method :put :content "")))
-      (if (equal "file_exists" (document-property :|error| res))
-          (ecase if-exists
-            ((:ignore) 
-             (list (cons :|ok| t) (cons :|ignored| t)))
-            ((:recreate) 
-             (delete-db)
-             (create-db))
-            ((:fail)
-             (restart-case
-                 (error 'db-already-exists
-                        :result res 
-                        :db *couchdb*
-                        :uri (make-uri (db-name *couchdb*)))
-               (ignore () :report "Ignore error and continue" nil))))
-          res))))
+    (multiple-value-bind (res status)
+        (db-request (cat (url-encode (db-name *couchdb*)) "/")
+                    :method :put :content "")
+      (cond ((eq 201 status)
+             res)
+            ((equal "file_exists" (document-property :|error| res))
+             (ecase if-exists
+               ((:ignore) (list (cons :|ok| t) (cons :|ignored| t)))
+               ((:recreate) (delete-db) (create-db))
+               ((:fail)
+                (restart-case
+                    (error 'db-already-exists
+                           :result res 
+                           :db *couchdb*
+                           :uri (make-uri (db-name *couchdb*)))
+                  (ignore () :report "Ignore error and continue" nil)))))
+            ((equal "illegal_database_name" (document-property :|reason| res))
+             (error 'illegal-database-name
+                    :result res
+                    :db *couchdb*
+                    :uri (make-uri (db-name *couchdb*))))))))
 
 (defun delete-db (&key (db *couchdb*) if-missing)
   "Delete database. If db and db-name are unspecified, deletes
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/15 01:32:28	1.11
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/15 02:22:59	1.12
@@ -1,6 +1,7 @@
 
 0.0.12: 
   - Added missing conflicts keyword parameter to get-document, tests
+  - Added error handling in create-db for illegal database names
 
 0.0.11:
 




From peddy at common-lisp.net  Wed Jul 15 02:23:00 2009
From: peddy at common-lisp.net (peddy)
Date: Tue, 14 Jul 2009 22:23:00 -0400
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1MQu96-0000Wt-6H@common-lisp.net>

Update of /project/clouchdb/cvsroot/clouchdb/public_html
In directory cl-net:/tmp/cvs-serv2013/public_html

Modified Files:
	index.html 
Log Message:
Added handling of illegal database names in create-db, doc and tests


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/15 01:37:25	1.7
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/15 02:23:00	1.8
@@ -2091,12 +2091,21 @@
   process. This is a sub type of <a
   href="#sym-doc-error">doc-error</a>
 </blockquote>
+
+<a name="sym-illegal-database-name"><b>illegal-database-name</b></a> <br />
+<blockquote>
+  Signaled when an attempt is made to create a database with an
+  illegal name. This is a sub type of <a
+  href="#sym-db-existential-error">db-existential-error</a>
+</blockquote>
+
 <a name="sym-invalid-type"><b>invalid-type</b></a> <br />
 <blockquote>
   Error raised when an invalid type was specified for a
   parameter. This is a sub type of <a
   href="#sym-clouchdb-error">clouchdb-error</a>
 </blockquote>
+
 </blockquote>
 
 <hr/>
@@ -2148,6 +2157,7 @@
   <a href="#sym-get-document">get-document</a> <br />
   <a href="#sym-id-missing">id-missing</a> <br />
   <a href="#sym-id-or-revision-conflict">id-or-revision-conflict</a> <br />
+  <a href="#sym-illegal-database-name">illegal-database-name</a> <br />
   <a href="#sym-invalid-input">invalid-input</a> <br />
   <a href="#sym-invoke-view">invoke-view</a> <br />
   <a href="#sym-json-to-document">json-to-document</a> <br />




From peddy at common-lisp.net  Fri Jul 17 00:26:32 2009
From: peddy at common-lisp.net (peddy)
Date: Thu, 16 Jul 2009 20:26:32 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MRbHU-00068m-Tc@common-lisp.net>

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

Modified Files:
	tests.lisp package.lisp clouchdb.lisp clouchdb.asd 
	changelog.txt 
Log Message:
Added get-uuids function, doc for it, and incremented *couchdb-version*


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/15 02:22:59	1.24
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/17 00:26:31	1.25
@@ -586,6 +586,16 @@
                "http://google.com"))
 
 (addtest (clouchdb-doc-api-tests)
+  (:documentation "Test UUID default function invocation")
+  uuid-default-test
+  (ensure-same 1 (length (document-property :|uuids| (get-uuids)))))
+
+(addtest (clouchdb-doc-api-tests)
+  (:documentation "Test UUID default function invocation")
+  uuid-count-test
+  (ensure-same 3 (length (document-property :|uuids| (get-uuids :count 3)))))
+
+(addtest (clouchdb-doc-api-tests)
   (:documentation "Test encoding and decoding of utf-8 document IDs")
   encode-document-utf-8-ids
   (ensure 
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/15 02:22:59	1.15
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2009/07/17 00:26:32	1.16
@@ -77,6 +77,7 @@
    :get-couchdb-info
    :get-db-info
    :get-document
+   :get-uuids
    :id-missing
    :id-or-revision-conflict
    :illegal-database-name
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/15 02:22:59	1.41
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/17 00:26:32	1.42
@@ -644,6 +644,13 @@
 ;; CouchDB Document Management API
 ;;
 
+(defun get-uuids (&key (count 1))
+  "Returns one or more new UUID from the current database."
+  (values (db-request "_uuids" 
+                     :parameters 
+                     (list (cons "count" (value-as-string count)))
+                     :method :get)))
+
 (defun get-all-documents (&rest options &key key keys start-key
                         start-key-docid end-key end-key-docid limit
                         stale descending skip group group-level reduce
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd	2009/06/06 17:56:25	1.7
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd	2009/07/17 00:26:32	1.8
@@ -29,7 +29,7 @@
 
 (in-package :clouchdb-asd)
 
-(defvar *clouchdb-version* "0.0.2"
+(defvar *clouchdb-version* "0.0.12"
   "The current version of clouchdb")
 
 (export '*clouchdb-version*)
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/15 02:22:59	1.12
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/17 00:26:32	1.13
@@ -2,6 +2,8 @@
 0.0.12: 
   - Added missing conflicts keyword parameter to get-document, tests
   - 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
 
 0.0.11:
 




From peddy at common-lisp.net  Fri Jul 17 00:26:33 2009
From: peddy at common-lisp.net (peddy)
Date: Thu, 16 Jul 2009 20:26:33 -0400
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1MRbHV-00069G-2o@common-lisp.net>

Update of /project/clouchdb/cvsroot/clouchdb/public_html
In directory cl-net:/tmp/cvs-serv23604/public_html

Modified Files:
	index.html 
Log Message:
Added get-uuids function, doc for it, and incremented *couchdb-version*


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/15 02:23:00	1.8
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/17 00:26:33	1.9
@@ -1290,6 +1290,18 @@
 </blockquote>
 
 <p>[Function]<br />
+<a name="sym-get-uuids"><b>get-uuids</b></a> &key count
+</p>
+<blockquote>
+  <p>
+    Get UUIDs from the datbase. By default returns one, but the
+    <b>count</b> parameter can be used to specifiy the number of UUIDs
+    to return. Note that the database does not guarantee that the
+    UUIDs returned are not already used in the database.
+  </p>
+</blockquote>
+
+<p>[Function]<br />
 <a name="sym-document-properties"><b>document-properties</b></a> doc
 </p>
 <blockquote>
@@ -1340,7 +1352,7 @@
 Create a new document or update an existing one. If the document is
 new an ID must be specified. If the document has been fetched from the
 server (and still retains its :|_*| CouchDb special properties) then
-no ID need be specified. If an parameter ID is provided and it differs
+no ID need be specified. If a parameter ID is provided and it differs
 from the :|_id| value in the document, then a new document is created
 with the provided ID and any non-special properties of the document.
 </p>
@@ -1705,7 +1717,7 @@
 ;; Save an attachment to /tmp/camels.jpg. Directory name must end
 ;; with / 
 (save-attachment "images" "camels.jpg" (pathname "/tmp/"))
-<b>=></b>(#P"/tmp/camels.jpg"
+<b>=></b>#P"/tmp/camels.jpg"
 
 ;; Save an attachment to a different file name in /tmp/
 (save-attachment "images" "camels.jpg" (pathname "/tmp/someCamels.jpg"))
@@ -2155,6 +2167,7 @@
   <a href="#sym-get-couchdb-info">get-couchdb-info</a> <br />
   <a href="#sym-get-db-info">get-db-info</a> <br />
   <a href="#sym-get-document">get-document</a> <br />
+  <a href="#sym-get-uuids">get-uuids</a> <br />
   <a href="#sym-id-missing">id-missing</a> <br />
   <a href="#sym-id-or-revision-conflict">id-or-revision-conflict</a> <br />
   <a href="#sym-illegal-database-name">illegal-database-name</a> <br />




From peddy at common-lisp.net  Sat Jul 18 21:14:49 2009
From: peddy at common-lisp.net (peddy)
Date: Sat, 18 Jul 2009 17:14:49 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MSHF3-0001ub-Jt@common-lisp.net>

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:
 




From peddy at common-lisp.net  Sat Jul 18 21:14:49 2009
From: peddy at common-lisp.net (peddy)
Date: Sat, 18 Jul 2009 17:14:49 -0400
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1MSHF3-0001ut-OI@common-lisp.net>

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

Modified Files:
	index.html 
Log Message:
Add property list option to (document-property) and (setf (document-property))


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/17 00:26:33	1.9
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/18 21:14:49	1.10
@@ -1237,15 +1237,26 @@
 </p>
 <blockquote>
 <p>
-Get the value of the named document property or nil if property does
-not exist. This function can be used with setf to set property values
-as well:
+  Get the value of the named document property or nil if property does
+  not exist. This function can be used with setf to set property
+  values as well. The <b>name</b> parameter may be either a keyword
+  document property name or a list of such properties. If <b>name</b>
+  is a list, it specifies a nested property in the document starting
+  with the outermost property and proceeding to the most nested
+  property.
 </p>
 <pre class="code">
 (create-document '((:name . "Maxwell Smart") (:agent . 86)) :id "max")
 
 (document-property :name (get-document "max"))
 <b>=></b> "Maxwell Smart"
+
+;; Nested property change example
+(create-document '((:a . 1)(:b . ((:c . ((:d . "New York")))))) :id "nested")
+;; Change (:d . "New York") to (:d . "Boston")
+(put-document
+  (setf (document-property '(:b :c :d) (get-document "nested")) "Boston"))
+
 </pre>
 <p>
 See




From peddy at common-lisp.net  Mon Jul 20 21:32:53 2009
From: peddy at common-lisp.net (peddy)
Date: Mon, 20 Jul 2009 17:32:53 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MT0Td-000512-F4@common-lisp.net>

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

Modified Files:
	tests.lisp clouchdb.lisp 
Log Message:
Added support to (document-property) and (setf (document-property)) to
allow gettting/setting/creating nested document property using a
property list. Added corresponding tests.


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/18 21:14:49	1.26
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/20 21:32:52	1.27
@@ -143,19 +143,139 @@
                                 (document-property (car e) doc)))
                      doc)))))
 
+;;
+;; (document-property) tests
+;;
+
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Test accessing document property with property list")
+  general-tests-document-property-single
+  (ensure-same 2
+               (document-property ':one
+                                  '((:one . 2) (:a . ((:b . ((:c . "found")))))))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Test accessing document property with property list")
+  general-tests-document-property-single-list
+  (ensure-same 2
+               (document-property '(:one)
+                                  '((:one . 2) (:a . ((:b . ((:c . "found")))))))))
+
 (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")))))))))
+                                  '((:one . 2) (:a . ((:b . ((:c . "found")))))))))
+
+;;
+;; (setf document-property) tests
+;;
 
 (addtest (clouchdb-general-tests)
-  (:documentation "Test accessing document property with property list")
+  (:documentation "Set existing document property with single property")
+  general-tests-document-property-modify
+  (let ((doc '((:one . 2) (:a . ((:b . ((:c . "not searched for"))))))))
+    (ensure-same "found" 
+                 (document-property :a 
+                                    (setf (document-property :a doc) "found")))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Set existing document property with single element list property")
+  general-tests-document-property-single-list-modify
+  (let ((doc '((:one . 2) (:a . ((:b . ((:c . "not searched for"))))))))
+    (ensure-same "found" 
+                 (document-property 
+                  :a 
+                  (setf (document-property '(:a) doc) "found")))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Set existing 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))))
+  (let ((doc '((:one . 2) (:a . ((:b . ((:c . "not found")))))))
+        (properties '(:a :b :c)))
+    (ensure-same "found" 
+                 (document-property 
+                  properties
+                  (setf (document-property properties doc) "found")))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Add top level document property
+  with (setf (document-property))")
+  general-tests-document-property-add-top-level
+  (let ((doc '((:one . 1) (:two . 2))))    
+    (ensure-same 3 (document-property 
+                    :three 
+                    (setf (document-property :three doc) 3)))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Add document property list to document.")
+  general-tests-document-property-add-property-list
+  (let ((doc '((:one . 1) (:two . 2)))
+        (properties '(:three :four)))
+    (ensure-same 4 
+                 (document-property 
+                  properties
+                  (setf (document-property properties doc) 4)))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Replace document property with nested property list.")
+  general-tests-document-property-replace-property-list
+  (let ((doc '((:one . 1) (:two . 2) (:three . 3)))
+        (properties '(:three :four)))
+    (ensure-same 4 
+                 (document-property 
+                  properties
+                  (setf (document-property properties doc) 4)))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Change nested document property.")
+  general-tests-document-property-replace-property-list1
+  (let ((doc '((:one . 1) (:two . ((:four . ((:nine . 8))))) (:three . 3)))
+        (properties '(:two :four :nine)))
+    (ensure-same 9
+                 (document-property 
+                  properties
+                  (setf (document-property properties doc) 9)))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Truncate deep document property list.")
+  general-tests-document-property-replace-property-list2
+  (let ((doc '((:one . 1) (:two . ((:four . ((:nine . 9))))) (:three . 3)))
+        (properties '(:two :four)))
+    (ensure-same 4
+                 (document-property 
+                  properties
+                  (setf (document-property properties doc) 4)))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Create document with single property (setf (document-property))")
+  general-tests-document-property-create-property
+  (ensure-same 44 
+               (document-property 
+                :value 
+                (setf (document-property ':value nil) 44))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Create document with property list (setf (document-property))")
+  general-tests-document-property-create-propert-list1
+  (ensure-same 44 
+               (document-property 
+                :value 
+                (setf (document-property '(:value) nil) 44))))
+
+(addtest (clouchdb-general-tests)
+  (:documentation "Create document with property list (setf (document-property))")
+  general-tests-document-property-create-propert-list-multi
+  (ensure-same 44 
+               (document-property 
+                '(:some :nested :value)
+                (setf (document-property '(:some :nested :value) nil) 44))))
+
+;; 
+;; 
+;; 
 
 (addtest (clouchdb-general-tests)
   (:documentation "Test case-encoded field name functions")
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/18 21:14:49	1.43
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/20 21:32:53	1.44
@@ -277,7 +277,8 @@
         ((db-p input) (couchdb-database-url input))
         (t (error 'invalid-type
                   :input input
-                  :description "Database must be a string or a database structure"))))
+                  :description 
+                  "Database must be a string or a database structure"))))
 
 (defun make-uri (&rest rest)
   "Return a URI containing protocol://host:port/ and the concatenation
@@ -358,18 +359,42 @@
   "Allows setting of existing document properties in
 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 ((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))
+of identifiers. If the specified document property does not already
+exist it is created."
+  (labels ((recursive-compose (pl val)
+             (if (null pl)
+                 val
+                 (list (cons (car pl) 
+                             (recursive-compose (cdr pl) val))))))
+    (let ((kw-name (as-keyword-symbol name)))
+      (cond ((and (listp name) (> (length name) 1))
+             (cond ((null (document-property (car name) doc))
+                    ;; Specified property does not exist in current
+                    ;; document, fill in potentially nested value.
+                    (setf doc (nconc doc (recursive-compose name value))))
+                   ((not (assoclp (document-property (car name) doc)))
+                    ;; Value being set is replacing existing value
+                    ;; which is not a more deeply nested document
+                    ;; value. 
+                    (rplacd (assoc (as-keyword-symbol (car name)) doc)
+                            (recursive-compose (rest name) value))
+                    doc)
+                   (t
+                    (setf (document-property 
+                           (rest name)
+                           (document-property (car name) doc))
+                          value)
+                    doc)))
+            ((listp name)
+             (setf (document-property (car name) doc) value))
+            ((hash-table-p doc)
+             (setf (gethash kw-name doc) value))
+            (t 
+             (let ((v (assoc kw-name doc)))
+               (if (or (null v) (not (listp v)))
+                   (setf doc (nconc doc (list (cons kw-name value))))
+                   (rplacd v value))
+               doc))))))
 
 (defun set-document-property (doc &rest args)
   "Set a property of a document. If the named property does not exist,
@@ -377,9 +402,7 @@
 destructively modify input document, so be sure to use return value."
   (let ((doc (copy-tree doc)))
     (loop for (name value) on args by #'cddr
-       do (if (assoc name doc)
-              (setf (document-property name doc) value)
-              (setf doc (cons `(,(as-keyword-symbol name) . ,value) doc))))
+       do (setf doc (setf (document-property name doc) value)))
     doc))
 
 (defun document-id (doc)
@@ -473,7 +496,6 @@
   (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) args)
-      ;;(declare (ignore must-close reason-phrase stream uri headers status))
       (when *debug-requests*
         (format t "uri: ~s~%args: ~s~%must-close:~s~%reason-phrase:
         ~s~%status: ~s~%headers: ~s~%stream:~s~%body:~s~%" uri args
@@ -763,16 +785,17 @@
 	   (setf doc (document-properties doc))))
     (when attachments
       (setf doc (cons (encode-attachments attachments) doc)))
-    (let ((res (ensure-db () (db-request (cat (url-encode (db-name *couchdb*)) "/" 
-                                              (url-encode (if id id current-id)))
-                                         :content-type "text/javascript"
-                                         :external-format-out +utf-8+
-                                         :content-length nil
-                                         :content (document-to-json 
-                                                   (document-update-notify 
-                                                    (db-document-update-fn *couchdb*) 
-                                                    doc))
-                                         :method :put))))
+    (let ((res (ensure-db () 
+                 (db-request (cat (url-encode (db-name *couchdb*)) "/" 
+                                  (url-encode (if id id current-id)))
+                             :content-type "text/javascript"
+                             :external-format-out +utf-8+
+                             :content-length nil
+                             :content (document-to-json 
+                                       (document-update-notify 
+                                        (db-document-update-fn *couchdb*) 
+                                        doc))
+                             :method :put))))
       (when (document-property :|error| res)
         (error (if (equal "conflict" (document-property :|error| res)) 
                    'id-or-revision-conflict 
@@ -913,7 +936,8 @@
                                 (url-encode (value-as-string rev)))
                            :method :delete))))
                (when (document-property :|error| res)
-                 (error 'doc-error :id id :reason (document-property :|reason| res)))
+                 (error 'doc-error :id id 
+                        :reason (document-property :|reason| res)))
                res)))
     (cond ((stringp doc-or-id)
            (del doc-or-id 
@@ -1200,8 +1224,33 @@
 		:method :get
                 :parameters (transform-params options *view-options*))))
 
+(defun add-ps-fns (id type &rest list-defs)
+  "Add lists in list-defs to document identified by id. If the
+document does not exist, create it. If any list function definitions
+already exist in the document, update them."
+  (let* ((list-id (cat "_design/" id))
+         (doc (get-document list-id :if-missing :ignore)))
+    (dolist (list-def (mapcar #'json-to-document list-defs))
+      (setf doc (setf (document-property (list type (caar list-def)) doc)
+                      (cdar list-def))))
+    (put-document doc :id list-id)))
+
+(defun add-ps-lists (id &rest list-defs)
+  "Add lists in list-defs to document identified by id. If the
+document does not exist, create it. If any list function definitions
+already exist in the document, update them."
+  (apply #'add-ps-fns id :|lists| list-defs))
 
-;; (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
+(defun invoke-list (doc-id list-id)
+  ""
+  (multiple-value-bind (body status headers uri stream must-close reason-phrase)
+      (let ((url (make-uri (url-encode (db-name *couchdb*))
+                                     "/_design/"
+                                     (url-encode doc-id) 
+                                     "/_list/"
+                                     (url-encode list-id))))
+        (format t "uri: ~S~%" url)
+        (drakma:http-request url))
+    (when stream
+      (close stream))
+    body))
\ No newline at end of file




From peddy at common-lisp.net  Wed Jul 22 20:30:43 2009
From: peddy at common-lisp.net (peddy)
Date: Wed, 22 Jul 2009 16:30:43 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MTiSZ-0002wd-Uv@common-lisp.net>

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

Modified Files:
	changelog.txt 
Log Message:
Fixes for (delete-document), and more related tests


--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/18 21:14:49	1.14
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/22 20:30:43	1.15
@@ -5,6 +5,8 @@
   - 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
+  - Made (get-document) accept documents with :|_id| or :|id| properties
+  - Fixed (delete-document) to work more consistently with :if-missing
 
 0.0.11:
 




From peddy at common-lisp.net  Wed Jul 22 20:31:31 2009
From: peddy at common-lisp.net (peddy)
Date: Wed, 22 Jul 2009 16:31:31 -0400
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1MTiTL-0002xO-4z@common-lisp.net>

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