[clouchdb-cvs] CVS clouchdb/src
peddy
peddy at common-lisp.net
Sat Jan 19 20:18:57 UTC 2008
Update of /project/clouchdb/cvsroot/clouchdb/src
In directory clnet:/tmp/cvs-serv31191/src
Modified Files:
tests.lisp package.lisp encoder.lisp clouchdb.asd
changelog.txt cache.lisp
Log Message:
--- /project/clouchdb/cvsroot/clouchdb/src/tests.lisp 2008/01/07 01:21:24 1.10
+++ /project/clouchdb/cvsroot/clouchdb/src/tests.lisp 2008/01/19 20:18:57 1.11
@@ -366,17 +366,17 @@
(addtest (clouchdb-doc-api-tests)
(:documentation "Create a document with create-document")
create-document-auto-id
- (ensure (document-property :|ok| (create-document '((:a "test"))))))
+ (ensure (document-property :|ok| (create-document '((:a . "test"))))))
(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")
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")))
--- /project/clouchdb/cvsroot/clouchdb/src/package.lisp 2008/01/07 01:21:24 1.6
+++ /project/clouchdb/cvsroot/clouchdb/src/package.lisp 2008/01/19 20:18:57 1.7
@@ -25,7 +25,7 @@
(cl:in-package :cl-user)
(defpackage :clouchdb
- (:use :cl :drakma :flexi-streams)
+ (:use :cl :drakma :flexi-streams :s-base64)
(:export :*scheme*
:*host*
:*port*
--- /project/clouchdb/cvsroot/clouchdb/src/encoder.lisp 2008/01/07 01:21:24 1.6
+++ /project/clouchdb/cvsroot/clouchdb/src/encoder.lisp 2008/01/19 20:18:57 1.7
@@ -127,10 +127,15 @@
((listp d)
(write-list d stream))))
+(defun document-to-json-stream (doc stream)
+ "Encode document to stream with special support for detecting and
+handling associative lists."
+ (if (null doc)
+ (write-string "{}" stream)
+ (encode doc stream)))
+
(defun document-to-json (doc)
- "Encode document with special support for detecting and handling
-associative lists."
+ "Encode document to string with special support for detecting and
+handling associative lists."
(with-output-to-string (stream)
- (if (null doc)
- (write-string "{}" stream)
- (encode doc stream))))
+ (document-to-json-stream doc stream)))
--- /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd 2007/12/28 16:25:51 1.4
+++ /project/clouchdb/cvsroot/clouchdb/src/clouchdb.asd 2008/01/19 20:18:57 1.5
@@ -39,6 +39,7 @@
:version #.*clouchdb-version*
:depends-on (:drakma
:parenscript
+ :s-base64
:flexi-streams)
:components ((:file "package")
(:file "clouchdb")
--- /project/clouchdb/cvsroot/clouchdb/src/changelog.txt 2007/12/21 19:58:32 1.6
+++ /project/clouchdb/cvsroot/clouchdb/src/changelog.txt 2008/01/19 20:18:57 1.7
@@ -1,4 +1,13 @@
+0.0.8:
+
+ - Function set-document-property now operates non-destructively, be
+ sure existing code is using use function's result.
+ - Added function query-document to make it easier to extract the
+ interesting portions of complex documents. Inspired by xpath style
+ queries.
+ - Added hooks to intercept document fetching and updating/creating.
+
0.0.7:
- Copied and modified cl-json encoding functions to better handle
conversion of lisp associative lists to json data types.
--- /project/clouchdb/cvsroot/clouchdb/src/cache.lisp 2008/01/12 20:44:41 1.2
+++ /project/clouchdb/cvsroot/clouchdb/src/cache.lisp 2008/01/19 20:18:57 1.3
@@ -24,9 +24,8 @@
(in-package :clouchdb)
-;;; This is an implementation of a most recently used cache. It's
-;;; primary data structures are a hashtable and a doubly linked list
-;;; list.
+;;; This is an implementation of a most recently used (MRU)
+;;; cache. Random access to cached data is through a hashtable,
(proclaim '(inline cache-size rmcache))
@@ -36,20 +35,16 @@
;; The cache data structure
(defstruct cache
hashtable head tail
+ remove-notify-fn add-notify-fn
(max-size 300 :type integer))
-(defun make-mru-cache (&key (size 100) (rehash-size 100)
- (rehash-threshold 0.9) (max-size 300)
- (test #'eql))
- "Make a new MRU cache."
- (make-cache :hashtable (make-hash-table :size size
- :test test
- :rehash-size rehash-size
- :rehash-threshold rehash-threshold)
- :max-size max-size))
+;;
+;; Cache Helper Functions
+;;
-(defun remove-element (element cache)
- "Remove specified element from cache linked list"
+(defun rm-element (element cache)
+ "Remove specified element from cache linked list, adjust cache head
+and tail if apropriate."
(if (cached-previous element)
(setf (cached-next (cached-previous element)) (cached-next element))
(setf (cache-head cache) (cached-next element)))
@@ -57,14 +52,10 @@
(setf (cached-previous (cached-next element)) (cached-previous element))
(setf (cache-tail cache) (cached-previous element))))
-(defun cache-size (cache)
- "Return number of elements in cache."
- (hash-table-count (cache-hashtable cache)))
-
(defun move-to-head (element cache)
- "Move specified cache element to top of cache"
+ "Move specified cache element to head of cache doubly linked list."
(unless (eq (cache-head cache) element)
- (remove-element element cache)
+ (rm-element element cache)
(setf (cached-previous element) nil)
(let ((old-head (cache-head cache)))
(setf (cache-head cache) element)
@@ -86,42 +77,87 @@
(setf (cached-next element) head)))
(setf (cache-head cache) element)))
-(defun get-cached (key cache)
- "Get cached value by key."
+(defun rm-cache (element cache)
+ "Remove element from hashtable and linked list, call the remove
+notification method if it has been specified."
+ (rm-element element cache)
+ (remhash (cached-key element) (cache-hashtable cache))
+ (when (cache-remove-notify-fn cache)
+ (funcall (cache-remove-notify-fn cache)
+ (cached-key element) (cached-value element) cache)))
+
+;;
+;; Public API
+;;
+
+(defun make-mru-cache (&key (size 100) (rehash-size 100)
+ (rehash-threshold 0.9) (max-size 300)
+ (test #'eql) remove-notify-fn)
+ "Make a new MRU cache. Arguments are the same as for
+make-hash-table, except for max-size, which limits the cache to a
+specific size."
+ (make-cache :hashtable (make-hash-table :size size
+ :test test
+ :rehash-size rehash-size
+ :rehash-threshold rehash-threshold)
+ :remove-notify-fn remove-notify-fn
+ :max-size max-size))
+
+(defun get-cached (key cache &key (update-mru t))
+ "Get cached value by key, move cached element to top of MRU list,
+unless update-mru is false."
(let ((element (gethash key (cache-hashtable cache))))
- (when element
+ (when (and element update-mru)
(move-to-head element cache)
(cached-value element))))
-(defun rmcache (element cache)
- "Remove element from hashtable and linked list."
- (remove-element element cache)
- (remhash (cached-key element) (cache-hashtable cache)))
+(defun cache-size (cache)
+ "Return the number of elements in the cache."
+ (hash-table-count (cache-hashtable cache)))
(defun (setf get-cached) (value key cache)
"Add new cached value or update current value associated with
-key. Moves cached element to top of cache list. May result in least
-recently used element element being removed."
+key. Moves new or updated cache element to top of cache list. May
+result in least recently used element element being removed."
(let ((element (gethash key (cache-hashtable cache))))
(cond ((null element)
(set-cache-top
(setf (gethash key (cache-hashtable cache))
(make-cached :key key :value value))
- cache))
+ cache)
+ (when (cache-add-notify-fn cache)
+ (funcall (cache-add-notify-fn cache) key value cache)))
(t
(move-to-head element cache)
(setf (cached-value element) value)
(move-to-head element cache)))
(when (> (cache-size cache)
(cache-max-size cache))
- (rmcache (cache-tail cache) cache))
+ (rm-cache (cache-tail cache) cache))
value))
(defun remove-cached (key cache)
"Remove specified element from cache"
(let ((element (gethash key (cache-hashtable cache))))
(when element
- (rmcache element cache))))
+ (rm-cache element cache)
+ element)))
+
+(defun clear-cache (cache)
+ "Clear all data from cache."
+ (clrhash (cache-hashtable cache))
+ (setf
+ (cache-head cache) nil
+ (cache-tail cache) nil))
+
+(defun map-cache (fn cache)
+ "Iterates over all entries in the cache. For each entry the function
+fn is called with two arguments, the cache key and the cached
+value. The function can change the cached value with setf of get-cache
+or it can remove the cache entry with remove-cached."
+ (maphash #'(lambda (k v)
+ (funcall fn k (cached-value v)))
+ (cache-hashtable cache)))
;;
;; Tests and test helper functions
More information about the clouchdb-cvs
mailing list