[clouchdb-cvs] CVS clouchdb/src
peddy
peddy at common-lisp.net
Mon Jul 6 22:24:45 UTC 2009
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))))
More information about the clouchdb-cvs
mailing list