]> git.saurik.com Git - redis.git/blame - tests/support/redis.tcl
Merge pull request #414 from chobits/unstable
[redis.git] / tests / support / redis.tcl
CommitLineData
f89c3a35 1# Tcl clinet library - used by test-redis.tcl script for now
2# Copyright (C) 2009 Salvatore Sanfilippo
3# Released under the BSD license like Redis itself
4#
5# Example usage:
6#
7# set r [redis 127.0.0.1 6379]
8# $r lpush mylist foo
9# $r lpush mylist bar
10# $r lrange mylist 0 -1
11# $r close
686bc0ac 12#
13# Non blocking usage example:
14#
15# proc handlePong {r type reply} {
16# puts "PONG $type '$reply'"
17# if {$reply ne "PONG"} {
18# $r ping [list handlePong]
19# }
20# }
21#
22# set r [redis]
23# $r blocking 0
24# $r get fo [list handlePong]
25#
26# vwait forever
f89c3a35 27
f1a930bb 28package require Tcl 8.5
f89c3a35 29package provide redis 0.1
30
31namespace eval redis {}
32set ::redis::id 0
33array set ::redis::fd {}
686bc0ac 34array set ::redis::blocking {}
5eedc9c6 35array set ::redis::deferred {}
686bc0ac 36array set ::redis::callback {}
37array set ::redis::state {} ;# State in non-blocking reply reading
6fcb1800 38array set ::redis::statestack {} ;# Stack of states, for nested mbulks
f89c3a35 39
5eedc9c6 40proc redis {{server 127.0.0.1} {port 6379} {defer 0}} {
f89c3a35 41 set fd [socket $server $port]
42 fconfigure $fd -translation binary
43 set id [incr ::redis::id]
44 set ::redis::fd($id) $fd
686bc0ac 45 set ::redis::blocking($id) 1
5eedc9c6 46 set ::redis::deferred($id) $defer
686bc0ac 47 ::redis::redis_reset_state $id
f89c3a35 48 interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id
49}
50
51proc ::redis::__dispatch__ {id method args} {
52 set fd $::redis::fd($id)
686bc0ac 53 set blocking $::redis::blocking($id)
5eedc9c6 54 set deferred $::redis::deferred($id)
686bc0ac 55 if {$blocking == 0} {
56 if {[llength $args] == 0} {
57 error "Please provide a callback in non-blocking mode"
58 }
59 set callback [lindex $args end]
60 set args [lrange $args 0 end-1]
61 }
f89c3a35 62 if {[info command ::redis::__method__$method] eq {}} {
00cf82c0
PN
63 set cmd "*[expr {[llength $args]+1}]\r\n"
64 append cmd "$[string length $method]\r\n$method\r\n"
65 foreach a $args {
66 append cmd "$[string length $a]\r\n$a\r\n"
f89c3a35 67 }
00cf82c0
PN
68 ::redis::redis_write $fd $cmd
69 flush $fd
70
5eedc9c6
PN
71 if {!$deferred} {
72 if {$blocking} {
73 ::redis::redis_read_reply $fd
74 } else {
75 # Every well formed reply read will pop an element from this
76 # list and use it as a callback. So pipelining is supported
77 # in non blocking mode.
78 lappend ::redis::callback($id) $callback
79 fileevent $fd readable [list ::redis::redis_readable $fd $id]
80 }
686bc0ac 81 }
f89c3a35 82 } else {
83 uplevel 1 [list ::redis::__method__$method $id $fd] $args
84 }
85}
86
686bc0ac 87proc ::redis::__method__blocking {id fd val} {
88 set ::redis::blocking($id) $val
89 fconfigure $fd -blocking $val
90}
91
5eedc9c6
PN
92proc ::redis::__method__read {id fd} {
93 ::redis::redis_read_reply $fd
94}
95
941c9fa2
PN
96proc ::redis::__method__write {id fd buf} {
97 ::redis::redis_write $fd $buf
98}
99
100proc ::redis::__method__flush {id fd} {
101 flush $fd
102}
103
f89c3a35 104proc ::redis::__method__close {id fd} {
105 catch {close $fd}
106 catch {unset ::redis::fd($id)}
686bc0ac 107 catch {unset ::redis::blocking($id)}
108 catch {unset ::redis::state($id)}
6fcb1800 109 catch {unset ::redis::statestack($id)}
686bc0ac 110 catch {unset ::redis::callback($id)}
f89c3a35 111 catch {interp alias {} ::redis::redisHandle$id {}}
112}
113
114proc ::redis::__method__channel {id fd} {
115 return $fd
116}
117
118proc ::redis::redis_write {fd buf} {
119 puts -nonewline $fd $buf
120}
121
122proc ::redis::redis_writenl {fd buf} {
123 redis_write $fd $buf
124 redis_write $fd "\r\n"
125 flush $fd
126}
127
128proc ::redis::redis_readnl {fd len} {
129 set buf [read $fd $len]
130 read $fd 2 ; # discard CR LF
131 return $buf
132}
133
134proc ::redis::redis_bulk_read {fd} {
135 set count [redis_read_line $fd]
136 if {$count == -1} return {}
137 set buf [redis_readnl $fd $count]
138 return $buf
139}
140
141proc ::redis::redis_multi_bulk_read fd {
142 set count [redis_read_line $fd]
143 if {$count == -1} return {}
144 set l {}
ff79ab71 145 set err {}
f89c3a35 146 for {set i 0} {$i < $count} {incr i} {
ff79ab71 147 if {[catch {
148 lappend l [redis_read_reply $fd]
149 } e] && $err eq {}} {
150 set err $e
151 }
f89c3a35 152 }
ff79ab71 153 if {$err ne {}} {return -code error $err}
f89c3a35 154 return $l
155}
156
157proc ::redis::redis_read_line fd {
158 string trim [gets $fd]
159}
160
161proc ::redis::redis_read_reply fd {
162 set type [read $fd 1]
163 switch -exact -- $type {
164 : -
165 + {redis_read_line $fd}
166 - {return -code error [redis_read_line $fd]}
167 $ {redis_bulk_read $fd}
168 * {redis_multi_bulk_read $fd}
7dcdd281 169 default {return -code error "Bad protocol, '$type' as reply type byte"}
f89c3a35 170 }
171}
686bc0ac 172
173proc ::redis::redis_reset_state id {
174 set ::redis::state($id) [dict create buf {} mbulk -1 bulk -1 reply {}]
6fcb1800 175 set ::redis::statestack($id) {}
686bc0ac 176}
177
178proc ::redis::redis_call_callback {id type reply} {
179 set cb [lindex $::redis::callback($id) 0]
180 set ::redis::callback($id) [lrange $::redis::callback($id) 1 end]
181 uplevel #0 $cb [list ::redis::redisHandle$id $type $reply]
182 ::redis::redis_reset_state $id
183}
184
185# Read a reply in non-blocking mode.
186proc ::redis::redis_readable {fd id} {
187 if {[eof $fd]} {
188 redis_call_callback $id eof {}
189 ::redis::__method__close $id $fd
190 return
191 }
192 if {[dict get $::redis::state($id) bulk] == -1} {
193 set line [gets $fd]
194 if {$line eq {}} return ;# No complete line available, return
195 switch -exact -- [string index $line 0] {
196 : -
197 + {redis_call_callback $id reply [string range $line 1 end-1]}
198 - {redis_call_callback $id err [string range $line 1 end-1]}
199 $ {
200 dict set ::redis::state($id) bulk \
201 [expr [string range $line 1 end-1]+2]
202 if {[dict get $::redis::state($id) bulk] == 1} {
203 # We got a $-1, hack the state to play well with this.
204 dict set ::redis::state($id) bulk 2
205 dict set ::redis::state($id) buf "\r\n"
206 ::redis::redis_readable $fd $id
207 }
208 }
6fcb1800 209 * {
210 dict set ::redis::state($id) mbulk [string range $line 1 end-1]
211 # Handle *-1
212 if {[dict get $::redis::state($id) mbulk] == -1} {
213 redis_call_callback $id reply {}
214 }
215 }
686bc0ac 216 default {
217 redis_call_callback $id err \
218 "Bad protocol, $type as reply type byte"
219 }
220 }
221 } else {
222 set totlen [dict get $::redis::state($id) bulk]
223 set buflen [string length [dict get $::redis::state($id) buf]]
224 set toread [expr {$totlen-$buflen}]
225 set data [read $fd $toread]
226 set nread [string length $data]
227 dict append ::redis::state($id) buf $data
228 # Check if we read a complete bulk reply
229 if {[string length [dict get $::redis::state($id) buf]] ==
230 [dict get $::redis::state($id) bulk]} {
231 if {[dict get $::redis::state($id) mbulk] == -1} {
232 redis_call_callback $id reply \
233 [string range [dict get $::redis::state($id) buf] 0 end-2]
234 } else {
235 dict with ::redis::state($id) {
236 lappend reply [string range $buf 0 end-2]
237 incr mbulk -1
238 set bulk -1
239 }
240 if {[dict get $::redis::state($id) mbulk] == 0} {
241 redis_call_callback $id reply \
242 [dict get $::redis::state($id) reply]
243 }
244 }
245 }
246 }
247}