X-Git-Url: http://git.kpe.io/?p=memstore.git;a=blobdiff_plain;f=src%2Fmemstore.lisp;h=2443a2625321914e60e2b010b1aec8e44bd9f0f1;hp=776c83d332aff74bfa17a59a3ceeb062188bd18b;hb=b863ee040d4f399abb087df7304eafb0d5da4d1a;hpb=7dd62ee1de6fc014941ae83d7e09bac2f44b6a5b diff --git a/src/memstore.lisp b/src/memstore.lisp index 776c83d..2443a26 100644 --- a/src/memstore.lisp +++ b/src/memstore.lisp @@ -2,8 +2,8 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; 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 @@ -49,17 +49,22 @@ "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))) @@ -78,7 +83,7 @@ Catches error while using *print-readably*. Returns nil if unable to (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)." @@ -102,7 +107,7 @@ 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*))) @@ -112,12 +117,12 @@ Returns a cons of (flags . data)." (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)) @@ -128,19 +133,21 @@ Returns a cons of (flags . 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 @@ -148,7 +155,8 @@ object. Optionally compresses value if meets compression criteria." :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 @@ -160,13 +168,16 @@ object. Optionally compresses value if meets compression criteria." (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 @@ -182,13 +193,16 @@ object. Optionally compresses value if meets compression criteria." (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))