- # Leave the user with a clean DB before to exit
- test {FLUSHALL} {
- redis_flushall $fd
- redis_dbsize $fd
- } {0}
-
- puts "\n[expr $::passed+$::failed] tests, $::passed passed, $::failed failed"
- if {$::failed > 0} {
- puts "\n*** WARNING!!! $::failed FAILED TESTS ***\n"
- }
- close $fd
-}
-
-proc redis_connect {server port} {
- set fd [socket $server $port]
- fconfigure $fd -translation binary
- return $fd
-}
-
-proc redis_write {fd buf} {
- puts -nonewline $fd $buf
-}
-
-proc redis_writenl {fd buf} {
- # puts "C: $buf"
- redis_write $fd $buf
- redis_write $fd "\r\n"
- flush $fd
-}
-
-proc redis_readnl {fd len} {
- set buf [read $fd $len]
- read $fd 2 ; # discard CR LF
- return $buf
-}
-
-proc redis_bulk_read {fd} {
- set count [redis_read_line $fd]
- if {$count == -1} return {}
- set buf [redis_readnl $fd $count]
- return $buf
-}
-
-proc redis_multi_bulk_read fd {
- set count [redis_read_line $fd]
- if {$count == -1} return {}
- set l {}
- for {set i 0} {$i < $count} {incr i} {
- lappend l [redis_read_reply $fd]
- }
- return $l
-}
-
-proc redis_read_line fd {
- string trim [gets $fd]
-}
-
-proc redis_read_reply fd {
- set type [read $fd 1]
- if {$type eq {:}} {
- redis_read_line $fd
- } elseif {$type eq {-}} {
- redis_read_line $fd
- } elseif {$type eq {+}} {
- redis_read_line $fd
- } elseif {$type eq {$}} {
- redis_bulk_read $fd
- } elseif {$type eq {*}} {
- redis_multi_bulk_read $fd
- } else {
- error "Bad protocol: $type as initial reply byte"
- }
-}
-
-### Actual API ###
-
-proc redis_set {fd key val} {
- redis_writenl $fd "set $key [string length $val]\r\n$val"
- redis_read_reply $fd
-}
-
-proc redis_setnx {fd key val} {
- redis_writenl $fd "setnx $key [string length $val]\r\n$val"
- redis_read_reply $fd
-}
-
-proc redis_get {fd key} {
- redis_writenl $fd "get $key"
- redis_read_reply $fd
-}
-
-proc redis_select {fd id} {
- redis_writenl $fd "select $id"
- redis_read_reply $fd
-}
-
-proc redis_move {fd key id} {
- redis_writenl $fd "move $key $id"
- redis_read_reply $fd
-}
-
-proc redis_del {fd key} {
- redis_writenl $fd "del $key"
- redis_read_reply $fd
-}
-
-proc redis_keys {fd pattern} {
- redis_writenl $fd "keys $pattern"
- split [redis_read_reply $fd]
-}
-
-proc redis_dbsize {fd} {
- redis_writenl $fd "dbsize"
- redis_read_reply $fd
-}
-
-proc redis_incr {fd key} {
- redis_writenl $fd "incr $key"
- redis_read_reply $fd
-}
-
-proc redis_decr {fd key} {
- redis_writenl $fd "decr $key"
- redis_read_reply $fd
-}
-
-proc redis_exists {fd key} {
- redis_writenl $fd "exists $key"
- redis_read_reply $fd
-}
-
-proc redis_lpush {fd key val} {
- redis_writenl $fd "lpush $key [string length $val]\r\n$val"
- redis_read_reply $fd
-}
-
-proc redis_rpush {fd key val} {
- redis_writenl $fd "rpush $key [string length $val]\r\n$val"
- redis_read_reply $fd
-}
-
-proc redis_llen {fd key} {
- redis_writenl $fd "llen $key"
- redis_read_reply $fd
-}
-
-proc redis_scard {fd key} {
- redis_writenl $fd "scard $key"
- redis_read_reply $fd
-}
-
-proc redis_lindex {fd key index} {
- redis_writenl $fd "lindex $key $index"
- redis_read_reply $fd
-}
-
-proc redis_lrange {fd key first last} {
- redis_writenl $fd "lrange $key $first $last"
- redis_read_reply $fd
-}
-
-proc redis_mget {fd args} {
- redis_writenl $fd "mget [join $args]"
- redis_read_reply $fd
-}
-
-proc redis_sort {fd key {params {}}} {
- redis_writenl $fd "sort $key $params"
- redis_read_reply $fd
-}
-
-proc redis_ltrim {fd key first last} {
- redis_writenl $fd "ltrim $key $first $last"
- redis_read_reply $fd
-}
-
-proc redis_rename {fd key1 key2} {
- redis_writenl $fd "rename $key1 $key2"
- redis_read_reply $fd
-}
-
-proc redis_renamenx {fd key1 key2} {
- redis_writenl $fd "renamenx $key1 $key2"
- redis_read_reply $fd
-}
projects / redis.git / blobdiff