;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FILE IDENTIFICATION
;;
-;; Name: main.lisp
-;; Purpose: memstore main functions
+;; Name: memstore.lisp
+;; Purpose: Memstore primary functions
;; Date Started: July 2011
;;
;; Copyright (c) 2011 Kevin M. Rosenberg
"Determines if compression is enabled.")
(defvar *compression-threshold* 5000
"Minimum size of object before attempting compression.")
-(defvar *debug* nil)
-(defvar *realm* "ms:")
-(defvar *encoding* (flex:make-external-format :utf-8))
+(defvar *debug* nil
+ "Controls output of debugging messages.")
+(defvar *namespace* "ms:"
+ "String to prepend to keys for memcache. Default is 'ms:'.")
+(defvar *encoding* (flex:make-external-format :utf-8)
+ "Character encoding to use with converting strings to octets.")
(defun serialize-clstore (obj)
+ "Converts a Lisp object into a vector of octets using CL-STORE."
(let ((s (make-in-memory-output-stream :element-type 'octet)))
(cl-store:store obj s)
(get-output-stream-sequence s)))
(defun deserialize-clstore (data)
+ "Restores a Lisp object from a vector of octets using CL-STORE."
(let ((s (make-in-memory-input-stream data)))
(cl-store:restore s)))
(declare (ignore pos))
obj))
-(defun serialize (obj &key (compression-enabled *compression-enabled*)
+(defun ms-serialize (obj &key (compression-enabled *compression-enabled*)
(compression-threshold *compression-threshold*))
"Converts a lisp object into a vector of octets.
Returns a cons of (flags . data)."
compression-enabled compression-threshold dlen))
(when (and compression-enabled compression-threshold
(> dlen compression-threshold))
- (multiple-value-bind (compressed clen) (zlib:compress data :fixed)
+ (multiple-value-bind (compressed clen) (compress data)
(when *debug*
(format t "clen:~D cmin:~A~%" clen (* dlen (- 1 *compression-savings*))))
(when (< clen (* dlen (- 1 *compression-savings*)))
(format t "flags:~D dlen:~D data:~S~%" flags (length data) data))
(cons flags data)))
-(defun deserialize (ser)
+(defun ms-deserialize (ser)
"Converts a cons of storage flags and vector of octets into a lisp object."
(let ((flags (car ser))
(data (cdr ser)))
(when (plusp (logand flags +flag-zlib+))
- (setq data (zlib:uncompress data)))
+ (setq data (uncompress data)))
(cond
((plusp (logand flags +flag-clstore+))
(deserialize-clstore data))
(defun make-key (key)
- (concatenate 'string *realm* key))
+ "Prepends the *namespace* to a key."
+ (concatenate 'string *namespace* key))
-(defun remove-realm (key)
- (subseq key (length *realm*)))
+(defun remove-namespace (key)
+ "Strips the current *namespace* from beginning of key."
+ (subseq key (length *namespace*)))
-(defun mem-store (key obj &key (memcache *memcache*) (command :set)
+(defun ms-store (key obj &key (memcache *memcache*) (command :set)
(exptime 0) (use-pool *use-pool*)
(compression-enabled *compression-enabled*)
(compression-threshold *compression-threshold*))
"Stores an object in cl-memcached. Tries to print-readably object
to a string for storage. If unable to do so, uses cl-store to serialize
object. Optionally compresses value if meets compression criteria."
- (let ((ser (serialize obj :compression-enabled compression-enabled
+ (let ((ser (ms-serialize obj :compression-enabled compression-enabled
:compression-threshold compression-threshold)))
(mc-store (make-key key) (cdr ser)
:memcache memcache
:use-pool use-pool :flags (car ser))))
(defun get-objects (keys-list &key (memcache *memcache*) (use-pool *use-pool*)
- (command :get))
+ (command :get))
+ "Retrieves a list of objects from memcache from the keys in KEYS-LIST."
(let ((items (mc-get
(mapcar 'make-key keys-list)
:memcache memcache
(data (third item)))
(ecase command
(:get
- (list (remove-realm key) (deserialize (cons flags data))))
+ (list (remove-namespace key) (ms-deserialize (cons flags data))))
(:gets
- (list (remove-realm key) (deserialize (cons flags data)) (fourth item))))))
+ (list (remove-namespace key) (ms-deserialize (cons flags data)) (fourth item))))))
items)))
-(defun mem-restore (key-or-keys &key (memcache *memcache*) (use-pool *use-pool*)
- (command :get))
+(defun ms-restore (key-or-keys &key (memcache *memcache*) (use-pool *use-pool*)
+ (command :get))
+ "Lisp objects are restored by memcache server. A key, or list of keys,
+is used to identify objects. Command is either :get or :gets. The latter
+is used to get memcached's unique object number for storage with :cas."
(let* ((multp (listp key-or-keys))
(keys (if multp key-or-keys (list key-or-keys)))
(items (get-objects keys :memcache memcache :use-pool use-pool
(values (second item) t (third item)))))
(values nil nil)))))
-(defun mem-del (key &key (memcache *memcache*) (use-pool *use-pool*) (time 0))
+(defun ms-del (key &key (memcache *memcache*) (use-pool *use-pool*) (time 0))
+ "Deletes a keyed object from memcache. Key is prepended with *namespace*."
(mc-del (make-key key) :memcache memcache :use-pool use-pool :time time))
-(defun mem-incr (key &key (memcache *memcache*) (use-pool *use-pool*) (delta 1))
+(defun ms-incr (key &key (memcache *memcache*) (use-pool *use-pool*) (delta 1))
+ "Increments a keyed integer object. Key is prepended with *namespace*."
(mc-incr (make-key key) :memcache memcache :use-pool use-pool :delta delta))
-(defun mem-decr (key &key (memcache *memcache*) (use-pool *use-pool*) (delta 1))
+(defun ms-decr (key &key (memcache *memcache*) (use-pool *use-pool*) (delta 1))
+ "Decrements a keyed integer object. Key is prepended with *namespace*."
(mc-decr (make-key key) :memcache memcache :use-pool use-pool :delta delta))
projects / memstore.git / blobdiff