[clouchdb-cvs] CVS clouchdb/src

[peddy]

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

Modified Files:
	changelog.txt clouchdb.asd clouchdb.lisp package.lisp 
Log Message:
  - Encode all URL parameters properly, this fixes issues reported by
  Daniel Farina having to do with the inability to use leagal
  characters in document IDs.
  - Error handling for (post-document)


--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2007/12/09 16:03:21	1.2
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2007/12/17 13:58:32	1.3
@@ -1,4 +1,10 @@
 
+0.0.5:
+  - Encode all URL parameters properly, this fixes issues reported by
+  Daniel Farina having to do with the inability to use leagal
+  characters in document IDs.
+  - Error handling for (post-document)
+
 0.0.4:
 
   - Fixed ad-hoc-view and invoke-view functions so that they now use
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd	2007/12/01 14:19:59	1.1.1.1
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd	2007/12/17 13:58:32	1.2
@@ -38,7 +38,8 @@
   :serial t
   :version #.*clouchdb-version*
   :depends-on (:drakma
-               :cl-json)
+               :cl-json
+               :flexi-streams)
   :components ((:file "package")
                (:file "clouchdb")))
 
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2007/12/14 23:22:58	1.4
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2007/12/17 13:58:32	1.5
@@ -25,7 +25,8 @@
 (in-package :clouchdb)
 
 (defvar *host* "localhost" "CouchDb server host name")
-(defvar *port* "5984" "As of version 7.2, the IANA assigned CouchDb port (was 8888)")
+(defvar *port* "5984" 
+  "As of version 7.2, the IANA assigned CouchDb port (was 8888)")
 (defvar *db-name* "default" "Default database name")
 (defvar *protocol* "http" "http or https")
 
@@ -37,6 +38,9 @@
 
 (defparameter *temp-db-counter* 0 "Used in the creation of temporary databases")
 
+;(defconstant +utf-8+ (make-external-format :utf-8 :eol-style :lf)
+;  "Default external format for document content.")
+
 ;;
 ;; URL Parameter helpers
 ;;
@@ -104,7 +108,11 @@
 (define-condition doc-error (error) 
   ((text :initarg :uri :reader text)
    (reason :initarg :reason :reader reason)
-   (id :initarg :id :reader id)))
+   (id :initarg :id :reader id))
+  (:report (lambda (condition stream)
+	     (format stream "Reason \"~A\", Document ID: \"~A\""
+		     (reason condition)
+		     (id condition)))))
   
 (define-condition id-or-revision-conflict (doc-error) 
   ()
@@ -197,6 +205,14 @@
 		      :uri (make-uri dbn)))))
        ,result)))
 
+;; (defmacro handle-doc-errors (&body body)
+;;   (let ((result (gensym)))
+;;     `(let ((,result (progn , at body)))
+;;        (when (document-property :error (,result))
+;;          (cond ((equal "conflict" (document-property :error result))
+;;                 (error 'id-or-revision-conflict 
+               
+
 ;;
 ;;
 ;;
@@ -235,7 +251,7 @@
 	(t (cdr (assoc name doc)))))
 
 (defun (setf document-property) (value name doc)
-  "Allows setting of document properties in place."
+  "Allows setting of document properties in place (destructively)."
   (cond ((hash-table-p doc)
 	 (setf (gethash name doc) value))
 	(t (rplacd (assoc name doc) value)))
@@ -303,7 +319,8 @@
 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)))
+	 (res (db-request (cat (url-encode name) "/") 
+                          :method :put)))
     (if (equal "database_already_exists" (document-property :error res))
       (ecase if-exists
 	((:ignore) (list (cons :ok t) (cons :ignored t)))
@@ -426,9 +443,10 @@
 	  ((and id current-id (not (equal current-id id)))
 	   (setf doc (document-properties doc))))
     (let ((res (ensure-db ()
-		 (db-request (cat (url-encode *db-name*) "/" (url-encode (if id id current-id)))
-                             :external-format-out :utf-8
+		 (db-request (cat (url-encode *db-name*) "/" 
+                                  (url-encode (if id id current-id)))
                              :content-type "text/json"
+;;                             :external-format-out +utf-8+
 			     :method :put :content (document-to-json doc)))))
       (when (document-property :error res)
 	(error (if (equal "conflict" (document-property :error res)) 
@@ -440,10 +458,23 @@
 (defun post-document (doc)
   "Create a document and let the server assign an ID. A successful
 areturn value includes the new document ID, in the :ID property."
-  (ensure-db ()
-    (db-request (cat (url-encode *db-name*) "/")
-		:method :post
-		:content (document-to-json doc))))
+  (let ((res (ensure-db ()
+               (db-request (cat (url-encode *db-name*) "/")
+                           :method :post
+                           :content (document-to-json doc)))))
+    (when (document-property :error res)
+      (error 'doc-error) :id nil :reason (document-property :reason res))
+    res))
+
+;; (defun post-document (doc)
+;;   "Create a document and let the server assign an ID. A successful
+;; areturn value includes the new document ID, in the :ID property."
+;;   (ensure-db ()
+;;     (db-request (cat (url-encode *db-name*) "/")
+;; 		:method :post
+;;                 :content-type "text/plain;charset=utf-8"
+;;                 :external-format-out +utf-8+
+;; 		:content #p"/Users/peter/encodings.txt")))
 
 (defun create-document (doc &key id)
   "Create a new document, optionally specifying the new document
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2007/12/01 14:19:59	1.1.1.1
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp	2007/12/17 13:58:32	1.2
@@ -25,7 +25,7 @@
 (cl:in-package :cl-user)
 
 (defpackage :clouchdb
-  (:use :cl :drakma :json)
+  (:use :cl :drakma :json :flexi-streams)
   (:export :*scheme*
 	   :*host*
 	   :*port*