Skip to content
Browse files

Modified error handling to attempt a server connection reset upon enc…

…ountering a serious error
  • Loading branch information...
1 parent 17b4c63 commit d1fcc9da7f4aef6de951a7445493e65a58e4a6ea B. W. Lewis committed Mar 16, 2010
Showing with 48 additions and 24 deletions.
  1. +18 −9 R/allValCMD.R
  2. +30 −15 R/redis-internal.R
View
27 R/allValCMD.R
@@ -1,11 +1,13 @@
# This file contains functions that operate on all kinds of Redis values.
-redisExists <- function(key) {
+redisExists <- function(key)
+{
msg <- paste('EXISTS ',key,'\r\n',sep='')
.sendCmd(msg)==1
}
-redisDelete <- function(key) {
+redisDelete <- function(key)
+{
nkeys <- length(key)
if (nkeys > 1) {
key <- paste(key, collapse=' ')
@@ -19,7 +21,8 @@ redisDelete <- function(key) {
ans==nkeys
}
-redisType <- function(key) {
+redisType <- function(key)
+{
msg <- paste('TYPE ',key,'\r\n',sep='')
.sendCmd(msg)
}
@@ -29,28 +32,34 @@ redisKeys <- function(pattern="*")
.sendCmd(.redismsg('KEYS',pattern))
}
-redisRandomKey <- function() {
+redisRandomKey <- function()
+{
.sendCmd(.redismsg('RANDOMKEY'))
}
-redisRename <- function(old, new, NX=FALSE) {
+redisRename <- function(old, new, NX=FALSE)
+{
if (NX) cmd <- 'RENAMENX ' else cmd <- 'RENAME '
ret <- .sendCmd(.redismsg(cmd,old,new))
if (NX) 1==ret else ret
}
-redisExpire <- function(key, seconds) {
+redisExpire <- function(key, seconds)
+{
1==.sendCmd(.redismsg('EXPIRE',key,seconds))
}
-redisExpireAt <- function(key, time) {
+redisExpireAt <- function(key, time)
+{
1==.sendCmd(.redismsg('EXPIREAT',key,time))
}
-redisTTL <- function(key) {
+redisTTL <- function(key)
+{
.sendCmd(.redismsg('TTL',key))
}
-redisMove <- function(key, dbindex) {
+redisMove <- function(key, dbindex)
+{
1==.sendCmd(.redismsg('MOVE',key,dbindex))
}
View
45 R/redis-internal.R
@@ -3,26 +3,43 @@
.redisEnv <- new.env()
-.redis <- function() {
+.redis <- function()
+{
tryCatch(get('con',envir=.redisEnv),error=function(e) stop('Not connected, try using redisConnect()'))
}
-.redisPP <- function() {
+# .redisError may be called by any function when a serious error occurs.
+# It will print an indicated error message, attempt to reset the current
+# Redis server connection, and signal the error.
+.redisError <- function(msg)
+{
+ con <- .redis()
+ close(con)
+ con <- socketConnection(.redisEnv$host, .redisEnv$port,open='a+b')
+ assign('con',con,envir=.redisEnv)
+ stop(msg)
+}
+
+.redisPP <- function()
+{
# Ping-pong
.sendCmd('PING\r\n')
}
-.cerealize <- function(value) {
+.cerealize <- function(value)
+{
if(!is.raw(value)) serialize(value,ascii=FALSE,connection=NULL)
else value
}
-.redismsg <- function(...) {
+.redismsg <- function(...)
+{
dat <- list(...)
paste(paste(dat,collapse=' '), '\r\n', sep='')
}
-.getResponse <- function(names=NULL) {
+.getResponse <- function(names=NULL)
+{
con <- .redis()
socketSelect(list(con))
l <- readLines(con=con, n=1)
@@ -32,7 +49,7 @@
# '+' is a valid retrun message on at least one cmd (RANDOMKEY)
return('')
}
- stop('Message garbled')
+ .redisError('Message garbled')
}
switch(s,
'-' = stop(substr(l,2,nchar(l))),
@@ -45,20 +62,16 @@
}
socketSelect(list(con))
dat <- tryCatch(readBin(con, 'raw', n=n),
- error=function(e) {
- stop("error reading from socket: ",e$message)
- })
+ error=function(e) .redisError(e$message))
m <- length(dat)
while(m<n) {
# Short read; we need to retrieve the rest of this message.
socketSelect(list(con))
dat <- c(dat, tryCatch(readBin(con, 'raw', n=(n-m)),
- error=function(e) {
- stop("error reading from socket: ",e$message)
- }))
+ error=function (e) .redisError(e$message)))
m <- length(dat)
}
- l <- readLines(con,n=1)
+ l <- readLines(con,n=1) # Trailing \r\n
# Try retrieving an R object, otherwise default to character:
tryCatch(unserialize(dat),
error=function(e) rawToChar(dat))
@@ -82,7 +95,8 @@
stop('Unknown message type'))
}
-.sendCmd <- function(cmd, bin=NULL, checkResponse=TRUE, ...) {
+.sendCmd <- function(cmd, bin=NULL, checkResponse=TRUE, ...)
+{
con <- .redis()
socketSelect(list(con), write=TRUE)
cat(cmd, file=con)
@@ -101,7 +115,8 @@
# NA or zero-length keys are allowed, for example:
# list(SADD=charToRaw("mykey"), myvalue)
# NA or zero-length keys are simply skipped in the outgoing message.
-.sendCmdMulti <- function(keyvalues, ...) {
+.sendCmdMulti <- function(keyvalues, ...)
+{
numItems <- length(keyvalues)
keys <- names(keyvalues)
if(is.null(keys)) {

0 comments on commit d1fcc9d

Please sign in to comment.
Something went wrong with that request. Please try again.