(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)
- (flet ((write-string-bytes (str stream)
- (loop for char across str
- do (write-byte (char-code char) stream))))
- (dolist (arg args)
- (unless (null arg)
- (if started
- (write-byte (char-code #\space) s)
- (setq started t))
- (typecase arg
- (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)))
+ (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))
;;;
;;;
(defun mc-store (key data &key (memcache *memcache*) ((:command command) :set) ((:exptime exptime) 0)
- ((:use-pool use-pool) *use-pool*) (cas-unique) (flags 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)
(:append "append")
(:prepend "prepend")
(:cas "cas"))
- key flags exptime len (when (eq command :cas) cas-unique))
+ key flags exptime len (when (eq command :cas) cas-unique) (when no-reply "noreply"))
(write-sequence data s)
(send-mc-command s)
- (read-crlf-line s))))
+ (if no-reply
+ (values)
+ (read-crlf-line s)))))
(defun mc-get (key-or-keys &key (memcache *memcache*) (use-pool *use-pool*)
(command :get))
res
(car res))))
-(defun mc-del (key &key (memcache *memcache*) ((:time time) 0) (use-pool *use-pool*))
+(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)
- (read-crlf-line s)))
+ (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)
+(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)
- (read-crlf-line s)))
- (int (ignore-errors (parse-integer res))))
+ (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-incr (key &key (memcache *memcache*) (delta 1) (use-pool *use-pool*))
+(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))
+ (incr-or-decr "incr" key delta memcache use-pool no-reply))
-(defun mc-decr (key &key (memcache *memcache*) (delta 1) (use-pool *use-pool*))
+(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))
+ (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)
;;; 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)
())
(defun mc-make-pool-item (&key (memcache *memcache*))
(handler-case (usocket:socket-connect (ip memcache) (port memcache) :element-type '(unsigned-byte 8))
- (usocket:socket-error () (error 'memcached-server-unreachable))
- (error () (error 'cannot-make-pool-object))))
+ (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)
projects / memstore.git / blobdiff