diff --git a/README.markdown b/README.markdown index a96430d..e2a347a 100644 --- a/README.markdown +++ b/README.markdown @@ -1,12 +1,12 @@ -CL-CACHE +CLACHE ======== -CL-CACHE is a general caching library for Common Lisp. +CLACHE is a general caching library for Common Lisp. Overview -------- -CL-CACHE provides a general caching facility for Common Lisp. The API +CLACHE provides a general caching facility for Common Lisp. The API is similar with standard hash-table interface. Let me show you an overview of API. @@ -17,24 +17,29 @@ overview of API. As you can see, it is easy to use. Here is an example: + ;; Create a store + (defparamater *store* (progn + (ensure-directories-exist #p"cache/") + (make-instance 'file-store :directory #p"cache/"))) + ;; Store cache - (setcache 1 "foo") + (setcache 1 "foo" *store*) ;;=> 1 ;; Get cache - (getcache 1) + (getcache 1 *store*) ;;=> 1, T ;; Get non-exited cache - (getcache 42) + (getcache 42 *store*) ;;=> NIL, NIL ;; Remove cache - (remcache 1) + (remcache 1 *store*) ;;=> T ;; Clear all cache - (clrcache) + (clrcache *store*) API --- @@ -74,7 +79,7 @@ storages via API. ### Function: `getcache` - getcache key &optional storage + getcache key storage Retrieve a cache value from `storage` indicated by `key` and return values of the cache value and a boolean whether the cache exists in @@ -84,7 +89,7 @@ exist. For example, `(getcache "not-existed-cache")` will return `nil`, ### Function: `setcache` - setcache key value &optional expire storage + setcache key value storage &optional expire Store a cache `value` into `storage` with `key` and `expire`. `expire` is an expiration time in seconds. If `expire` is `nil`, the cache will @@ -92,13 +97,13 @@ never be expired. The return value is `value` that has been stored. ### Function: `(setf getcache)` - (setf getcache) value key &optional expire storage + (setf getcache) value key storage &optional expire Same as `setcache`. ### Function: `remcache` - remcache key &optional storage + remcache key storage Remove a cache from `storage` indicated by `key`. If the cache has been successfully removed, this function returns `t`, otherwise @@ -106,7 +111,7 @@ returns `nil`. ### Function: `clrcache` - clrcache &optional storage + clrcache storage Remove all caches from `storage`. The return value is undefined. diff --git a/clache-test.asd b/clache-test.asd index edddfca..222cc24 100644 --- a/clache-test.asd +++ b/clache-test.asd @@ -1,9 +1,9 @@ -(defpackage cl-cache-test-asd +(defpackage clache-test-asd (:use :cl :asdf)) -(in-package :cl-cache-test-asd) +(in-package :clache-test-asd) -(defsystem cl-cache-test - :depends-on (:cl-cache +(defsystem clache-test + :depends-on (:clache :cl-test-more) :components ((:module "tests" :serial t diff --git a/clache.asd b/clache.asd index 2122345..49ab9e1 100644 --- a/clache.asd +++ b/clache.asd @@ -5,8 +5,9 @@ (in-package :clache-asd) (defsystem :clache - :version "0.2" + :version (:read-from-file "version.lisp-expr") :author "Tomohiro Matsuyama" + :maintainer "Olexiy Zamkoviy" :license "LLGPL" :depends-on (:alexandria :trivial-garbage diff --git a/src/api.lisp b/src/api.lisp index 7b1c373..bad0cf5 100644 --- a/src/api.lisp +++ b/src/api.lisp @@ -46,7 +46,7 @@ values of the cache value and a boolean whether the cache exists in STORE. The cache value will be NIL if such the cache doesn't exist. For example, (getcache \"not-existed-cache\") will return NIL, NIL." - @type (store store) + ;@type (store store) (load-cache key store)) @export @@ -54,27 +54,27 @@ NIL." "Store a cache VALUE into STORE with KEY and EXPIRE. EXPIRE is an expiration time in seconds. If EXPIRE is NIL, the cache will never be expired. The return value is VALUE that has been stored." - @type (store store) - @type (expire expire) + ;@type (store store) + ;@type (expire expire) (store-cache key value store expire)) @export (defun (setf getcache) (value key store &key expire) - @type (store store) - @type (expire expire) - (store-cache key value expire store)) + ;@type (store store) + ;@type (expire expire) + (store-cache key value store expire)) @export (defun remcache (key store) "Remove a cache from STORE indicated by KEY. If the cache has been successfully removed, this function returns T, otherwise returns NIL." - @type (store store) + ;@type (store store) (delete-cache key store)) @export (defun clrcache (store) "Remove all caches from STORE. The return value is undefined." - @type (store store) + ;@type (store store) (clear-cache store)) @export @@ -96,16 +96,16 @@ Example: (if ,exists-p ,value (let ((,value (progn ,@body))) - (setcache ,key ,store ,value :expire ,expire) + (setcache ,key ,value ,store :expire ,expire) ,value)))))) @export -(defmacro with-inline-cache ((key &key expire (test #'equal) weakness) &body body) +(defmacro with-inline-cache ((key &key expire (test 'equal) weakness) &body body) "Same as WITH-CACHE, except that an inline memory store will be used as a cache store. TEST is a function to test hash table keys of the memory store. WEAKNESS specifies the hash table is weak-hash-table or not." - (let* ((hash-table-form `(trivial-garbage:make-weak-hash-table :test ,test :weakness ,weakness)) + (let* ((hash-table-form `(trivial-garbage:make-weak-hash-table :test (quote ,test) :weakness ,weakness)) (store-form `(make-instance 'memory-store :hash-table ,hash-table-form))) `(with-cache (,key :store (load-time-value ,store-form) :expire ,expire) ,@body))) diff --git a/src/stores/file.lisp b/src/stores/file.lisp index 1de8713..a00650c 100644 --- a/src/stores/file.lisp +++ b/src/stores/file.lisp @@ -31,7 +31,7 @@ TODO (values value t))) (values nil nil)))) -(defmethod store-cache (key value expire (store file-store)) +(defmethod store-cache (key value (store file-store) expire) (when expire (setf expire (+ (get-universal-time) expire))) (cl-store:store (cons expire value) diff --git a/src/stores/memory.lisp b/src/stores/memory.lisp index 24bd6a6..c29ded1 100644 --- a/src/stores/memory.lisp +++ b/src/stores/memory.lisp @@ -13,6 +13,7 @@ TODO @export (defclass memory-store (store) ((hash-table :initform (make-hash-table :test #'equal) + :initarg :hash-table :reader hash-table-of))) (defmethod load-cache (key (store memory-store)) @@ -26,7 +27,7 @@ TODO (values value t))) (values nil nil)))) -(defmethod store-cache (key value expire (store memory-store)) +(defmethod store-cache (key value (store memory-store) expire) (when expire (setf expire (+ (get-universal-time) expire))) (setf (gethash key (hash-table-of store)) diff --git a/tests/api.lisp b/tests/api.lisp index e698a81..8b5c15c 100644 --- a/tests/api.lisp +++ b/tests/api.lisp @@ -1,157 +1,157 @@ -(in-package :cl-cache-test) +(in-package :clache-test) (defun test-storage-via-api (storage) (format t "Running ~A test suite~%" (type-of storage)) (let ((*default-storage* storage)) ;; Basic tests - (clrcache) + (clrcache storage) - (is (multiple-value-list (getcache "none")) + (is (multiple-value-list (getcache "none" storage)) '(nil nil) "Getting non-existed cache should return nil, nil") - (is (setcache "foo" 1) + (is (setcache "foo" 1 storage) 1 "Setting cache should return its value") - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(1 t) "Getting cache that has been set should return value, t") - (is (setf (getcache "bar") 2) + (is (setf (getcache "bar" storage) 2) 2 "Setting cache by setf should also return its value") - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(2 t) "Getting cache that has been set by setf should also return value, t") - (is (setcache "bar" 3) + (is (setcache "bar" 3 storage) 3 "Overwriting cache should return its value") - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(3 t) "Getting cache that has been overwrote should return value, t") - (is (remcache "none") + (is (remcache "none" storage) nil "Removing non-existed cache should return nil") - (is (remcache "foo") + (is (remcache "foo" storage) t "Removing existed cache should return t") - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(nil nil) "Getting removed cache should return nil, nil") - (clrcache) + (clrcache storage) - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(nil nil) "Getting cleared (removed) cache should return nil, nil") - (is (with-cache ("foo") 1) + (is (with-cache ("foo" :store storage) 1) 1 "with-cache with non-existed cache should evalute its body") - (is (with-cache ("foo") (error "MUST NOT BE ERROR")) + (is (with-cache ("foo" :store storage) (error "MUST NOT BE ERROR")) 1 "with-cache with existed cache shouldn't evalute its body") - (is-error (with-cache ("none") (error "SHOULD BE ERROR")) + (is-error (with-cache ("none" :store storage) (error "SHOULD BE ERROR")) error "with-cache with non-existed cache should evalute its body even if it reports an error") - (is (multiple-value-list (getcache "none")) + (is (multiple-value-list (getcache "none" storage)) '(nil nil) "Getting non-existed cache that hasn't set by with-cache because of evaluation errors should return nil, nil") ;; Expiration tests - (clrcache) + (clrcache storage) - (is (setcache "foo" 1 2) + (is (setcache "foo" 1 storage :expire 2) 1 "Setting cache with expiration time should return its value") (sleep 0.5) - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(1 t) "Getting existed cache that hasn't yet been expired should return value, t") (sleep 2) - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(nil nil) "Getting existed cache that has already been expired should return nil, nil") - (is (setf (getcache "foo" 2) 1) + (is (setf (getcache "foo" storage) 1) 1 "Setting cache by setf with expiration time should return its value") (sleep 0.5) - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(1 t) "Getting existed cache that has been set by setf and hasn't yet been expired should return value, t") (sleep 2) - (is (multiple-value-list (getcache "foo")) + (is (multiple-value-list (getcache "foo" storage)) '(nil nil) "Getting existed cache that has been set by setf and has been expired should return nil, nil") - (setcache "bar" 1) + (setcache "bar" 1 storage) - (is (setcache "bar" 2 2) + (is (setcache "bar" 2 storage :expire 2) 2 "Overwriting never-expire cache with expiration time should return its value") (sleep 0.5) - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(2 t) "Getting existed cache that has been overwrote with expiration time and hasn't yet been expired should return value, t") (sleep 2) - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(nil nil) "Getting existed cache that has been overwrote with expiration time and has been expired should return nil, nil") - (setcache "bar" 2 2) + (setcache "bar" 2 storage :expire 2) - (is (setcache "bar" 3) + (is (setcache "bar" 3 storage) 3 "Overwriting will-expire cache with never-expiration time should return its value") (sleep 3) - (is (multiple-value-list (getcache "bar")) + (is (multiple-value-list (getcache "bar" storage)) '(3 t) "Getting existed cache that has been overwrote with never-expiration time and has been expired should return value, t") - (is (with-cache ("foo" 2) 1) + (is (with-cache ("foo" :expire 2 :store storage) 1) 1 "with-cache with non-existed cache and expiration-time should evalute its body") (sleep 0.5) - (is (with-cache ("foo" 2) (error "MUST NOT BE ERROR")) + (is (with-cache ("foo" :expire 2 :store storage) (error "MUST NOT BE ERROR")) 1 "with-cache with existed cache that hasn't yet been expired doesn't evalute its body should return value") (sleep 2) - (is (with-cache ("foo" 2) 2) + (is (with-cache ("foo" :expire 2 :store storage) 2) 2 "with-cache with existed cache that has been expired evalutes its body should return value") - (is-error (with-cache ("none" 2) (error "SHOULD BE ERROR")) + (is-error (with-cache ("none" :expire 2 :store storage) (error "SHOULD BE ERROR")) error "with-cache with non-existed cache and expiration-time should evalute its body even if it reports an error") @@ -159,13 +159,13 @@ ;; TODO CLOS tests ;; Cleanup - (clrcache))) + (clrcache storage))) (defun test-all-storages-via-api () - (let ((cache-dir #p"/tmp/cl-cache-test/")) + (let ((cache-dir #p"/tmp/clache-test/")) (ensure-directories-exist cache-dir) - (dolist (storage (list (make-instance 'memory-storage) - (make-instance 'file-storage + (dolist (storage (list (make-instance 'memory-store) + (make-instance 'file-store :directory cache-dir))) (test-storage-via-api storage)))) diff --git a/tests/package.lisp b/tests/package.lisp index 44b9fb8..e529988 100644 --- a/tests/package.lisp +++ b/tests/package.lisp @@ -1,7 +1,7 @@ -(defpackage cl-cache-test +(defpackage clache-test (:use :cl :cl-test-more) - (:import-from :cl-cache + (:import-from :clache :symbol-fqn :object-to-string :md5-hex-string @@ -11,5 +11,5 @@ :clrcache :with-cache :cache - :memory-storage - :file-storage)) + :memory-store + :file-store)) diff --git a/tests/utils.lisp b/tests/utils.lisp index f1547c4..f156ad9 100644 --- a/tests/utils.lisp +++ b/tests/utils.lisp @@ -1,11 +1,11 @@ -(in-package :cl-cache-test) +(in-package :clache-test) (is (symbol-fqn 'foo) - "CL-CACHE-TEST:FOO" + "CLACHE-TEST:FOO" "symbol-fqn") (is (object-to-string 'foo) - "CL-CACHE-TEST:FOO" + "CLACHE-TEST:FOO" "object-to-string for symbol") (is (object-to-string 123) diff --git a/version.lisp-expr b/version.lisp-expr new file mode 100644 index 0000000..fd32d72 --- /dev/null +++ b/version.lisp-expr @@ -0,0 +1 @@ +"0.2.1"