From peddy at common-lisp.net  Sun Nov 22 16:41:25 2009
From: peddy at common-lisp.net (peddy)
Date: Sun, 22 Nov 2009 11:41:25 -0500
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1NCFV7-0007gc-HC@common-lisp.net>

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

Modified Files:
	index.html 
Log Message:
Finally add ad-hoc-view patch from Marco


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/07/18 21:14:49	1.10
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/11/22 16:41:25	1.11
@@ -1823,7 +1823,7 @@
 <a name="sym-ad-hoc-view"><b>ad-hoc-view</b></a> view &amp;key key start-key
                         start-key-docid end-key end-key-docid limit
                         stale descending skip group group-level reduce
-                        include-docs
+                        include-docs language
 </p>
 <blockquote>
 <p>
@@ -1884,6 +1884,9 @@
   <li>
     <b>include-docs</b> If not nil, include the associated documents in the results.
   </li>
+  <li>
+    <b>language</b> The view language, default is "javascript"
+  </li>
 </ul>
 <p>
 Example:




From peddy at common-lisp.net  Sun Nov 22 16:41:25 2009
From: peddy at common-lisp.net (peddy)
Date: Sun, 22 Nov 2009 11:41:25 -0500
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1NCFV7-0007go-P8@common-lisp.net>

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

Modified Files:
	changelog.txt clouchdb.lisp 
Log Message:
Finally add ad-hoc-view patch from Marco


--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/07/22 20:30:43	1.15
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/11/22 16:41:25	1.16
@@ -4,7 +4,8 @@
   - 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
+  - Made (document-property) and (setf (document-property)) accept a list of property names
+  - Made (set-document-property) accept multiple lists of property names
   - Made (get-document) accept documents with :|_id| or :|id| properties
   - Fixed (delete-document) to work more consistently with :if-missing
 
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/07/22 20:31:31	1.45
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/11/22 16:41:25	1.46
@@ -1114,7 +1114,7 @@
 (defun ad-hoc-view (view &rest options &key key start-key
                     start-key-docid end-key end-key-docid limit stale
                     descending skip group group-level reduce
-                    include-docs)
+                    include-docs (language "javascript"))
   "Execute query using an ad-hoc view."
   (declare (ignore key start-key start-key-docid end-key end-key-docid
                    limit stale descending skip group group-level
@@ -1126,7 +1126,9 @@
 		:content-type "application/json"
                 :content-length nil
                 :parameters (transform-params options *view-options*)
-		:content view)))
+		:content 
+                (cat "{\"language\" : \"" language "\"," 
+                     "\"map\" : \"" view "\"}"))))
 
 (defun create-view (id view &key (language "javascript"))
   "Create one or more views in the specified view document ID."
@@ -1241,7 +1243,7 @@
     (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
+  "Add CouchDb 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))




From peddy at common-lisp.net  Sun Nov 22 18:09:56 2009
From: peddy at common-lisp.net (peddy)
Date: Sun, 22 Nov 2009 13:09:56 -0500
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1NCGsm-00058v-9k@common-lisp.net>

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

Modified Files:
	tests.lisp 
Log Message:
Update ad-hoc-view tests


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/07/22 20:31:31	1.28
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/11/22 18:09:55	1.29
@@ -962,11 +962,10 @@
 	       (document-property
 		:|total_rows|
 		(ad-hoc-view 
-		 (ps-view () 
-                   (defun map (doc)
-                     (with-slots (*NAME*) doc
-                       (if (= *NAME* "marc")
-                           (emit null *NAME*)))))))))
+		 (ps (lambda (doc)
+                       (with-slots (*NAME*) doc
+                         (if (= *NAME* "marc")
+                             (emit null *NAME*)))))))))
 
 (addtest (clouchdb-view-tests)
   (:documentation "Create an ad-hock view that should return no results")
@@ -974,10 +973,9 @@
   (ensure-same 0 (document-property
 		  :|total_rows|
 		  (ad-hoc-view 
-		   (ps-view () 
-                     (defun map (doc)
-                       (if (= doc.name "marie")
-                           (emit null doc.name))))))))
+		   (ps (lambda (doc)
+                         (if (= doc.name "marie")
+                             (emit null doc.name))))))))
 
 (addtest (clouchdb-view-tests)
   (:documentation "Ensure a view can be created")




From peddy at common-lisp.net  Fri Nov 27 22:48:33 2009
From: peddy at common-lisp.net (peddy)
Date: Fri, 27 Nov 2009 17:48:33 -0500
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1NE9c9-0002s9-2N@common-lisp.net>

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

Modified Files:
	clouchdb.lisp 
Log Message:
- Added basic authentication support


--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/11/22 16:41:25	1.46
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.lisp	2009/11/27 22:48:32	1.47
@@ -121,6 +121,16 @@
   ()
   (:documentation "The base type of all errors signaled by clouchdb"))
 
+(define-condition authorization-error (clouchdb-error)
+  ((result :initarg :result :reader result)
+   (db :initarg :db :reader db)
+   (uri :initarg :uri :reader uri)
+   (text :initarg :text :reader text))
+  (:report (lambda (condition stream)
+	     (format stream "Authorizion failed for URI \"~A\", reason \"~A\"" 
+                     (uri condition)
+                     (text condition)))))
+
 (define-condition db-existential-error (clouchdb-error)
   ((text :initarg :uri :reader uri)
    (db :initarg :db :reader db)
@@ -283,7 +293,8 @@
 (defun make-uri (&rest rest)
   "Return a URI containing protocol://host:port/ and the concatenation
 of the remaining parameters."
-  (concatenate 'string (couchdb-host-url *couchdb*) "/"
+  (concatenate 'string 
+               (couchdb-host-url *couchdb*) "/"
 	       (apply #'concatenate 'string rest)))
 
 (defmacro ensure-db ((&key (db-name nil db-name-p)) &body body)
@@ -504,8 +515,11 @@
           (values (json-to-document body) status)
           (values body status reason-phrase)))))
 
-(defun make-db (&key host port name protocol user password
-                document-fetch-fn document-update-fn (db *couchdb*))
+(defun make-db (&key host port name protocol 
+                (user nil user-supplied-p) 
+                (password nil password-supplied-p)
+                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."
@@ -513,21 +527,19 @@
           :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))
+          :user (if user-supplied-p user (db-user db))
+          :password (if password-supplied-p 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 *couchdb*) document-update-fn
-                       document-fetch-fn)
+(defun set-connection (&rest args &key host port name protocol user password 
+                       document-fetch-fn document-update-fn db)
   "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 *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)))
+  (declare (ignore host port name protocol user password document-update-fn
+                   document-fetch-fn db))
+  (setf *couchdb* (apply #'make-db args)))
 
 (defmacro with-connection ((&key db name port protocol
                                  host document-update-fn
@@ -560,6 +572,12 @@
          ((db-p ,db) ,db)
          (t nil)))
 
+(defun make-db-auth (db)
+  "Return user name password values or nil if no user name specified
+for db"
+  (let ((user (db-user db)))
+    (if user (list user (db-password db)))))
+
 ;;
 ;; CouchDB Database Management API
 ;;
@@ -581,9 +599,16 @@
   (let ((*couchdb* (db-or-db-name db)))
     (multiple-value-bind (res status)
         (db-request (cat (url-encode (db-name *couchdb*)) "/")
-                    :method :put :content "")
+                    :method :put :content ""
+                    :basic-authorization (make-db-auth *couchdb*))
       (cond ((eq 201 status)
              res)
+            ((equal "unauthorized" (document-property :|error| res))
+             (error 'authorization-error
+                    :text (document-property :|reason| res)
+                    :result res
+                    :db *couchdb*
+                    :uri (make-uri (db-name *couchdb*))))
             ((equal "file_exists" (document-property :|error| res))
              (ecase if-exists
                ((:ignore) (list (cons :|ok| t) (cons :|ignored| t)))
@@ -595,7 +620,8 @@
                            :db *couchdb*
                            :uri (make-uri (db-name *couchdb*)))
                   (ignore () :report "Ignore error and continue" nil)))))
-            ((equal "illegal_database_name" (document-property :|reason| res))
+            ((or (equal "illegal_database_name" (document-property :|reason| res))
+                 (equal "illegal_database_name" (document-property :|error| res)))
              (error 'illegal-database-name
                     :result res
                     :db *couchdb*
@@ -606,15 +632,25 @@
 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* ((*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 *couchdb* :uri (make-uri))
-	  (ignore () :report "Ignore error and continue" nil)))
-    res))
+  (let* ((*couchdb* (db-or-db-name db)))
+    (multiple-value-bind (res status)
+        (db-request (cat (url-encode (db-name *couchdb*)) "/")
+                    :method :delete
+                    :basic-authorization (make-db-auth *couchdb*))
+      (cond ((eq 200 status)
+             res)
+            ((equal "unauthorized" (document-property :|error| res))
+             (error 'authorization-error
+                    :text (document-property :|reason| res)
+                    :result res
+                    :db *couchdb*
+                    :uri (make-uri (db-name *couchdb*))))
+            ((and (document-property :|error| res) (not (eq :ignore if-missing)))
+             (restart-case 
+                    (error 'db-does-not-exist
+                           :result res :db *couchdb* :uri (make-uri))
+                  (ignore () :report "Ignore error and continue" nil))))
+      res)))
 
 (defun compact-db (&key (db *couchdb*))
   "Start compaction on current database, or specified database if
@@ -674,12 +710,49 @@
     (ensure-db ()
       (db-request "_replicate"
                   :method :post
+                  :basic-authorization (make-db-auth *couchdb*)
                   :content-type "application/json"
                   :content 
                   (cat "{\"source\":\"" (make-db-identifier source) "\","
                        "\"target\":\"" (make-db-identifier target) "\"}"))))
 
 ;;
+;; _config API
+;;
+
+;; (defun get-config (key)
+;;   ""
+;;   (multiple-value-bind (res status)
+;;       (db-request (cat "_config/" key) :method :get
+;;                   :basic-authorization (make-db-auth *couchdb*))
+;;     (cond ((eq 200 status)
+;;            res)
+;;           ((equal "unauthorized" (document-property :|error| res))
+;;            (error 'authorization-error
+;;                   :text (document-property :|reason| res)
+;;                   :result res
+;;                   :db *couchdb*
+;;                   :uri (make-uri (db-name *couchdb*))))
+;;           (t res))))
+  
+
+;; (defun put-config (key value)
+;;   ""
+;;   (multiple-value-bind (res status)
+;;       (db-request (cat "_config/" key) :method :put
+;;                   :content value
+;;                   :basic-authorization (make-db-auth *couchdb*))
+;;     (cond ((eq 200 status)
+;;            res)
+;;           ((equal "unauthorized" (document-property :|error| res))
+;;            (error 'authorization-error
+;;                   :text (document-property :|reason| res)
+;;                   :result res
+;;                   :db *couchdb*
+;;                   :uri (make-uri (db-name *couchdb*))))
+;;           (t res))))
+
+;;
 ;; CouchDB Document Management API
 ;;
 
@@ -935,6 +1008,10 @@
                                 (url-encode id)
                                 "?rev=" 
                                 (url-encode (value-as-string rev)))
+                           ;; Authorization here is for delete-view,
+                           ;; it's not required for normal document
+                           ;; deletes
+                           :basic-authorization (make-db-auth *couchdb*)
                            :method :delete))))
                (when (document-property :|error| res)
                  (error 'doc-error :id id 
@@ -1138,6 +1215,7 @@
                      (url-encode id))
                 :method :put
                 :external-format-out +utf-8+
+                :basic-authorization (make-db-auth *couchdb*)
 		:content-type "application/json"
                 :content-length nil
                 :content




From peddy at common-lisp.net  Fri Nov 27 22:49:28 2009
From: peddy at common-lisp.net (peddy)
Date: Fri, 27 Nov 2009 17:49:28 -0500
Subject: [clouchdb-cvs] CVS clouchdb/src
Message-ID: <E1NE9d2-0002te-5e@common-lisp.net>

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

Modified Files:
	tests.lisp changelog.txt 
Log Message:
- Add tests and doc for basic auth


--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/11/22 18:09:55	1.29
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp	2009/11/27 22:49:28	1.30
@@ -146,6 +146,13 @@
                                 (document-property (car e) doc)))
                      doc)))))
 
+
+
+;;
+;; DB Structure Tests
+;;
+
+
 ;;
 ;; (document-property) tests
 ;;
@@ -515,6 +522,7 @@
   db-compact-db-struct
   (with-temp-db
     (ensure (document-property :|ok| (compact-db :db *couchdb*)))))
+
 ;;
 ;; Document API Tests
 ;;
@@ -881,7 +889,7 @@
   (:teardown 
    (progn 
      (delete-db)
-     (set-connection :db-name "default"))))
+     (set-connection :name "default"))))
 
 (addtest (clouchdb-replication-tests)
   (:documentation "test local replication of current db to new db using string identifier")
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/11/22 16:41:25	1.16
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt	2009/11/27 22:49:28	1.17
@@ -1,4 +1,9 @@
 
+0.0.13:
+  - Applied ad-hoc-view patch from Marco
+  - Added basic authentication support
+  - Updated tests
+
 0.0.12: 
   - Added missing conflicts keyword parameter to get-document, tests
   - Added error handling in create-db for illegal database names




From peddy at common-lisp.net  Fri Nov 27 22:49:28 2009
From: peddy at common-lisp.net (peddy)
Date: Fri, 27 Nov 2009 17:49:28 -0500
Subject: [clouchdb-cvs] CVS clouchdb/public_html
Message-ID: <E1NE9d2-0002tv-BC@common-lisp.net>

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

Modified Files:
	index.html 
Log Message:
- Add tests and doc for basic auth


--- /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/11/22 16:41:25	1.11
+++ /project/clouchdb/cvsroot/clouchdb/public_html/index.html	2009/11/27 22:49:28	1.12
@@ -111,21 +111,21 @@
 
 <p>
   The clouchdb distribution comes with a unit test suite which uses
-  the LIFT testing framework. To run the tests, follow the following
+  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)
+
+;; The following is only necessary if the couchdb server is not on 
+;; localhost, or authenticaion is enabled, respectively.
+(set-connection :host "hostname" :user "username" :password "password")
+
 (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>
@@ -1907,7 +1907,7 @@
 (ad-hoc-view (ps (lambda (doc)
                    (with-slots (*name*) doc
                      (if (eql *name* "Laraby")
-                       (map nil doc))))))
+                       (emit nil doc))))))
 </pre>
 <p>
  Note that it is not necessary for every document in the database to
@@ -1922,7 +1922,7 @@
 <pre class="code">
 (ad-hoc-view (ps (lambda (doc)
                    (if (eql doc.*name* "Laraby")
-                     (map nil doc))))))
+                     (emit nil doc))))))
 </pre>
 <p>See (<a href="#sym-create-view">create-view</a>) and <a href="#example-3">Example 3</a></p>
 </blockquote>
@@ -2044,11 +2044,11 @@
         (ps (lambda (doc)  ;; parameter-less view
               (with-slots (name) doc
                 (if (eql "Laraby" name)
-                  (map nil doc))))))
+                  (emit nil doc))))))
   (cons <b>"name"</b>
         (ps (lambda (doc)  ;; parameter view
               (with-slots (name) doc
-                (map name doc))))))
+                (emit name doc))))))
 
 ;; Find document by invoking parameter-less "laraby" view
 (invoke-view <b>"names" "laraby"</b>)