修正 redis-lrange bug. 2020.02.22
;;;; redis-lib.pkg
(in-package :cl-user)
(defpackage :whj-redis
(:nicknames :redis :redis-lib)
(:use
:common-lisp
:ext
:socket)
(:export
:*redis-conn*
:redis-connect
:redis-close
:with-redis
:redis-send ;for debug
:redis-command
:redis-ttl
:redis-exists
:redis-expire
:redis-keys
:redis-type
:redis-sort
:redis-set
:redis-get
:redis-set-encode
:redis-get-encode
:redis-lpush
:redis-lpop
:redis-rpush
:redis-rpop
:redis-lrange
:redis-llen
:redis-lindex
:redis-lset
:redis-linsert
:redis-rpoplpush
:redis-ltrim
:redis-lrem
:redis-smembers
:redis-sismember
:redis-sadd
:redis-srem
:redis-scard
:redis-sdiff
:redis-sinter
:redis-sunion
:redis-sdiffstore
:redis-sinterstore
:redis-sunionstore
:redis-srandmember
:redis-spop
:redis-zrange
:redis-zrevrange
:redis-zadd
:redis-zscore
:redis-zrangebyscore
:redis-zrevrangebyscore
:redis-zincrby
:redis-zcard
:redis-zrem
:redis-zcount
:redis-zremrangebyrank
:redis-zremrangebyscore
:redis-zrank
:redis-zrevrank
:redis-zinterstore
:redis-zunionstore
:redis-hset
:redis-hget
:redis-hgetall
:redis-hkeys
:redis-hlen))
;;;; redis-lib.lsp
(in-package :redis-lib)
;------------------------------------------------------------------------------------------
(defvar *redis-conn* nil)
(defvar *redis-charset* charset:utf-8)
(defvar *redis-cmd-end-flag* (coerce (list #\return #\newline) 'string))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;實現統一請求協議
;;;; 助手宏
(defmacro redis-read-byte ()
'(read-byte *redis-conn* nil))
(defmacro redis-send-bytes (sequence)
`(write-byte-sequence ,sequence *redis-conn*))
(defmacro redis-send-string (string)
`(redis-send-bytes (convert-string-to-bytes ,string *redis-charset*)))
(defmacro redis-cmd-end ()
'(redis-send-string *redis-cmd-end-flag*))
(defmacro redis-command (&rest args)
`(progn
(redis-send-cmd-length ,(length args))
(redis-send-item-list ,@args)
(redis-read-to-end)))
(defun to-string (o)
(format nil "~a" o))
(defun redis-mode (mode)
(setf (stream-element-type *redis-conn*) (if (eq mode :char) 'character '(unsigned-byte 8))))
(defun redis-send-cmd-length (n)
(redis-send-string (format nil "*~a" n))
(redis-cmd-end))
(defun redis-send-item-length (n)
(redis-send-string (format nil "$~a" n))
(redis-cmd-end))
;${len}\r\n{str-item-byte-list}\r\n
(defun redis-send-item (string-item)
(let ((v (convert-string-to-bytes string-item *redis-charset*)))
(redis-send-item-length (length v))
(redis-send-bytes v)
(redis-cmd-end)))
(defun redis-send-item-list (&rest args)
(dolist (item args)
(redis-send-item (to-string item))))
(defun redis-read-line ()
(let ((lst (loop for x = (redis-read-byte) while (not (= x 13)) collect x)))
(redis-read-byte)
(convert-string-from-bytes (coerce lst 'vector) *redis-charset*)))
(defun redis-read-integer ()
(let ((line (redis-read-line)))
(when (string/= line "")
(parse-integer line
:start (if (member (elt line 0) (list #\* #\$)) 1 0)))))
(defun redis-read-nbyte (n)
(if (<= n 0)
""
(let ((lst (loop for i from 1 to n collect (redis-read-byte))))
(redis-read-byte)
(redis-read-byte)
(convert-string-from-bytes (coerce lst 'vector) *redis-charset*))))
(defun redis-read-to-end ()
(let ((char-flag (code-char (redis-read-byte))))
(cond
((char= char-flag #\$);單字符串
(let ((n (redis-read-integer)))
(values (redis-read-nbyte n) n)))
((char= char-flag #\*)
(let ((n (redis-read-integer)))
(values
(let ((lst nil))
(do ((i 0))
((>= i n))
(let ((xb (redis-read-integer)))
(when xb
(incf i)
(push (redis-read-nbyte xb) lst))))
(nreverse lst))
n)))
((char= char-flag #\:);整數回覆
(parse-integer (redis-read-line)))
((char= char-flag #\+);狀態
(redis-read-line))
((char= char-flag #\-);錯誤
(redis-read-line)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;------------------------------------------------------------------------------------------
;連接redis server
(defun redis-connect (&optional (ip "127.0.0.1") (port 6379))
(setf *redis-conn* (socket-connect port ip :element-type '(unsigned-byte 8) :external-format :dos)))
;關閉redis socket 連接
(defun redis-close nil
(when *redis-conn*
(close *redis-conn*)))
;打開連接，執行命令後關閉連接
(defmacro with-redis ((ip port) &body body)
`(let ((*redis-conn* (redis-connect ,ip ,port)))
(unwind-protect
(progn
,@body)
(redis-close))))
;------------------------------------------------------------------------------------------
;redis ttl
(defun redis-ttl (key)
(redis-command "ttl" key))
;redis exists
(defun redis-exists (&rest key-list)
(redis-send-cmd-length (1+ (length key-list)))
(apply #'redis-send-item-list "exists" key-list)
(redis-read-to-end))
;redis expire
(defun redis-expire (key seconds)
(redis-command "expire" key seconds))
;redis type
(defun redis-type (key)
(redis-command "type" key))
;redis keys
(defun redis-keys (&optional (pattern "*"))
(redis-command "keys" pattern))
;redis get
(defun redis-get (key)
(redis-command "get" key))
;redis set
(defun redis-set (key value &optional (expire-seconds -1))
(let ((n (+ 3
(if (>= expire-seconds 0)
2
0))))
(redis-send-cmd-length n)
(redis-send-item-list "set" key value)
(when (>= expire-seconds 0)
(redis-send-item-list "ex" expire-seconds)))
(redis-read-to-end))
;redis sort [BY pattern] [LIMIT offset count] [GET pattern [GET pattern]] ASC|DESC
(defun redis-sort (key &key (BY NIL) (LIMIT NIL) (GET NIL) (MODE 'ASC))
(let ((n (+ 2
(if by 2 0)
(if limit 3 0)
(if get 2 0)
(if mode 1 0))))
(redis-send-cmd-length n)
(redis-send-item-list "sort" key)
(when BY
(redis-send-item-list "BY" BY))
(when LIMIT
(redis-send-item-list
"LIMIT"
(car limit)
(cadr limit)))
(when GET
(redis-send-item-list
"GET"
GET))
(when MODE
(redis-send-item (to-string MODE)))
(redis-read-to-end)))
;------------------------------------------------------------------------------------------
;redis lpush
;返回 添加後的新長度
(defun redis-lpush (key &rest value-list)
(redis-send-cmd-length (+ 2 (length value-list)))
(apply #'redis-send-item-list "lpush" key value-list)
(redis-read-to-end))
;redis lpop
(defun redis-lpop (key)
(redis-command "lpop" key))
;redis rpush
(defun redis-rpush (key &rest value-list)
(redis-send-cmd-length (+ 2 (length value-list)))
(apply #'redis-send-item-list "rpush" key value-list)
(redis-read-to-end))
;redis rpop
(defun redis-rpop (key)
(redis-command "rpop" key))
;redis lrange
(defun redis-lrange (key &optional (start 0) (end -1))
(redis-command "lrange" key start end))
;redis-llen
(defun redis-llen (key)
(redis-command "llen" key))
;redis lindex
(defun redis-lindex (key index)
(redis-command "lindex" key index))
;redis lset
(defun redis-lset (key index value)
(redis-command "lset" key index value))
;redis linsert
(defun redis-linsert (key value pivot-value &optional (after-p t))
(redis-command
"linsert"
key
(if after-p "after" "before")
pivot-value
value))
;redis rpoplpush
(defun redis-rpoplpush (src dest)
(redis-command "rpoplpush" src dest))
;redis ltrim ;僅保留 start end 之間的數據
(defun redis-ltrim (key start end)
(redis-command "ltrim" key start end))
;redis lrem
(defun redis-lrem (key count value)
(redis-command "lrem" key count value))
;------------------------------------------------------------------------------------------
;redis semembers
(defun redis-smembers (key)
(redis-command "smembers" key))
;redis sismember
(defun redis-sismember (key member)
(redis-command "sismember" key member))
;redis sadd
(defun redis-sadd (key &rest member-list)
(redis-send-cmd-length (+ 2 (length member-list)))
(apply #'redis-send-item-list "sadd" key member-list)
(redis-read-to-end))
;redis srem
(defun redis-srem (key &rest member-list)
(redis-send-cmd-length (+ 2 (length member-list)))
(apply #'redis-send-item-list "srem" key member-list)
(redis-read-to-end))
;redis scard
(defun redis-scard (key)
(redis-command "scard" key))
;redis sdiff
(defun redis-sdiff (&rest key-list)
(redis-send-cmd-length (1+ (length key-list)))
(apply #'redis-send-item-list "sdiff" key-list)
(redis-read-to-end))
;redis sinter
(defun redis-sinter (&rest key-list)
(redis-send-cmd-length (1+ (length key-list)))
(apply #'redis-send-item-list "sinter" key-list)
(redis-read-to-end))
;redis sunion
(defun redis-sunion (&rest key-list)
(redis-send-cmd-length (1+ (length key-list)))
(apply #'redis-send-item-list "sunion" key-list)
(redis-read-to-end))
;redis sdiffstore
(defun redis-sdiffstore (dst-key &rest key-list)
(redis-send-cmd-length (+ 2 (length key-list)))
(apply #'redis-send-item-list "sdiffstore" dst-key key-list)
(redis-read-to-end))
;redis sinterstore
(defun redis-sinterstore (dst-key &rest key-list)
(redis-send-cmd-length (+ 2 (length key-list)))
(apply #'redis-send-item-list "sinterstore" dst-key key-list)
(redis-read-to-end))
;redis sunionstore
(defun redis-sunionstore (dst-key &rest key-list)
(redis-send-cmd-length (+ 2 (length key-list)))
(apply #'redis-send-item-list "sunionstore" dst-key key-list)
(redis-read-to-end))
;redis srandmember
(defun redis-srandmember (key count)
(redis-command "srandmember" key count))
;redis spop
(defun redis-spop (key &optional (count 1))
(redis-command "spop" key count))
;------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------
;redis zadd
(defun redis-zadd (key &rest score-value-list)
(redis-send-cmd-length (+ 2 (length score-value-list)))
(apply #'redis-send-item-list "zadd" key score-value-list)
(redis-read-to-end))
;redis zrange
(defun redis-zrange (key &optional (withscores-p nil) (start 0) (end -1) )
(redis-send-cmd-length (+ 4 (if withscores-p 1 0)))
(redis-send-item-list "zrange" key start end)
(when withscores-p
(redis-send-item "withscores"))
(redis-read-to-end))
;redis zrevrange
(defun redis-zrevrange (key &optional (withscores-p nil) (start 0) (end -1) )
(redis-send-cmd-length (+ 4 (if withscores-p 1 0)))
(redis-send-item-list "zrevrange" key start end)
(when withscores-p
(redis-send-item "withscores"))
(redis-read-to-end))
;redis zscore
(defun redis-zscore (key member)
(redis-command "zscore" key member))
;redis zrangebyscore key min max [withscores] [limit offset count]
;exap: (redis-zrangebyscore "z1" "(10" 20 t '(0 1))
(defun redis-zrangebyscore (key min max &optional (withscores nil) (limit '(0 -1)))
(redis-send-cmd-length (+ 7 (if withscores 1 0)))
(redis-send-item-list "zrangebyscore" key min max "limit" (car limit) (cadr limit))
(when withscores
(redis-send-item "withscores"))
(redis-read-to-end))
;redis zrevrangebyscore key max min [withscores] [limit offset count]
(defun redis-zrevrangebyscore (key max min &optional (withscores nil) (limit '(0 -1)))
(redis-send-cmd-length (+ 7 (if withscores 1 0)))
(redis-send-item-list "zrevrangebyscore" key max min "limit" (car limit) (cadr limit))
(when withscores
(redis-send-item "withscores"))
(redis-read-to-end))
;redis-zincrby
(defun redis-zincrby (key increment member)
(redis-command "zincrby" key increment member))
;redis-zcard
(defun redis-zcard (key)
(redis-command "zcard" key))
;redis zrem
(defun redis-zrem (key &rest member-list)
(redis-send-cmd-length (+ 2 (length member-list)))
(apply #'redis-send-item-list "zrem" key member-list)
(redis-read-to-end))
;redis zcount
(defun redis-zcount (key min max)
(redis-command "zcount" key min max))
;redis-zremrangebyrank
(defun redis-zremrangebyrank (key start stop)
(redis-command "zremrangebyrank" key start stop))
;:redis-zremrangebyscore
(defun redis-zremrangebyscore (key min max)
(redis-command "zremrangebyscore" key min max))
;:redis-zrank: zrank key member
(defun redis-zrank (key member)
(redis-command "zrank" key member))
;:redis-zrevrank: zrevrank key member
(defun redis-zrevrank (key member)
(redis-command "zrevrank" key member))
;redis-zinterstore: zinterstore numkeys key [key ...] [WEIGHTS weight [weight ...]] [AGGREGATE min|max|sum]
; exap: (redis-zinterstore "z-dst" '("z1" 1 "z2" 2) 'sum)
(defun redis-zinterstore (dst-key key-weight-list aggregate-type)
(let ((kv-cnt (length key-weight-list)))
(redis-send-cmd-length (+ 6 kv-cnt))
(apply #'redis-send-item-list
`("zinterstore"
,dst-key
,(/ kv-cnt 2)
,@(loop for x in key-weight-list by #'cddr collect x)
"WEIGHTS"
,@(loop for x on key-weight-list by #'cddr collect (second x))
"AGGREGATE"
,aggregate-type)))
(redis-read-to-end))
;:redis-zunionstore: zunionstore numkeys key [key ...] [WEIGHTS weight [weight ...]] [AGGREGATE min|max|sum]
(defun redis-zunionstore (dst-key key-weight-list aggregate-type)
(let ((kv-cnt (length key-weight-list)))
(redis-send-cmd-length (+ 6 kv-cnt))
(apply #'redis-send-item-list
`("zunionstore"
,dst-key
,(/ kv-cnt 2)
,@(loop for x in key-weight-list by #'cddr collect x)
"WEIGHTS"
,@(loop for x on key-weight-list by #'cddr collect (second x))
"AGGREGATE"
,aggregate-type)))
(redis-read-to-end))
;------------------------------------------------------------------------------------------
;hash API
;redis hset
(defun redis-hset (key field value)
(redis-command "hset" key field value))
;redis hget
(defun redis-hget (key field)
(redis-command "hget" key field))
;redis hgetall
(defun redis-hgetall (key)
(redis-command "hgetall" key))
;redis hkeys
(defun redis-hkeys (key)
(redis-command "hkeys" key))
;redis hlen
(defun redis-hlen (key)
(redis-command "hlen" key))
;;;; redis-lib-test.lsp
(in-package :cl-user)
(defun reload nil
(load "h:/lisptool/rediscli/redis-lib.pkg")
(load "h:/lisptool/rediscli/redis-lib.lsp")
(load "h:/lisptool/rediscli/redis-lib-test.lsp"))
(use-package :redis-lib)
(defparameter *ip* "127.0.0.1")
(defparameter *port* 6379)
;for test
(defun redis-init nil
(redis-close)
(redis-connect *ip* *port*))
(defun test-1 nil
(dotimes (i 10000)
(redis-set (format nil "key~4,'0d" i)
(format nil "it is a test No.~a !" (1+ i)))))
(defun test-2 nil
(with-redis (*ip* *port*)
(print (redis-zrange "z1"))
(print (redis-lrange "lst1"))))
(defun test-3 nil
(with-redis (*ip* *port*)
(loop for x = (redis-rpop "lst1")
while x
do (print x))))
(defun test-4 nil
(with-redis (*ip* *port*)
(dotimes (i 100)
(redis-lpush "lst1" "ok test1" 1 2 5 "end flag"))
(loop for x = (redis-rpop "lst1")
while x
do (print x))))