[clouchdb-cvs] CVS clouchdb/src

[peddy]

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: