Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ruanhaishen
redis
Commits
95869437
Commit
95869437
authored
Mar 24, 2009
by
antirez
Browse files
Tcl client library
parent
4c26a79a
Changes
1
Hide whitespace changes
Inline
Side-by-side
client-libraries/tcl/redis.tcl
0 → 100644
View file @
95869437
# Tcl clinet library - used by test-redis.tcl script for now
# Copyright
(
C
)
2009 Salvatore Sanfilippo
# Released under the BSD license like Redis itself
#
# Example usage:
#
# set r
[
redis 127.0.0.1 6379
]
# $r lpush mylist foo
# $r lpush mylist bar
# $r lrange mylist 0 -1
# $r close
package provide redis 0.1
namespace eval redis
{}
set ::redis::id 0
array set ::redis::fd
{}
array set ::redis::bulkarg
{}
# Flag commands requiring last argument as a bulk write operation
foreach redis_bulk_cmd
{
set setnx rpush lpush lset lrem sadd srem sismember echo
}
{
set ::redis::bulkarg
(
$redis
_bulk_cmd
)
{}
}
unset redis_bulk_cmd
proc redis
{{
server 127.0.0.1
}
{
port 6379
}}
{
set fd
[
socket $server $port
]
fconfigure $fd -translation binary
set id
[
incr ::redis::id
]
set ::redis::fd
(
$id
)
$fd
interp alias
{}
::redis::redisHandle$id
{}
::redis::__dispatch__ $id
}
proc ::redis::__dispatch__
{
id method args
}
{
set fd $::redis::fd
(
$id
)
if
{[
info command ::redis::__method__$method
]
eq
{}}
{
set cmd
"
$method
"
if
{[
info exists ::redis::bulkarg
(
$method
)]}
{
append cmd
[
join
[
lrange $args 0 end-1
]]
append cmd
"
[
string length
[
lindex $args end
]]
\r\n
"
append cmd
[
lindex $args end
]
}
else
{
append cmd
[
join $args
]
}
::redis::redis_writenl $fd $cmd
::redis::redis_read_reply $fd
}
else
{
uplevel 1
[
list ::redis::__method__$method $id $fd
]
$args
}
}
proc ::redis::__method__close
{
id fd
}
{
catch
{
close $fd
}
catch
{
unset ::redis::fd
(
$id
)}
catch
{
interp alias
{}
::redis::redisHandle$id
{}}
}
proc ::redis::__method__channel
{
id fd
}
{
return $fd
}
proc ::redis::redis_write
{
fd buf
}
{
puts -nonewline $fd $buf
}
proc ::redis::redis_writenl
{
fd buf
}
{
redis_write $fd $buf
redis_write $fd
"
\r\n
"
flush $fd
}
proc ::redis::redis_readnl
{
fd len
}
{
set buf
[
read $fd $len
]
read $fd 2
;
# discard CR LF
return $buf
}
proc ::redis::redis_bulk_read
{
fd
}
{
set count
[
redis_read_line $fd
]
if
{
$count
== -1
}
return
{}
set buf
[
redis_readnl $fd $count
]
return $buf
}
proc ::redis::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::redis_read_line fd
{
string trim
[
gets $fd
]
}
proc ::redis::redis_read_reply fd
{
set type
[
read $fd 1
]
switch -exact -- $type
{
: -
+
{
redis_read_line $fd
}
-
{
return -code error
[
redis_read_line $fd
]}
$
{
redis_bulk_read $fd
}
*
{
redis_multi_bulk_read $fd
}
default
{
return -code error
"Bad protocl,
$type
as reply type byte"
}
}
}
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment