]> git.saurik.com Git - redis.git/blame - client-libraries/tcl/redis.tcl
MSET and MSETNX commands implemented
[redis.git] / client-libraries / tcl / redis.tcl
CommitLineData
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
13package provide redis 0.1
14
15namespace eval redis {}
16set ::redis::id 0
17array set ::redis::fd {}
18array set ::redis::bulkarg {}
f6b141c5 19array set ::redis::multibulkarg {}
95869437 20
21# Flag commands requiring last argument as a bulk write operation
22foreach 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
29foreach redis_multibulk_cmd {
30 mset
31} {
32 set ::redis::multibulkarg($redis_multibulk_cmd) {}
33}
34
95869437 35unset redis_bulk_cmd
f6b141c5 36unset redis_multibulk_cmd
95869437 37
38proc 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
46proc ::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
73proc ::redis::__method__close {id fd} {
74 catch {close $fd}
75 catch {unset ::redis::fd($id)}
76 catch {interp alias {} ::redis::redisHandle$id {}}
77}
78
79proc ::redis::__method__channel {id fd} {
80 return $fd
81}
82
83proc ::redis::redis_write {fd buf} {
84 puts -nonewline $fd $buf
85}
86
87proc ::redis::redis_writenl {fd buf} {
88 redis_write $fd $buf
89 redis_write $fd "\r\n"
90 flush $fd
91}
92
93proc ::redis::redis_readnl {fd len} {
94 set buf [read $fd $len]
95 read $fd 2 ; # discard CR LF
96 return $buf
97}
98
99proc ::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
106proc ::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
116proc ::redis::redis_read_line fd {
117 string trim [gets $fd]
118}
119
120proc ::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}