]>
Commit | Line | Data |
---|---|---|
95869437 | 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 | |
12 | ||
13 | package provide redis 0.1 | |
14 | ||
15 | namespace eval redis {} | |
16 | set ::redis::id 0 | |
17 | array set ::redis::fd {} | |
18 | array set ::redis::bulkarg {} | |
f6b141c5 | 19 | array set ::redis::multibulkarg {} |
95869437 | 20 | |
21 | # Flag commands requiring last argument as a bulk write operation | |
22 | foreach redis_bulk_cmd { | |
0eeb2a4b | 23 | set setnx rpush lpush lset lrem sadd srem sismember echo getset smove |
95869437 | 24 | } { |
25 | set ::redis::bulkarg($redis_bulk_cmd) {} | |
26 | } | |
f6b141c5 | 27 | |
28 | # Flag commands requiring last argument as a bulk write operation | |
29 | foreach redis_multibulk_cmd { | |
30 | mset | |
31 | } { | |
32 | set ::redis::multibulkarg($redis_multibulk_cmd) {} | |
33 | } | |
34 | ||
95869437 | 35 | unset redis_bulk_cmd |
f6b141c5 | 36 | unset redis_multibulk_cmd |
95869437 | 37 | |
38 | proc redis {{server 127.0.0.1} {port 6379}} { | |
39 | set fd [socket $server $port] | |
40 | fconfigure $fd -translation binary | |
41 | set id [incr ::redis::id] | |
42 | set ::redis::fd($id) $fd | |
43 | interp alias {} ::redis::redisHandle$id {} ::redis::__dispatch__ $id | |
44 | } | |
45 | ||
46 | proc ::redis::__dispatch__ {id method args} { | |
47 | set fd $::redis::fd($id) | |
48 | if {[info command ::redis::__method__$method] eq {}} { | |
95869437 | 49 | if {[info exists ::redis::bulkarg($method)]} { |
f6b141c5 | 50 | set cmd "$method " |
95869437 | 51 | append cmd [join [lrange $args 0 end-1]] |
52 | append cmd " [string length [lindex $args end]]\r\n" | |
53 | append cmd [lindex $args end] | |
f6b141c5 | 54 | ::redis::redis_writenl $fd $cmd |
55 | } elseif {[info exists ::redis::multibulkarg($method)]} { | |
56 | set cmd "*[expr {[llength $args]}+1]\r\n" | |
57 | append cmd "$[string length $method]\r\n$method\r\n" | |
58 | foreach a $args { | |
59 | append cmd "$[string length $a]\r\n$a\r\n" | |
60 | } | |
61 | ::redis::redis_write $fd $cmd | |
95869437 | 62 | } else { |
f6b141c5 | 63 | set cmd "$method " |
95869437 | 64 | append cmd [join $args] |
f6b141c5 | 65 | ::redis::redis_writenl $fd $cmd |
95869437 | 66 | } |
95869437 | 67 | ::redis::redis_read_reply $fd |
68 | } else { | |
69 | uplevel 1 [list ::redis::__method__$method $id $fd] $args | |
70 | } | |
71 | } | |
72 | ||
73 | proc ::redis::__method__close {id fd} { | |
74 | catch {close $fd} | |
75 | catch {unset ::redis::fd($id)} | |
76 | catch {interp alias {} ::redis::redisHandle$id {}} | |
77 | } | |
78 | ||
79 | proc ::redis::__method__channel {id fd} { | |
80 | return $fd | |
81 | } | |
82 | ||
83 | proc ::redis::redis_write {fd buf} { | |
84 | puts -nonewline $fd $buf | |
85 | } | |
86 | ||
87 | proc ::redis::redis_writenl {fd buf} { | |
88 | redis_write $fd $buf | |
89 | redis_write $fd "\r\n" | |
90 | flush $fd | |
91 | } | |
92 | ||
93 | proc ::redis::redis_readnl {fd len} { | |
94 | set buf [read $fd $len] | |
95 | read $fd 2 ; # discard CR LF | |
96 | return $buf | |
97 | } | |
98 | ||
99 | proc ::redis::redis_bulk_read {fd} { | |
100 | set count [redis_read_line $fd] | |
101 | if {$count == -1} return {} | |
102 | set buf [redis_readnl $fd $count] | |
103 | return $buf | |
104 | } | |
105 | ||
106 | proc ::redis::redis_multi_bulk_read fd { | |
107 | set count [redis_read_line $fd] | |
108 | if {$count == -1} return {} | |
109 | set l {} | |
110 | for {set i 0} {$i < $count} {incr i} { | |
111 | lappend l [redis_read_reply $fd] | |
112 | } | |
113 | return $l | |
114 | } | |
115 | ||
116 | proc ::redis::redis_read_line fd { | |
117 | string trim [gets $fd] | |
118 | } | |
119 | ||
120 | proc ::redis::redis_read_reply fd { | |
121 | set type [read $fd 1] | |
122 | switch -exact -- $type { | |
123 | : - | |
124 | + {redis_read_line $fd} | |
125 | - {return -code error [redis_read_line $fd]} | |
126 | $ {redis_bulk_read $fd} | |
127 | * {redis_multi_bulk_read $fd} | |
4e405577 | 128 | default {return -code error "Bad protocol, $type as reply type byte"} |
95869437 | 129 | } |
130 | } |