set ::redis::id 0
array set ::redis::fd {}
array set ::redis::blocking {}
+array set ::redis::deferred {}
array set ::redis::callback {}
array set ::redis::state {} ;# State in non-blocking reply reading
array set ::redis::statestack {} ;# Stack of states, for nested mbulks
-array set ::redis::bulkarg {}
-array set ::redis::multibulkarg {}
-# Flag commands requiring last argument as a bulk write operation
-foreach redis_bulk_cmd {
- set setnx rpush lpush lset lrem sadd srem sismember echo getset smove zadd zrem zscore zincrby append zrank zrevrank hget hdel hexists setex
-} {
- set ::redis::bulkarg($redis_bulk_cmd) {}
-}
-
-# Flag commands requiring last argument as a bulk write operation
-foreach redis_multibulk_cmd {
- mset msetnx hset hsetnx hmset hmget
-} {
- set ::redis::multibulkarg($redis_multibulk_cmd) {}
-}
-
-unset redis_bulk_cmd
-unset redis_multibulk_cmd
-
-proc redis {{server 127.0.0.1} {port 6379}} {
+proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
set fd [socket $server $port]
fconfigure $fd -translation binary
set id [incr ::redis::id]
set ::redis::fd($id) $fd
set ::redis::blocking($id) 1
+ set ::redis::deferred($id) $defer
::redis::redis_reset_state $id
interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id
}
proc ::redis::__dispatch__ {id method args} {
set fd $::redis::fd($id)
set blocking $::redis::blocking($id)
+ set deferred $::redis::deferred($id)
if {$blocking == 0} {
if {[llength $args] == 0} {
error "Please provide a callback in non-blocking mode"
set args [lrange $args 0 end-1]
}
if {[info command ::redis::__method__$method] eq {}} {
- if {[info exists ::redis::bulkarg($method)]} {
- set cmd "$method "
- append cmd [join [lrange $args 0 end-1]]
- append cmd " [string length [lindex $args end]]\r\n"
- append cmd [lindex $args end]
- ::redis::redis_writenl $fd $cmd
- } elseif {[info exists ::redis::multibulkarg($method)]} {
- set cmd "*[expr {[llength $args]+1}]\r\n"
- append cmd "$[string length $method]\r\n$method\r\n"
- foreach a $args {
- append cmd "$[string length $a]\r\n$a\r\n"
- }
- ::redis::redis_write $fd $cmd
- flush $fd
- } else {
- set cmd "$method "
- append cmd [join $args]
- ::redis::redis_writenl $fd $cmd
+ set cmd "*[expr {[llength $args]+1}]\r\n"
+ append cmd "$[string length $method]\r\n$method\r\n"
+ foreach a $args {
+ append cmd "$[string length $a]\r\n$a\r\n"
}
- if {$blocking} {
- ::redis::redis_read_reply $fd
- } else {
- # Every well formed reply read will pop an element from this
- # list and use it as a callback. So pipelining is supported
- # in non blocking mode.
- lappend ::redis::callback($id) $callback
- fileevent $fd readable [list ::redis::redis_readable $fd $id]
+ ::redis::redis_write $fd $cmd
+ flush $fd
+
+ if {!$deferred} {
+ if {$blocking} {
+ ::redis::redis_read_reply $fd
+ } else {
+ # Every well formed reply read will pop an element from this
+ # list and use it as a callback. So pipelining is supported
+ # in non blocking mode.
+ lappend ::redis::callback($id) $callback
+ fileevent $fd readable [list ::redis::redis_readable $fd $id]
+ }
}
} else {
uplevel 1 [list ::redis::__method__$method $id $fd] $args
fconfigure $fd -blocking $val
}
+proc ::redis::__method__read {id fd} {
+ ::redis::redis_read_reply $fd
+}
+
+proc ::redis::__method__write {id fd buf} {
+ ::redis::redis_write $fd $buf
+}
+
+proc ::redis::__method__flush {id fd} {
+ flush $fd
+}
+
proc ::redis::__method__close {id fd} {
catch {close $fd}
catch {unset ::redis::fd($id)}
- {return -code error [redis_read_line $fd]}
$ {redis_bulk_read $fd}
* {redis_multi_bulk_read $fd}
- default {return -code error "Bad protocol, $type as reply type byte"}
+ default {return -code error "Bad protocol, '$type' as reply type byte"}
}
}