cl-memstore-1.1.0/0000755000175000017500000000000011604616523012756 5ustar kevinkevincl-memstore-1.1.0/LICENSE0000644000175000017500000000270211603523513013757 0ustar kevinkevinCopyright (c) 2011 Kevin M. Rosenberg All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of the contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-memstore-1.1.0/memcache.asd0000644000175000017500000000132511603523513015205 0ustar kevinkevin;;; -*- Mode: Common-Lisp -*- ; ;;; Copyright (c) 2005-2006, quasi. All rights reserved. Cleartrip. ;;; Copyright (c) 2011 Kevin Rosenberg. All rights reserved. (in-package #:cl-user) (defpackage #:memcache-system (:use #:cl #:asdf)) (in-package #:memcache-system) (defsystem #:memcache :version "0.5.0" :author "Kevin Rosenberg , quasi " :depends-on (usocket kmrcl) :components ((:module memcache :serial t :components ((:file "package") (:file "specials") (:file "util") (:file "compat") (:file "memcache"))))) cl-memstore-1.1.0/memcache/0000755000175000017500000000000011604541517014520 5ustar kevinkevincl-memstore-1.1.0/memcache/LICENSE0000644000175000017500000000250611603523513015523 0ustar kevinkevinCopyright (c) 2006, Abhijit 'quasi' Rao. All rights reserved. Copyright (c) 2006, Cleartrip Travel Services. Copyright (c) 2011 Kevin Rosenberg Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. cl-memstore-1.1.0/memcache/compat.lisp0000644000175000017500000000264611603523513016677 0ustar kevinkevin(in-package #:memcache) ;;; ;;; queue implementation from http://aima.cs.berkeley.edu/lisp/utilities/queue.lisp ;;; (defstruct q (key #'identity) (last nil) (elements nil)) (defun make-empty-queue () (make-q)) (defun empty-queue? (q) "Are there no elements in the queue?" (= (length (q-elements q)) 0)) (defun queue-front (q) "Return the element at the front of the queue." (elt (q-elements q) 0)) (defun remove-front (q) "Remove the element from the front of the queue and return it." (if (listp (q-elements q)) (pop (q-elements q)) nil)) (defun enqueue-at-end (q items) "Add a list of items to the end of the queue." ;; To make this more efficient, keep a pointer to the last cons in the queue (let ((items (list items))) (cond ((null items) nil) ((or (null (q-last q)) (null (q-elements q))) (setf (q-last q) (last items) (q-elements q) (nconc (q-elements q) items))) (t (setf (cdr (q-last q)) items (q-last q) (last items)))))) ;; the wrappers (defun make-queue () "" #+allegro (make-instance 'mp:queue) #-allegro (make-empty-queue)) (defmacro enqueue (queue what) "" #+allegro `(mp:enqueue ,queue ,what) #-allegro `(enqueue-at-end ,queue ,what)) (defmacro dequeue (queue) "" #+allegro `(mp:dequeue ,queue) #-allegro `(remove-front ,queue)) (defmacro queue-empty-p (queue) "" #+allegro `(mp:queue-empty-p ,queue) #-allegro `(empty-queue? ,queue)) cl-memstore-1.1.0/memcache/doc/0000755000175000017500000000000011603523513015260 5ustar kevinkevincl-memstore-1.1.0/memcache/doc/cl-memcached.html0000644000175000017500000004137311603523513020460 0ustar kevinkevin CL-MEMCACHED

CL-MEMCACHED - Common Lisp interface to the memcached object caching system.


 

Abstract

CL-MEMCACHED is a library to interface with the memcached object caching system.

What is Memcached?? According to the home page :

memcached is a high-performance, distributed memory object caching system, generic in nature, but intended for use in speeding up dynamic web applications by alleviating database load.

Danga Interactive developed memcached to enhance the speed of LiveJournal.com, a site which was already doing 20 million+ dynamic page views per day for 1 million users with a bunch of webservers and a bunch of database servers. memcached dropped the database load to almost nothing, yielding faster page load times for users, better resource utilization, and faster access to the databases on a memcache miss.

CL-MEMCACHED implements most of the memcached protocol. The code has been tested on Allegro CL and does not work on other Lisp's right now. See file compat.lisp to help.

We have used memcached (1.1.2) in production for over 20 months and have found it to give excellent performance and good stability. The CL-MEMCACHED has evolved over this period of time from a hack to it's current state. Our memcached servers have been up for over 60 days at a time having served over a terabyte of data to the network in this period.

Here are some sample performance statistics of CL-MEMCACHED and other memcached clients :
clientlang implementation10,000 writes
1K data (in msec)		10,000 reads
1K data (in msec)		10,000 writes
10K data (in msec)		10,000 reads
10K data (in msec)
cl-memcachedAllegro 8.0 (AMD64)9508302,1301,330
memcached-client-1.2.0ruby 1.8.57278741,1291,296
python-memcached-1.36python 2.5.18929511,0921,259
php-memcached-2.1.2php 4.3.9507513400,000660

The code comes with a BSD-style license so you can basically do with it whatever you want.

Download shortcut: cl-memcached-latest.tar.gz.

 

Lists


The devel mailing list is cl-memcached-devel.
The announce mailing list is cl-memcached-announce.
 

Example Usage

quick start 

CL-USER> (asdf:oos 'asdf:load-op :cl-memcached)

CL-USER> (setf *my-cache* (cl-memcached:mc-make-memcache-instance :ip "127.0.0.1" :name "My test cache"))
#<CL-MEMCACHED:MEMCACHE My test cache on 127.0.0.1:11211 SIZE:64Mb>

CL-USER> (cl-memcached:mc-store "test-key" "This is Test-DATA" :memcache *my-cache* :use-pool t)
"STORED"

CL-USER> (cl-memcached:mc-get+ "test-key" :memcache *my-cache* :use-pool t)
"This is Test-DATA"

CL-USER> (cl-memcached:mc-get '("test-key") :memcache *my-cache* :use-pool t)
(("test-key"
  #(84 104 105 115 32 105 115 32 84 101 115 116 45 68 65 84 65)))

CL-USER> (cl-memcached:mc-get '("test-key") :memcache *my-cache* :use-pool t :is-string t)
(("test-key" "This is Test-DATA"))

CL-USER> (cl-memcached:mc-store "test-key-2" "This is Test-DATA Again" :memcache *my-cache* :use-pool t)
"STORED"

CL-USER> (cl-memcached:mc-get '("test-key" "test-key-2") :memcache *my-cache* :use-pool t :is-string t)
(("test-key" "This is Test-DATA")
 ("test-key-2" "This is Test-DATA Again"))

 

Contents

  1. Download
  2. The CL-MEMCACHED dictionary
    1. *memcache*
    2. *use-pool*
    3. *pool-get-trys?*
    4. mc-decr
    5. mc-del
    6. mc-get
    7. mc-get+
    8. mc-incr
    9. mc-make-memcache-instance
    10. mc-pool-init
    11. mc-server-check
    12. mc-stats
    13. mc-store
    14. memcache
  3. Acknowledgements

 

Download

CL-MEMCACHED together with this documentation can be downloaded from cl-memcached-latest.tar.gz. The current version is 0.4.1. (I will be setting up a SVN repo soon)
 

The CL-MEMCACHED dictionary


[Special variable]
*memcache*


We can set the current memcache instance to this if there is only one in use.


[Special variable]
*use-pool* 


This controls if we use the connection pool by default. One can set it at each call level, but it is also
possible to set this global policy.

Default value for the USE-POOL is nil, which means a new connection is make every request.


[Special variable]
*pool-get-trys?* 


This controls the policy for the fetching connectors from the pool.  There are two approaches :
a) where we throw an error if pool is empty
b) where we sleep an try again to see if one is available.

The default value is nil which is the a) approach.


[Function]
mc-store key data &key memcache command timeout use-pool => result


Stores data in the memcached server. 
key - key by which the data is stored. this is of type SIMPLE-STRING
data - data to be stored into the cache. data is a sequence of type (UNSIGNED-BYTE 8)
length - size of data
memcache - The instance of class memcache which represnts the memcached we want to use.
command - The storage command we want to use.  There are 3 available : set, add & replace.
timeout - The time in seconds when this data expires.  0 is never expire.


[Function]
mc-get keys-list &key memcache use-pool is-string => result


Retrive value for key from memcached server. 
keys-list - is a list of the keys, seperated by whitespace, by which data is stored in memcached
memcache - The instance of class memcache which represnts the memcached we want to use.

Returns a list of lists where each list has two elements key and value
key - is of type SIMPLE-STRING
value is of type (UNSIGNED-BYTE 8)


[Function]
mc-get+ key-or-list-of-keys &key memcache use-pool => result


To be used for non-binary data only. If one key is given returns the response in string format


[Function]
mc-decr key &key memcache value use-pool => result


Implements the DECR command. Decrements the value of a key. Please read memcached documentation for more information


[Function]
mc-del key &key memcache time use-pool => result


Deletes a particular 'key' and it's associated data from the memcached server


[Function]
mc-incr key &key memcache value use-pool => result


Implements the INCR command. Increments the value of a key. Please read memcached documentation for more information


[Function]
mc-make-memcache-instance &key ip port name pool-size => result


Creates an instance of class MEMCACHE which represents a memcached server


[Function]
mc-pool-init &key memcache => result


Cleans up the pool for this particular instance of memcache & reinits it with POOL-SIZE number of objects required by this pool


[Function]
mc-server-check &key memcache => result


Performs some basic tests on the Memcache instance and outputs a status string


[Function]
mc-stats &key memcache use-pool => result


Returns a struct of type memcache-stats which contains internal statistics from the memcached server instance. Please refer to documentation of memcache-stats for detailed information about each slot.


[Structure]
memcache-stats


The structure which holds the statistics from the memcached server. The fields are : 
field-name                 accessor-function                 documentation
----------                 -----------------                 -------------
pid                        mc-stats-pid                      Process id of this server process
uptime                     mc-stats-uptime                   Number of seconds this server has been running
time                       mc-stats-time                     current UNIX time according to the server
version                    mc-stats-version                  Version string of this server
rusage-user                mc-stats-rusage-user              Accumulated user time for this process
rusage-system              mc-stats-rusage-system            Accumulated system time for this process
curr-items                 mc-stats-curr-items               Current number of items stored by the server
total-items                mc-stats-total-items              Total number of items stored by this server ever since it started
bytes                      mc-stats-bytes                    Current number of bytes used by this server to store items
curr-connections           mc-stats-curr-connections         Number of open connections
total-connections          mc-stats-total-connections        Total number of connections opened since the server started running
connection-structures      mc-stats-connection-structures    Number of connection structures allocated by the server
cmd-get                    mc-stats-cmd-get                  Cumulative number of retrieval requests
cmd-set                    mc-stats-cmd-set                  Cumulative number of storage requests
get-hits                   mc-stats-get-hits                 Number of keys that have been requested and found present
get-misses                 mc-stats-get-misses               Number of items that have been requested and not found
evictions                  mc-stats-evictions                Number of items removed from cache because they passed their expiration time
bytes-read                 mc-stats-bytes-read               Total number of bytes read by this server from network
bytes-written              mc-stats-bytes-written            Total number of bytes sent by this server to network
limit-maxbytes             mc-stats-limit-maxbytes           Number of bytes this server is allowed to use for storage.


[Standard class]
memcache


This class represents an instance of the Memcached server 
(defclass memcache ()
  ((name
    :initarg :name
    :reader name
    :type simple-string
    :documentation "Name of this Memcache instance")
   (ip 
    :initarg :ip
    :initform "127.0.0.1"
    :accessor ip
    :type simple-string
    :documentation "The IP address of the Memcached server this instance represents")
   (port 
    :initarg :port
    :initform 11211
    :accessor port
    :type fixnum
    :documentation "The port on which the Memcached server this instance represents runs")
   (memcached-server-storage-size 
    :initform 0
    :reader memcached-server-storage-size
    :type fixnum
    :documentation "Memory allocated to the Memcached Server")
   (pool-size
    :initarg :pool-size
    :initform 2
    :reader pool-size)
   (pool
    :reader pool))
  (:documentation "This class represents an instance of the Memcached server"))

 

Known Issues

The pooling functionality is still experimental. This is mainly because strategies to deal with network errors are not in place.
 

TODO


- Add facility to created a replicated memcached pair.
- Support for a memcached cluster (distributedness)

People

Abhijit 'quasi' Rao

Chaitanya Gupta
 

Acknowledgements

Thanks to Mr. Hrush Bhatt of Cleartrip for allowing us to make this library available under a BSD licence.

This documentation was prepared with the help of DOCUMENTATION-TEMPLATE.

cl-memstore-1.1.0/memcache/util.lisp0000644000175000017500000001367111603523513016371 0ustar kevinkevin(in-package #:memcache) (defun mc-server-check (&key (memcache *memcache*)) "Performs some basic tests on the Memcache instance and outputs a status string" (with-output-to-string (s) (let ((key "MEMCACHESERVERCHECK") (data "IS THE SERVER OK ? PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE PLEASE") (server-response (mc-make-pool-item :memcache memcache))) (if server-response (progn (format s "Checking Memcached Server ~A running on ~A:~A ..." (name memcache) (ip memcache) (port memcache)) (format s "~%Sending data of length ~D with key ~A..." (length data) key) (format s "~%Storage Command Rreturned : ~A" (handler-case (mc-store key data :memcache memcache) (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%")) (error (c) (format t "GET COMMAND ERROR ~A" c)))) (format s "~%Trying to get back stored data with key ~A" key) (format s "~%Retrieve Command Returned : ~a" (when (handler-case (mc-get (list key) :memcache memcache) (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%")) (error (c) (format t "GET COMMAND ERROR ~A" c))) "DATA")) (format s "~%Delete Command Returned : ~A" (handler-case (mc-del key :memcache memcache) (socket-error () (format t "~2%CANNOT CONNECT TO CACHE !~%")) (error (c) (format t "DEL COMMAND ERROR ~A" c)))) (format s "~2%~a" (mc-stats :memcache memcache))) (format s "~2%CANNOT CONNECT TO CACHE SERVER ! ~%"))))) (defun mc-make-benchmark-data (n) (make-array (list n) :initial-element 0)) (defun mc-benchmark (n data-size &key (memcache *memcache*) (use-pool t) (action :write)) (let ((data (make-array (list data-size) :initial-element 0))) (dotimes (i n) (let ((key (concatenate 'simple-string "key_" (princ-to-string i)))) (case action (:write (mc-store key data :memcache memcache :use-pool use-pool :exptime 600)) (:read (mc-get (list key) :memcache memcache :use-pool use-pool))))))) ;; if you have cl-who installed, print a pretty html table for the memcached stats #+cl-who (defun memcached-details-table-helper (&key (memcache *memcache*) (stream *standard-output*)) "" (cl-who:with-html-output-to-string (stream) (:table :border 1 :cellpadding 4 :width "90%" :style "border:solid black 4px;font-family:monospace;font-size:12px" (let ((stats (memcache:mc-stats :memcache memcache :use-pool nil))) (cl-who:htm (:tr (:th :colspan 2 (:h4 (format stream "Name: ~A | Server IP : ~A | Port : ~A" (memcache::name memcache) (memcache::ip memcache) (memcache::port memcache))))) (:tr (:td (format stream "Process ID")) (:td (format stream "~a" (memcache::mc-stats-pid stats)))) (:tr (:td (format stream "Server Uptime")) (:td (format stream "~a" (kmrcl:seconds-to-condensed-time-string (memcache::mc-stats-uptime stats))))) (:tr (:td (format stream "System Time")) (:td (format stream "~a" (memcache::mc-stats-time stats)))) (:tr (:td (format stream "Server Version")) (:td (format stream "~a" (memcache::mc-stats-version stats)))) (:tr (:td (format stream "Accumulated user time")) (:td (format stream "~a" (memcache::mc-stats-rusage-user stats)))) (:tr (:td (format stream "Accumulated system time")) (:td (format stream "~a" (memcache::mc-stats-rusage-system stats)))) (:tr (:td (format stream "Current items stored in server")) (:td (format stream "~a" (memcache::mc-stats-curr-items stats)))) (:tr (:td (format stream "Current items total")) (:td (:b (format stream "~a" (memcache::mc-stats-curr-items-total stats))))) (:tr (:td (format stream "Current bytes used by server to store items")) (:td (format stream "~a MB" (float (/ (memcache::mc-stats-bytes stats) 1048576))))) (:tr (:td (format stream "Number of open connections")) (:td (format stream "~a" (memcache::mc-stats-curr-connections stats)))) (:tr (:td (format stream "Total number of connections opened since server start")) (:td (format stream "~a" (memcache::mc-stats-total-connections stats)))) (:tr (:td (format stream "Number of connection structures allocated by server")) (:td (format stream "~a" (memcache::mc-stats-connection-structures stats)))) (:tr (:td (format stream "Cumulative number of Retrieval requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-get stats))))) (:tr (:td (format stream "Cumulative number of Storage requests")) (:td (:b (format stream "~a" (memcache::mc-stats-cmd-set stats))))) (:tr (:td (format stream "Number of keys that have been requested and found present")) (:td (format stream "~a" (memcache::mc-stats-get-hits stats)))) (:tr (:td (format stream "Number of items that have been requested and not found")) (:td (format stream "~a" (memcache::mc-stats-get-misses stats)))) (:tr (:td (format stream "Total number of bytes read by server from network")) (:td (format stream "~a MB" (float (/ (memcache::mc-stats-bytes-read stats) 1048576))))) (:tr (:td (format stream "Total number of bytes sent by this server to network")) (:td (format stream "~a MB" (float (/ (memcache::mc-stats-bytes-written stats) 1048576))))) (:tr (:td (format stream "Number of bytes this server is allowed to use for storage")) (:td (format stream "~f MB" (float (/ (memcache::mc-stats-limit-maxbytes stats) 1048576)))))))))) (defun read-crlf-line (s) "Reads a line from socket s. For platform independence, use read-bytes to avoid differences in line endings across platforms." (with-output-to-string (str) (do* ((byte (read-byte s nil nil) (read-byte s nil nil)) (cr nil)) ((or (null byte) (eql byte 10)) (when (and (eql byte 10) (not cr)) (error "Newline with Return character."))) (cond ((eql byte 13) (setq cr t)) (t (write-char (code-char byte) str)))))) cl-memstore-1.1.0/memcache/README.md0000644000175000017500000000444111604541517016002 0ustar kevinkevinMemcache ======== _Library for memcached protocol_ Author: Kevin Rosenberg , based on the `cl-memcached` library by Abhijit 'quasi' Rao and Chaitanya Gupta . Date Started: July 1, 2011 Overview -------- This package is based on the `cl-memcached` library. It is substantially modified for use with the [memstore](http://memstore.b9.com) library. The primary areas of additional functionality are: * Support for flags field with get and set functions. This is required as memstore stores bit flags denoting how the data is serialized. That information is required to deserialize the data. * Support for additional memcached functionality, such as the gets command for retrieving CAS identifiers. The CAS unique ID is used for the added `:cas` storage command. Other storage commands newly supported are `:append` and `:prepend`. * All communication now uses `mc-send-command` function with transparently supports writing strings with `write-byte`. This allows `usocket` to be used on other Lisp implementations besides AllegroCL. Because cl-memcached used `write-string` with usocket-stream, only AllegroCL was supported. By sending all data as (unsigned-byte 8), all Lisp implementions supported by `usocket` are now supported with `memcached`. * Encapsulated reading and writing to socket stream to avoid handling \\#return characters in high-level code. * Changes to support the change in statistics fields with membase. Some fields were no longer present. Also, membase 1.7 has 187 statistics fields versus the 20 fields supported in `cl-memcached`. New function `mc-get-stat` allows to retrieving any statistics field by name. * More robust `print-object` functions to avoid errors if fields in statistics are not present. * Removed compatibility functions in `compat.lisp` by using the [`kmrcl`](http://gitpub.b9.com/kmrcl.git) library to provide those functions as well as utilitizing other `kmrcl` functions to simplify code. * Added functions to support all memcached API commands, such as `flush_all` and `version`. * Support for the `moreply` command argument accepted by many commands. * Support the `noreply` argument that many API commands accept. * Write nearly the entire code base for improved clarity, robustness, and efficiency. cl-memstore-1.1.0/memcache/memcache.lisp0000644000175000017500000004446511604616232017165 0ustar kevinkevin;;; -*- Mode: Common-Lisp -*- ;;; Copyright (c) 2006, Abhijit 'quasi' Rao. All rights reserved. ;;; Copyright (c) 2006, Cleartrip Travel Services. ;;; Copyright (c) 2011 Kevin Rosenberg ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package #:memcache) (defmethod print-object ((mc memcache) stream) (print-unreadable-object (mc stream :type t :identity t) (format stream "~A on ~A:~A ~AMB" (when (slot-boundp mc 'name) (name mc)) (when (slot-boundp mc 'host) (host mc)) (when (slot-boundp mc 'port) (port mc)) (when (and (slot-boundp mc 'memcached-server-storage-size) (numberp (slot-value mc 'memcached-server-storage-size))) (/ (memcached-server-storage-size mc) 1024 1024))))) (defmethod initialize-instance :after ((memcache memcache) &rest initargs) (declare (ignore initargs)) (setf (slot-value memcache 'pool) (make-instance 'memcache-connection-pool :name (concatenate 'simple-string (name memcache) " - Connection Pool") :max-capacity (pool-size memcache))) (handler-case (mc-pool-init :memcache memcache) (error () nil)) (let ((stats (handler-case (mc-stats :memcache memcache) (error () nil)))) (if stats (setf (slot-value memcache 'memcached-server-storage-size) (mc-stats-limit-maxbytes stats)) (setf (slot-value memcache 'memcached-server-storage-size) -1)))) (defun make-memcache-instance (&key (host "127.0.0.1") (port 11211) (name "Memcache") (pool-size 5)) "Creates an instance of class MEMCACHE which represents a memcached server." (make-instance 'memcache :name name :host host :port port :pool-size pool-size)) (defmacro with-pool-maybe ((stream memcache use-pool) &body body) "Macro to wrap the use-pool/dont-use-pool stuff and the cleanup around a body of actual action statements" (let ((mc (gensym "MEMCACHE-")) (up (gensym "USE-POOL-")) (us (gensym "USOCKET-"))) `(let* ((,mc ,memcache) (,up ,use-pool) (,us (if ,up (if *pool-get-trys?* (mc-get-from-pool-with-try :memcache ,mc) (mc-get-from-pool :memcache ,mc)) (mc-make-pool-item :memcache ,mc)))) (unwind-protect (when ,us (let ((,stream (usocket:socket-stream ,us))) (handler-case (progn ,@body) (error (c) (when ,up (mc-chuck-from-pool ,us ,mc)) (error c))))) (if ,up (mc-put-in-pool ,us :memcache ,mc) (ignore-errors (usocket:socket-close ,mc))))))) (defun write-string-bytes (string stream) (loop for char across string do (write-byte (char-code char) stream))) (defun send-mc-command (s &rest args &aux started) (dolist (arg args) (unless (null arg) (if started (write-byte (char-code #\space) s) (setq started t)) (typecase arg #+nil (keyword (if (eq :no-reply arg) (write-string-bytes "noreply" s) (write-string-bytes (string-downcase (symbol-name arg)) s))) (string (write-string-bytes arg s)) (character (write-byte (char-code arg) s)) (t (write-string-bytes (princ-to-string arg) s))))) (write-string-bytes +crlf+ s) (force-output s)) ;;; ;;; ;;; Memcached API functionality ;;; ;;; (defun mc-store (key data &key (memcache *memcache*) ((:command command) :set) ((:exptime exptime) 0) ((:use-pool use-pool) *use-pool*) (cas-unique) (flags 0) no-reply) "Stores data in the memcached server using the :command command. key => key by which the data is stored. this is of type SIMPLE-STRING data => data to be stored into the cache. data is a sequence of type (UNSIGNED-BYTE 8) length => size of data memcache => The instance of class memcache which represnts the memcached we want to use. command => The storage command we want to use. There are 3 available : set, add & replace. exptime => The time in seconds when this data expires. 0 is never expire." (declare (type fixnum exptime) (type simple-string key)) (when (and (eq command :cas) (not (integerp cas-unique))) (error "CAS command, but CAS-UNIQUE not set.")) (let ((len (length data))) (with-pool-maybe (s memcache use-pool) (send-mc-command s (ecase command (:set "set") (:add "add") (:replace "replace") (:append "append") (:prepend "prepend") (:cas "cas")) key flags exptime len (when (eq command :cas) cas-unique) (when no-reply "noreply")) (write-sequence data s) (send-mc-command s) (if no-reply (values) (read-crlf-line s))))) (defun mc-get (key-or-keys &key (memcache *memcache*) (use-pool *use-pool*) (command :get)) "Retrive value for key from memcached server. keys-list => is a list of the keys, seperated by whitespace, by which data is stored in memcached memcache => The instance of class memcache which represnts the memcached we want to use. Returns a list of lists where each list has three elements key, flags, and value key is of type SIMPLE-STRING value is of type (UNSIGNED-BYTE 8)" (let* ((multp (listp key-or-keys)) (keys-list (if multp key-or-keys (list key-or-keys))) (res (with-pool-maybe (s memcache use-pool) (apply 'send-mc-command s (ecase command (:get "get") (:gets "gets")) keys-list) (loop for x = (read-crlf-line s) until (string-equal x "END") collect (let* ((status-line (delimited-string-to-list x)) (flags (parse-integer (third status-line))) (len (parse-integer (fourth status-line))) (cas-unique (when (eq command :gets) (parse-integer (fifth status-line)))) (seq (make-sequence '(vector (unsigned-byte 8)) len))) (read-sequence seq s) (read-crlf-line s) (if (eq command :gets) (list (second status-line) flags seq cas-unique) (list (second status-line) flags seq))))))) (if multp res (car res)))) (defun mc-del (key &key (memcache *memcache*) ((:time time) 0) (use-pool *use-pool*) (no-reply)) "Deletes a particular 'key' and it's associated data from the memcached server" (declare (type fixnum time)) (with-pool-maybe (s memcache use-pool) (send-mc-command s "delete" key time (when no-reply "noreply")) (if no-reply (values) (read-crlf-line s)))) (defun incr-or-decr (cmd key delta memcache use-pool no-reply) (declare (type fixnum delta)) (let* ((res (with-pool-maybe (s memcache use-pool) (send-mc-command s cmd key delta (if no-reply "noreply")) (if no-reply (values) (read-crlf-line s)))) (int (unless no-reply (ignore-errors (parse-integer res))))) (or int res))) (defun mc-version (&key (memcache *memcache*) (use-pool *use-pool*)) (let* ((raw (with-pool-maybe (s memcache use-pool) (send-mc-command s "version") (read-crlf-line s))) (split (delimited-string-to-list raw))) (when (string-equal (first split) "VERSION") (second split)))) (defun mc-verbosity (v &key (memcache *memcache*) (use-pool *use-pool*) (no-reply)) (declare (type integer v)) (let ((res (with-pool-maybe (s memcache use-pool) (send-mc-command s "verbosity" v (when no-reply "noreply")) (if no-reply (values) (read-crlf-line s))))) res)) (defun mc-flush-all (&key (time nil) (memcache *memcache*) (use-pool *use-pool*) (no-reply)) (declare (type (or null integer) time)) (let ((res (with-pool-maybe (s memcache use-pool) (if time (send-mc-command s "flush_all" time (when no-reply "noreply")) (send-mc-command s "flush_all" (when no-reply "noreply"))) (if no-reply (values) (read-crlf-line s))))) res)) (defun mc-incr (key &key (memcache *memcache*) (delta 1) (use-pool *use-pool*) (no-reply)) "Implements the INCR command. Increments the value of a key. Please read memcached documentation for more information. key is a string delta is an integer" (incr-or-decr "incr" key delta memcache use-pool no-reply)) (defun mc-decr (key &key (memcache *memcache*) (delta 1) (use-pool *use-pool*) (no-reply)) "Implements the DECR command. Decrements the value of a key. Please read memcached documentation for more information." (incr-or-decr "decr" key delta memcache use-pool no-reply)) (defun mc-stats-raw (&key (memcache *memcache*) (use-pool *use-pool*) args &aux results) "Returns Raw stats data from memcached server to be used by the mc-stats function" (with-pool-maybe (s memcache use-pool) (send-mc-command s "stats" args) (with-output-to-string (str) (loop for line = (read-crlf-line s) do (push line results) until (or (string-equal "END" line) (string-equal "ERROR" line))))) (nreverse results)) (defun mc-get-stat (key stats) (when (stringp key) (setq key (ensure-keyword key))) (get-alist key (mc-stats-all-stats stats))) ;;; Collects statistics from the memcached server (defun mc-stats (&key (memcache *memcache*) (use-pool *use-pool*)) "Returns a struct of type memcache-stats which contains internal statistics from the memcached server instance. Please refer to documentation of memcache-stats for detailed information about each slot" (let* ((result (mc-stats-raw :memcache memcache :use-pool use-pool)) (split (loop with xx = nil for x in result do (setf xx (delimited-string-to-list x)) when (and (string= (first xx) "STAT") (second xx)) collect (cons (second xx) (third xx)))) (all-stats (sort split (lambda (a b) (string-greaterp (car a) (car b))))) (results)) (dolist (r all-stats) (push (cons (ensure-keyword (car r)) (let* ((val (cdr r)) (int (ignore-errors (parse-integer val))) (float (unless int (ignore-errors (parse-float val))))) (cond ((integerp int) int) ((numberp float) float) (t val)))) results)) (make-memcache-stats :all-stats results :pid (get-alist :pid results) :uptime (get-alist :uptime results) :time (get-alist :time results) :version (get-alist :version results) :rusage-user (get-alist :rusage_user results) :rusage-system (get-alist :rusage_system results) :curr-items (get-alist :curr_items results) :curr-items-total (get-alist :curr_items_tot results) :curr-connections (get-alist :curr_connections results) :total-connections (get-alist :total_connections results) :connection-structures (get-alist :connection_structures results) :cmd-get (get-alist :cmd_get results) :cmd-set (get-alist :cmd_set results) :get-hits (get-alist :get_hits results) :get-misses (get-alist :get_misses results) :bytes-read (get-alist :bytes_read results) :bytes-written (get-alist :bytes_written results) :limit-maxbytes (get-alist :limit_maxbytes results) ))) ;;; Error Conditions (define-condition memcached-server-unreachable (error) ((error :initarg :error))) (define-condition memcache-pool-empty (error) ()) (define-condition cannot-make-pool-object (error) ((error :initarg :error))) (define-condition bad-pool-object (error) ()) ;;; ;;; ;;; Memcached Pooled Access ;;; ;;; (defclass memcache-connection-pool () ((name :initarg :name :reader name :initform "Connection Pool" :type simple-string :documentation "Name of this pool") (pool :initform (make-queue) :accessor pool) (pool-lock :reader pool-lock :initform (make-lock "Memcache Connection Pool Lock")) (max-capacity :initarg :max-capacity :reader max-capacity :initform 2 :type fixnum :documentation "Total capacity of the pool to hold pool objects") (current-size :accessor current-size :initform 0) (currently-in-use :accessor currently-in-use :initform 0 :type fixnum :documentation "Pool objects currently in Use") (total-uses :accessor total-uses :initform 0 :documentation "Total uses of the pool") (total-created :accessor total-created :initform 0 :type fixnum :documentation "Total pool objects created") (pool-grow-requests :initform 0 :accessor pool-grow-requests :type fixnum :documentation "Pool Grow Request pending Action") (pool-grow-lock :initform (make-lock "Pool Grow Lock") :reader pool-grow-lock)) (:documentation "A memcached connection pool object")) (defmethod print-object ((mcp memcache-connection-pool) stream) (print-unreadable-object (mcp stream :type t :identity t) (format stream "Capacity:~d, Currently in use:~d" (when (slot-boundp mcp 'max-capacity) (max-capacity mcp)) (when (slot-boundp mcp 'currently-in-use) (currently-in-use mcp))))) (defun mc-put-in-pool (conn &key (memcache *memcache*)) (with-lock-held ((pool-lock (pool memcache))) (enqueue (pool (pool memcache)) conn) (decf (currently-in-use (pool memcache))))) (defun mc-get-from-pool (&key (memcache *memcache*)) "Returns a pool object from pool." (let (pool-object (state t)) (with-lock-held ((pool-lock (pool memcache))) (if (queue-empty-p (pool (pool memcache))) (setf state nil) (progn (incf (currently-in-use (pool memcache))) (incf (total-uses (pool memcache))) (setf pool-object (dequeue (pool (pool memcache))))))) (if state pool-object (error 'memcache-pool-empty)))) (defun mc-get-from-pool-with-try (&key (memcache *memcache*) (tries 5) (try-interval 1)) "" (let ((tr 1)) (loop (progn (when (> tr tries) (return nil)) (let ((conn (handler-case (mc-get-from-pool :memcache memcache) (memcache-pool-empty () nil)))) (if (not conn) (progn (incf tr) (warn "memcache ~a : Connection Pool Empty! I will try again after ~d secs." (name memcache) try-interval) (process-sleep try-interval)) (return conn))))))) (defun mc-pool-init (&key (memcache *memcache*)) "Cleans up the pool for this particular instance of memcache & reinits it with POOL-SIZE number of objects required by this pool" (mc-pool-cleanup memcache) (dotimes (i (pool-size memcache)) (mc-pool-grow-request memcache)) (mc-pool-grow memcache)) (defun mc-make-pool-item (&key (memcache *memcache*)) (handler-case (usocket:socket-connect (host memcache) (port memcache) :element-type '(unsigned-byte 8)) (usocket:socket-error (e) (error 'memcached-server-unreachable :error e)) (error (e) (error 'cannot-make-pool-object :error e)))) (defun mc-pool-grow (memcache) (let (grow-count pool-item-list) (with-lock-held ((pool-grow-lock (pool memcache))) (setf grow-count (pool-grow-requests (pool memcache))) (setf pool-item-list (remove nil (loop for x from 1 to grow-count collect (mc-make-pool-item :memcache memcache)))) (loop for x from 1 to (length pool-item-list) do (with-lock-held ((pool-lock (pool memcache))) (enqueue (pool (pool memcache)) (pop pool-item-list)) (incf (total-created (pool memcache))) (incf (current-size (pool memcache)))) do (decf (pool-grow-requests (pool memcache))))))) (defun mc-destroy-pool-item (pool-item) (ignore-errors (usocket:socket-close pool-item))) (defun mc-pool-grow-request (memcache) (with-lock-held ((pool-grow-lock (pool memcache))) (if (> (max-capacity (pool memcache)) (+ (current-size (pool memcache)) (pool-grow-requests (pool memcache)))) (incf (pool-grow-requests (pool memcache))) (warn "memcache: Pool is at capacity.")))) (defun mc-chuck-from-pool (object memcache) (mc-destroy-pool-item object) (with-lock-held ((pool-lock (pool memcache))) (decf (current-size (pool memcache)))) #|(loop while (mc-pool-grow-request memcache)) (mc-pool-grow memcache)|# (mc-pool-init :memcache memcache)) (defun mc-pool-cleanup (memcache) (with-lock-held ((pool-lock (pool memcache))) (with-lock-held ((pool-grow-lock (pool memcache))) (loop when (queue-empty-p (pool (pool memcache))) do (return) else do (mc-destroy-pool-item (dequeue (pool (pool memcache))))) (setf (current-size (pool memcache)) 0 (currently-in-use (pool memcache)) 0 (pool-grow-requests (pool memcache)) 0 (total-created (pool memcache)) 0 (total-uses (pool memcache)) 0)))) cl-memstore-1.1.0/memcache/package.lisp0000644000175000017500000000404511604541517017007 0ustar kevinkevin;;; -*- Mode: Common-Lisp -*- ;;; Copyright (c) 2005-2006, quasi. All rights reserved. ;;; Copyright (c) 2011 Kevin Rosenberg ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package #:cl-user) (defpackage #:memcache (:use #:cl) (:nicknames #:mc) (:shadowing-import-from #:kmrcl #:get-alist #:defconstant* #:delimited-string-to-list #:ensure-keyword #:parse-float #:make-lock #:with-lock-held #:process-sleep) (:export #:*memcache* #:memcache #:mc-store #:mc-get #:mc-del #:mc-incr #:mc-decr #:mc-stats #:mc-get-stat #:mc-version #:mc-verbosity #:mc-flush-all #:memcache-stats #:make-memcache-instance #:mc-server-check #:mc-pool-init #:*use-pool*)) cl-memstore-1.1.0/memcache/specials.lisp0000644000175000017500000002275511604616242017225 0ustar kevinkevin;;; -*- Mode: Common-Lisp -*- ;;; Copyright (c) 2006, Abhijit 'quasi' Rao. All rights reserved. ;;; Copyright (c) 2006, Cleartrip Travel Services. ;;; Copyright (c) 2011 Kevin Rosenberg ;;; Redistribution and use in source and binary forms, with or without ;;; modification, are permitted provided that the following conditions ;;; are met: ;;; * Redistributions of source code must retain the above copyright ;;; notice, this list of conditions and the following disclaimer. ;;; * Redistributions in binary form must reproduce the above ;;; copyright notice, this list of conditions and the following ;;; disclaimer in the documentation and/or other materials ;;; provided with the distribution. ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. (in-package #:memcache) (defvar *memcache* nil "Represents a particular Memcached server") (defvar *use-pool* nil "Default value for the USE-POOL keyword parameter in memcached functions") (defvar *pool-get-trys?* nil "If true then it will try to wait and sleep for a while if pool item in unavailable, if nil then will return immideatly") (defconstant* +crlf+ (concatenate 'string (string (code-char 13)) (string (code-char 10)))) (defconstant* +mc-END-ret+ (concatenate 'string (string "END") (string #\return))) (defstruct (memcache-stats (:conc-name mc-stats-) (:print-function (lambda (struct stream depth) (declare (ignore depth)) (print-unreadable-object (struct stream :type t :identity t) (format stream "pid:~A size:~d MB curr:~d total:~D" (mc-stats-pid struct) (/ (mc-stats-limit-maxbytes struct) 1024 1024) (mc-stats-curr-items struct) (mc-stats-curr-items-total struct)))))) "The structure which holds the statistics from the memcached server. The fields are : field-name accessor-function documentation ---------- ----------------- ------------- pid mc-stats-pid Process id of this server process uptime mc-stats-uptime Number of seconds this server has been running time mc-stats-time current UNIX time according to the server version mc-stats-version Version string of this server rusage-user mc-stats-rusage-user Accumulated user time for this process rusage-system mc-stats-rusage-system Accumulated system time for this process curr-items mc-stats-curr-items Current number of items stored by the server curr-items-total mc-stats-curr-items-total curr-connections mc-stats-curr-connections Number of open connections total-connections mc-stats-total-connections Total number of connections opened since the server started running connection-structures mc-stats-connection-structures Number of connection structures allocated by the server cmd-get mc-stats-cmd-get Cumulative number of retrieval requests cmd-set mc-stats-cmd-set Cumulative number of storage requests get-hits mc-stats-get-hits Number of keys that have been requested and found present get-misses mc-stats-get-misses Number of items that have been requested and not found bytes-read mc-stats-bytes-read Total number of bytes read by this server from network bytes-written mc-stats-bytes-written Total number of bytes sent by this server to network limit-maxbytes mc-stats-limit-maxbytes Number of bytes this server is allowed to use for storage. " all-stats pid uptime time version rusage-user rusage-system curr-items curr-items-total curr-connections total-connections connection-structures cmd-get cmd-set get-hits get-misses bytes-read bytes-written limit-maxbytes) ;;; ;;; The main class which represents the memcached server ;;; (defclass memcache () ((name :initarg :name :reader name :type simple-string :documentation "Name of this Memcache instance") (host :initarg :host :initform "127.0.0.1" :accessor host :type simple-string :documentation "The host name of the Memcached server for this instance.") (port :initarg :port :initform 11211 :accessor port :type fixnum :documentation "The port on which the Memcached server this instance represents runs") (memcached-server-storage-size :initform 0 :reader memcached-server-storage-size :type fixnum :documentation "Memory allocated to the Memcached Server") (pool-size :initarg :pool-size :initform 2 :reader pool-size) (pool :reader pool)) (:documentation "This class represents an instance of the Memcached server")) (defconstant* +membase17-stat-names+ '("accepting_conns" "auth_cmds" "auth_errors" "bucket_active_conns" "bucket_conns" "bytes_read" "bytes_written" "cas_badval" "cas_hits" "cas_misses" "cmd_flush" "cmd_get" "cmd_set" "conn_yields" "connection_structures" "curr_connections" "curr_items" "curr_items_tot" "daemon_connections" "decr_hits" "decr_misses" "delete_hits" "delete_misses" "ep_bg_fetched" "ep_commit_num" "ep_commit_time" "ep_commit_time_total" "ep_data_age" "ep_data_age_highwat" "ep_db_cleaner_status" "ep_db_strategy" "ep_dbinit" "ep_dbname" "ep_dbshards" "ep_diskqueue_drain" "ep_diskqueue_fill" "ep_diskqueue_items" "ep_diskqueue_memory" "ep_diskqueue_pending" "ep_expired" "ep_flush_all" "ep_flush_duration" "ep_flush_duration_highwat" "ep_flush_duration_total" "ep_flush_preempts" "ep_flusher_state" "ep_flusher_todo" "ep_io_num_read" "ep_io_num_write" "ep_io_read_bytes" "ep_io_write_bytes" "ep_item_begin_failed" "ep_item_commit_failed" "ep_item_flush_expired" "ep_item_flush_failed" "ep_items_rm_from_checkpoints" "ep_kv_size" "ep_latency_arith_cmd" "ep_latency_get_cmd" "ep_latency_store_cmd" "ep_max_data_size" "ep_max_txn_size" "ep_mem_high_wat" "ep_mem_low_wat" "ep_min_data_age" "ep_num_active_non_resident" "ep_num_checkpoint_remover_runs" "ep_num_eject_failures" "ep_num_eject_replicas" "ep_num_expiry_pager_runs" "ep_num_non_resident" "ep_num_not_my_vbuckets" "ep_num_pager_runs" "ep_num_value_ejects" "ep_onlineupdate" "ep_onlineupdate_revert_add" "ep_onlineupdate_revert_delete" "ep_onlineupdate_revert_update" "ep_oom_errors" "ep_overhead" "ep_pending_ops" "ep_pending_ops_max" "ep_pending_ops_max_duration" "ep_pending_ops_total" "ep_queue_age_cap" "ep_queue_size" "ep_storage_age" "ep_storage_age_highwat" "ep_storage_type" "ep_store_max_concurrency" "ep_store_max_readers" "ep_store_max_readwrite" "ep_tap_bg_fetch_requeued" "ep_tap_bg_fetched" "ep_tap_keepalive" "ep_tmp_oom_errors" "ep_too_old" "ep_too_young" "ep_total_cache_size" "ep_total_del_items" "ep_total_enqueued" "ep_total_new_items" "ep_total_persisted" "ep_uncommitted_items" "ep_vb_total" "ep_vbucket_del" "ep_vbucket_del_fail" "ep_version" "ep_warmed_up" "ep_warmup" "ep_warmup_dups" "ep_warmup_oom" "ep_warmup_thread" "ep_warmup_time" "get_hits" "get_misses" "incr_hits" "incr_misses" "libevent" "limit_maxbytes" "listen_disabled_num" "mem_used" "pid" "pointer_size" "rejected_conns" "rusage_system" "rusage_user" "threads" "time" "total_connections" "uptime" "vb_active_curr_items" "vb_active_eject" "vb_active_ht_memory" "vb_active_itm_memory" "vb_active_num" "vb_active_num_non_resident" "vb_active_ops_create" "vb_active_ops_delete" "vb_active_ops_reject" "vb_active_ops_update" "vb_active_perc_mem_resident" "vb_active_queue_age" "vb_active_queue_drain" "vb_active_queue_fill" "vb_active_queue_memory" "vb_active_queue_pending" "vb_active_queue_size" "vb_dead_num" "vb_pending_curr_items" "vb_pending_eject" "vb_pending_ht_memory" "vb_pending_itm_memory" "vb_pending_num" "vb_pending_num_non_resident" "vb_pending_ops_create" "vb_pending_ops_delete" "vb_pending_ops_reject" "vb_pending_ops_update" "vb_pending_perc_mem_resident" "vb_pending_queue_age" "vb_pending_queue_drain" "vb_pending_queue_fill" "vb_pending_queue_memory" "vb_pending_queue_pending" "vb_pending_queue_size" "vb_replica_curr_items" "vb_replica_eject" "vb_replica_ht_memory" "vb_replica_itm_memory" "vb_replica_num" "vb_replica_num_non_resident" "vb_replica_ops_create" "vb_replica_ops_delete" "vb_replica_ops_reject" "vb_replica_ops_update" "vb_replica_perc_mem_resident" "vb_replica_queue_age" "vb_replica_queue_drain" "vb_replica_queue_fill" "vb_replica_queue_memory" "vb_replica_queue_pending" "vb_replica_queue_size" "version")) cl-memstore-1.1.0/memstore-tests.asd0000644000175000017500000000242011603523513016433 0ustar kevinkevin;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; File: memstore-tests.asd ;;;; Author: Kevin Rosenberg ;;;; Created: March 2011 ;;;; ;;;; This file is part of the Memstore package. ;;;; ************************************************************************* (in-package #:cl-user) (defpackage #:memstore-tests-system (:use #:asdf #:cl)) (in-package #:memstore-tests-system) (defsystem memstore-tests :name "Memstore tests" :author "Kevin Rosenberg" :licence "BSD" :description "A regression test suite for memstore." :depends-on (memstore rt) :components ((:module src :components ((:file "tests"))))) (defmethod operation-done-p ((o test-op) (c (eql (find-system :memstore-tests)))) ;; Always returns NIL so that tests are never marked as done. nil) (defmethod perform ((o test-op) (c (eql (find-system :memstore-tests)))) (flet ((run-tests (&rest args) (apply (intern (string '#:run-tests) (find-package '#:memstore-tests)) args))) (load-system c) (run-tests :compiled nil) (run-tests :compiled t))) cl-memstore-1.1.0/src/0000755000175000017500000000000011604616267013552 5ustar kevinkevincl-memstore-1.1.0/src/memstore.lisp0000644000175000017500000002140611604541517016274 0ustar kevinkevin;; -*- Mode: Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE IDENTIFICATION ;; ;; Name: memstore.lisp ;; Purpose: Memstore primary functions ;; Date Started: July 2011 ;; ;; Copyright (c) 2011 Kevin M. Rosenberg ;; All rights reserved. ;; ;; Redistribution and use in source and binary forms, with or without ;; modification, are permitted provided that the following conditions ;; are met: ;; 1. Redistributions of source code must retain the above copyright ;; notice, this list of conditions and the following disclaimer. ;; 2. Redistributions in binary form must reproduce the above copyright ;; notice, this list of conditions and the following disclaimer in the ;; documentation and/or other materials provided with the distribution. ;; 3. Neither the name of the author nor the names of the contributors ;; may be used to endorse or promote products derived from this software ;; without specific prior written permission. ;; ;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS AND CONTRIBUTORS ``AS IS'' AND ;; ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE ;; IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL ;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS ;; OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) ;; HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT ;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY ;; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF ;; SUCH DAMAGE. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package #:memstore) (defconstant +flag-wstring+ (ash 1 0) "Bit set if stored with write-to-string.") (defconstant +flag-clstore+ (ash 1 1) "Bit set if stored with cl-store.") (defconstant +flag-zlib+ (ash 1 2) "Bit set if data compressed with zlib.") (defvar *compression-savings* 0.20 "Compression required before saving compressed value.") (defvar *compression-enabled* t "Determines if compression is enabled.") (defvar *compression-threshold* 5000 "Minimum size of object before attempting compression.") (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))) (defun serialize-string (obj) "Tries to write object to string, then convert to vector of octets Catches error while using *print-readably*. Returns nil if unable to write to string." (let* ((*print-readably* t) (str (ignore-errors (write-to-string obj)))) (when (stringp str) (flex:string-to-octets str :external-format *encoding*)))) (defun deserialize-string (str) (multiple-value-bind (obj pos) (read-from-string (flex:octets-to-string str :external-format *encoding*)) (declare (ignore pos)) obj)) (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)." (let* ((flags 0) (data (cond ((stringp obj) (flex:string-to-octets obj :external-format :utf8)) (t (let ((ser (serialize-string obj))) (etypecase ser (vector (setq flags (logior flags +flag-wstring+)) ser) (null (setq flags (logior flags +flag-clstore+)) (serialize-clstore obj))))))) (dlen (length data))) (when *debug* (format t "Compression enabled:~A compression-threshold:~A dlen:~D~%" compression-enabled compression-threshold dlen)) (when (and compression-enabled compression-threshold (> dlen compression-threshold)) (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*))) (setq data compressed) (setq flags (logior flags +flag-zlib+))))) (when *debug* (format t "flags:~D dlen:~D data:~S~%" flags (length data) data)) (cons flags data))) (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 (uncompress data))) (cond ((plusp (logand flags +flag-clstore+)) (deserialize-clstore data)) ((plusp (logand flags +flag-wstring+)) (deserialize-string data)) (t (flex:octets-to-string data :external-format :utf8))))) (defun make-key (key) "Prepends the *namespace* to a key." (concatenate 'string *namespace* key)) (defun remove-namespace (key) "Strips the current *namespace* from beginning of key." (subseq key (length *namespace*))) (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 (ms-serialize obj :compression-enabled compression-enabled :compression-threshold compression-threshold))) (mc-store (make-key key) (cdr ser) :memcache memcache :command command :exptime exptime :use-pool use-pool :flags (car ser)))) (defun get-objects (keys-list &key (memcache *memcache*) (use-pool *use-pool*) (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 :use-pool use-pool :command command))) (mapcar (lambda (item) (let ((key (first item)) (flags (second item)) (data (third item))) (ecase command (:get (list (remove-namespace key) (ms-deserialize (cons flags data)))) (:gets (list (remove-namespace key) (ms-deserialize (cons flags data)) (fourth item)))))) items))) (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 :command command))) (if multp items (if items (let ((item (car items))) (ecase command (:get (values (second item) t)) (:gets (values (second item) t (third item))))) (values nil nil))))) (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 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 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)) cl-memstore-1.1.0/src/package.lisp0000644000175000017500000000173711604541517016041 0ustar kevinkevin;; -*- Mode: Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE IDENTIFICATION ;; ;; Name: package.lisp ;; Purpose: Package definition for memstore package ;; Date Started: July 2011 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package #:cl-user) (defpackage #:memstore (:nicknames #:ms) (:use #:common-lisp #:kmrcl) (:documentation "This is the main memstore package.") (:import-from #:memcache #:*memcache* #:*use-pool* #:mc-get #:mc-store #:mc-del #:mc-incr #:mc-decr) (:import-from #:flexi-streams #:make-in-memory-input-stream #:make-in-memory-output-stream #:get-output-stream-sequence #:octet) (:export #:*compression-threshold* #:*compression-enabled* #:*compression-savings* #:*namespace* #:ms-serialize #:ms-deserialize #:ms-store #:ms-restore #:ms-del #:ms-incr #:ms-decr)) cl-memstore-1.1.0/src/tests.lisp0000644000175000017500000001543711604541517015612 0ustar kevinkevin;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: memstore-tests.lisp ;;;; Purpose: memstore tests file ;;;; Author: Kevin M. Rosenberg ;;;; Date Started: July 2011 ;;;; ;;;; This file is Copyright (c) 2011 by Kevin M. Rosenberg ;;;; ;;;; ************************************************************************* (in-package #:cl) (defpackage #:memstore-tests (:import-from #:rtest #:*compile-tests* #:*expected-failures*) (:use #:memstore #:cl #:rtest) (:import-from #:memstore #:ms-store #:ms-restore #:ms-del #:ms-serialize #:ms-deserialize #:serialize-clstore #:deserialize-clstore #:serialize-string #:deserialize-string #:+flag-wstring+ #:+flag-clstore+ #:+flag-zlib+ #:*namespace* #:compress #:uncompress) (:import-from #:memcache #:*memcache* #:*use-pool* #:make-memcache-instance)) (in-package #:memstore-tests) (eval-when (:compile-toplevel :load-toplevel :execute) (defparameter *test-cnt* 0) (defvar *test-namespace* "__mctest__:")) (unless *memcache* (setq *memcache* (make-memcache-instance :name "Memcache test"))) (rem-all-tests) (defun run-tests (&key (compiled *compile-tests*)) (let ((*compile-tests* compiled)) (rtest:do-tests))) (defmacro def-readably-value* (val) `(progn (deftest ,(intern (format nil "DS.~D" *test-cnt*) '#:keyword) (let* ((ser (ms-serialize (quote ,val))) (flags (car ser))) (cond ((stringp (quote ,val)) (unless (and (zerop (logand flags +flag-wstring+)) (zerop (logand flags +flag-clstore+))) (error "Should be stored as simple string."))) (t (unless (and (plusp (logand flags +flag-wstring+)) (zerop (logand flags +flag-clstore+))) (error "Should be stored as wstring.")))) (ms-deserialize ser)) ,val) (deftest ,(intern (format nil "RS.~D" *test-cnt*) '#:keyword) (deserialize-clstore (serialize-clstore (quote ,val))) ,val) (deftest ,(intern (format nil "SS.~D" *test-cnt*) '#:keyword) (deserialize-string (serialize-string (quote ,val))) ,val) (deftest ,(intern (format nil "MC.~D" *test-cnt*) '#:keyword) (let ((*namespace* ,*test-namespace*) (key (format nil "~D" ,*test-cnt*))) (ms-store key (quote ,val)) (multiple-value-bind (res found) (ms-restore key) (ms-del key) (values found (equalp res (quote ,val))))) t t) ,(incf *test-cnt*))) (defmacro def-readably-value (val) `(progn (let ((*use-pool* nil)) (def-readably-value* ,val)) (let ((*use-pool* t)) (def-readably-value* ,val)))) (def-readably-value -1) (def-readably-value 10) (def-readably-value 1.5) (def-readably-value #C(1 2)) (def-readably-value "") (def-readably-value "abc") (def-readably-value nil) (def-readably-value t) (def-readably-value a) (def-readably-value :a) (def-readably-value (a b)) (def-readably-value (a . b)) (def-readably-value (:a . "b")) (def-readably-value #(0 1 2)) (def-readably-value \#k) (def-readably-value ((:a . 1) (:b . 2))) (def-readably-value #(((:a . 1) (:b . 2.5)) ((:c . "a") (:d . a)))) (deftest :ht.1 (let ((h (make-hash-table :test 'equal))) (setf (gethash "a" h) "A") (setf (gethash "b" h) "B") (let ((ds (ms-deserialize (ms-serialize h)))) (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds)))) (2 "A" "B")) (deftest :ht.2 (let ((h (make-hash-table :test 'equal))) (setf (gethash "a" h) "A") (setf (gethash "b" h) "B") (let ((ds (deserialize-clstore (serialize-clstore h)))) (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds)))) (2 "A" "B")) #-sbcl (deftest :ht.3 (let ((h (make-hash-table :test 'equal))) (setf (gethash "a" h) "A") (setf (gethash "b" h) "B") (serialize-string h)) ;; should be nil as hash tables can't be print-readably to string nil) ;; SBCL can print hash-tables readably #+sbcl (deftest :ht.3 (let ((h (make-hash-table :test 'equal))) (setf (gethash "a" h) "A") (setf (gethash "b" h) "B") (let ((ds (deserialize-string (serialize-string h)))) (list (hash-table-count ds) (gethash "a" ds) (gethash "b" ds)))) (2 "A" "B")) (defvar *long-string* (make-string 10000 :initial-element #\space)) (defvar *long-array* (make-array '(10000) :initial-element 0)) (deftest :l.1 (let* ((ser (ms-serialize *long-string*)) (data (cdr ser)) (flags (car ser))) (values (< (length data) (length *long-string*)) (eql (logand flags +flag-zlib+) +flag-zlib+) (zerop (logand flags +flag-wstring+)) (zerop (logand flags +flag-clstore+)) (string-equal *long-string* (ms-deserialize ser)))) t t t t t) (deftest :l.2 (let* ((ser (ms-serialize *long-array*)) (data (cdr ser)) (flags (car ser))) (values (< (length data) (length *long-array*)) (eql (logand flags +flag-zlib+) +flag-zlib+) (eql (logand flags +flag-wstring+) +flag-wstring+) (zerop (logand flags +flag-clstore+)) (equalp *long-array* (ms-deserialize ser)))) t t t t t) (deftest :incr.1 (let ((*namespace* *test-namespace*)) (values (ms-store "i" 0) (ms-restore "i") (ms-incr "i") (ms-incr "i" :delta 5) (ms-incr "i" :delta 3) (ms-decr "i" :delta 2) (ms-decr "i") (ms-del "i"))) "STORED" 0 1 6 9 7 6 "DELETED") (deftest :nf.1 (let ((*namespace* *test-namespace*)) (ms-restore "a")) nil nil) (defmacro def-compress-test (length id) (let ((len (gensym "LENGTH-"))) `(deftest ,(intern (format nil "Z.~D" id) (find-package '#:keyword)) (block z (let* ((,len ,length) (a (make-array (list ,len) :element-type '(unsigned-byte 8)))) (dotimes (j ,len) (setf (aref a j) (random 256))) (let* ((comp (compress a)) (uncomp (uncompress comp))) (unless (equalp a uncomp) (throw 'z :error))))) nil))) (def-compress-test (random 10000) 0) (def-compress-test (random 10000) 1) (def-compress-test (random 10000) 2) (def-compress-test (random 10000) 3) (def-compress-test (random 10000) 4) (def-compress-test (random 10000) 5) (def-compress-test (random 10000) 6) (def-compress-test (random 10000) 7) (def-compress-test (random 10000) 8) (def-compress-test (random 10000) 9) (def-compress-test (random 10000) 10) cl-memstore-1.1.0/src/compress.lisp0000644000175000017500000000202311604616146016267 0ustar kevinkevin;; -*- Mode: Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; FILE IDENTIFICATION ;; ;; Name: compress.lisp ;; Purpose: Uses zlib to compress and uncompress vectors of octets ;; Author: Kevin Rosenberg ;; Date Started: July 2011 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package #:memstore) ;; KMR: zlib gives compression errors on random tests: ;; indices outside of input array size ;; Using salza2 as default compressor (defun compress-zlib (data) (zlib:compress data :fixed)) (defun compress (data) (let ((comp (salza2:compress-data data (make-instance 'salza2:zlib-compressor)))) (values comp (length comp)))) ;; KMR: zlib appears to works fine with salza2 zlib compressor, but ;; moving to chipz as default decompressor as appears better supported (defun uncompress-zlib (data) (zlib:uncompress data)) (defun uncompress (data) (chipz:decompress nil 'chipz:zlib data)) cl-memstore-1.1.0/README.md0000644000175000017500000000454411603656164014250 0ustar kevinkevinMemstore ======== _A high-level interface for the memcached and membase servers_ Written by Kevin M. Rosenberg Downloads --------- * The web site for memstore is [http://memstore.b9.com/](http://memstore.b9.com/) * A git repository is available at [http://gitpub.b9.com/memstore.git](http://gitpub.b9.com/memstore.git) * Releases are available for download at [http://files.b9.com/memstore/](http://files.b9.com/memstore/) Prerequisites ------------- This library incorporates a heavily modified version of `cl-memcached` version 0.4.1. The primary need for the modification is to support the `flags` field supported by the memcached server. The flag field is used to store information required to deserialize the object data from memcached. In addition to adding the `flags` field, the library has been heavily refactored. For more information on the changes in memcache, see [memcache](memcache.html). This library also requires Common Lisp libraries of [kmrcl](http://gitpub.b9.com/kmrcl.git), [cl-store](http://common-lisp.net/project/cl-store/), [flexi-streams](http://weitz.de/flexi-streams/), and [zlib](http://common-lisp.net/project/zlib/). Overview -------- Memstore allows efficient storing of simple objects as well as easy storing of complex objects and optional compression. When storing an object, if the object is a string then that is directly written to the memcached server. For non-strings, an attempt to made to write the object to a string with `*print-readably*` bound to `t`. If that succeeds, then the string is converted to a vector of octets. If that fails, the `cl-store` is used to serialize that object to a vector of octets. Next, optional compression is applied to the octets. First, the `*compression-enabled*` flag is checked to see if compression is enabled. Next, the length of the objects is compared to `*compression-threshold*`. Only objects larger than `*compression-threshold*` will be compressed. For objects that qualify for compression, the size of the compressed object is compared to the length of the uncompressed object to decide if the object is shrunk enough to make the compression worthwhile. The `flags` parameter to cl-memcached stores whether cl-store or write-to-string is used to serialize the object and whether compression is applied. `mem-restore` uses those flags to determine how to reconstruct the object. cl-memstore-1.1.0/doc/0000755000175000017500000000000011603702347013522 5ustar kevinkevincl-memstore-1.1.0/doc/memcache.html0000644000175000017500000000563111604616342016157 0ustar kevinkevin

Memcache

Library for memcached protocol

Author: Kevin Rosenberg kevin@rosenberg.net, based on the cl-memcached library by Abhijit 'quasi' Rao and Chaitanya Gupta .

Date Started: July 1, 2011

Overview

This package is based on the cl-memcached library. It is substantially modified for use with the memstore library. The primary areas of additional functionality are:

  • Support for flags field with get and set functions. This is required as memstore stores bit flags denoting how the data is serialized. That information is required to deserialize the data.

  • Support for additional memcached functionality, such as the gets command for retrieving CAS identifiers. The CAS unique ID is used for the added :cas storage command. Other storage commands newly supported are :append and :prepend.

  • All communication now uses mc-send-command function with transparently supports writing strings with write-byte. This allows usocket to be used on other Lisp implementations besides AllegroCL. Because cl-memcached used write-string with usocket-stream, only AllegroCL was supported. By sending all data as (unsigned-byte 8), all Lisp implementions supported by usocket are now supported with memcached.

  • Encapsulated reading and writing to socket stream to avoid handling \#return characters in high-level code.

  • Changes to support the change in statistics fields with membase. Some fields were no longer present. Also, membase 1.7 has 187 statistics fields versus the 20 fields supported in cl-memcached. New function mc-get-stat allows to retrieving any statistics field by name.

  • More robust print-object functions to avoid errors if fields in statistics are not present.

  • Removed compatibility functions in compat.lisp by using the kmrcl library to provide those functions as well as utilitizing other kmrcl functions to simplify code.

  • Added functions to support all memcached API commands, such as flush_all and version.

  • Support for the moreply command argument accepted by many commands.

  • Support the noreply argument that many API commands accept.

  • Write nearly the entire code base for improved clarity, robustness, and efficiency.

cl-memstore-1.1.0/doc/memstore.html0000644000175000017500000000560411604616331016246 0ustar kevinkevin

Memstore

A high-level interface for the memcached and membase servers

Written by Kevin M. Rosenberg kevin@rosenberg.net

Downloads

Prerequisites

This library incorporates a heavily modified version of cl-memcached version 0.4.1. The primary need for the modification is to support the flags field supported by the memcached server. The flag field is used to store information required to deserialize the object data from memcached. In addition to adding the flags field, the library has been heavily refactored. For more information on the changes in memcache, see memcache.

This library also requires Common Lisp libraries of kmrcl, cl-store, flexi-streams, and zlib.

Overview

Memstore allows efficient storing of simple objects as well as easy storing of complex objects and optional compression.

When storing an object, if the object is a string then that is directly written to the memcached server. For non-strings, an attempt to made to write the object to a string with *print-readably* bound to t. If that succeeds, then the string is converted to a vector of octets. If that fails, the cl-store is used to serialize that object to a vector of octets.

Next, optional compression is applied to the octets. First, the *compression-enabled* flag is checked to see if compression is enabled. Next, the length of the objects is compared to *compression-threshold*. Only objects larger than *compression-threshold* will be compressed. For objects that qualify for compression, the size of the compressed object is compared to the length of the uncompressed object to decide if the object is shrunk enough to make the compression worthwhile.

The flags parameter to cl-memcached stores whether cl-store or write-to-string is used to serialize the object and whether compression is applied. mem-restore uses those flags to determine how to reconstruct the object.

cl-memstore-1.1.0/memstore.asd0000644000175000017500000000222211604616161015276 0ustar kevinkevin;;;; -*- Mode: Common-Lisp -*- ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: memstore.asd ;;;; Purpose: ASDF system definition for memstore package ;;;; Programmer: Kevin M. Rosenberg ;;;; Date Started: July 2011 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defpackage #:memstore-system (:use #:asdf #:cl)) (in-package #:memstore-system) (defsystem memstore :name "memstore" :author "Kevin M. Rosenberg " :version "1.0" :licence "BSD" :depends-on (memcache cl-store flexi-streams zlib salza2 chipz) :components ((:module src :serial t :components ((:file "package") (:file "compress") (:file "memstore"))))) (defmethod operation-done-p ((o test-op) (c (eql (find-system :memstore)))) ;; Always returns NIL so that tests are never marked as done. nil) (defmethod perform ((o test-op) (c (eql (find-system 'memstore)))) (asdf:load-system 'memstore-tests) (asdf:test-system 'memstore-tests))