如何为redux::hiredis实现自动重连？避免手动调用R$reconnect()

我在项目中通过SSH端口转发使用redux::hiredis，但网络链路偶尔故障会导致连接对象失效（原因已明确）。redux提供了R$reconnect()手动重连方法，我需要实现自动重连机制。

方案1：直接用tryCatch包裹调用 #

最直接的方式是在所有调用处用tryCatch包裹，示例代码如下：

R <- redux::hiredis()
res <- tryCatch(
  R$GET("quux"),
  error = function(e) {
    if (grepl("Failure communicating", conditionMessage(e))) {
      R$reconnect()
      R$GET("quux")
    } else stop(e)
  })

缺点：多处使用时过于繁琐，且部分代码难以修改。

方案2：添加父类并重写$方法（含额外PING检测） #

我尝试通过为对象添加父类并实现新的$方法解决问题，该方案可行，但每次调用都会额外执行PING命令，示例代码如下：

封装函数 #

redis_retry <- function(..., verbose = FALSE) {
  R <- redux::hiredis(...)
  class(R) <- c("redis_retry", class(R))
  R
}

`$.redis_retry` <- function(x, val) {
  val <- substitute(val)
  ocls <- class(x)
  on.exit(class(x) <- ocls, add = TRUE)
  class(x) <- setdiff(class(x), "redis_retry")
  res <- tryCatch(x$PING(), error = function(e) e)
  if (inherits(res, "error")) {
    if (grepl("Failure communicating with", conditionMessage(res))) {
      x$reconnect()
      res <- tryCatch(x$PING(), error = function(e) e)
      if (inherits(res, "error")) stop(res)
      return(x[[val]])
    } else stop(res)
  }
  x[[val]]
}

测试代码 #

R2 <- redis_retry()
R2$SET("quux", 42)
# [Redis: OK]
R2$GET("quux")
# [1] "42"

### 断开SSH端口转发
R2$GET("quux")
# Error in redis_connect_tcp(config$host, config$port, config$timeout) : 
#   Failed to create context: Unknown error

### 重新连接SSH端口转发
R2$GET("quux")
# [1] "42"

当前问题 #

我希望移除内部的x$PING()检测，但$访问器仅返回函数，无法获取后续的调用参数（如("quux")）。调试时也无法获取完整表达式：

Browse[1]> debug at #3: val <- substitute(val)
Browse[2]> match.call()
`$.redis_retry`(x = R2, val = GET)
Browse[2]> where
where 1: `$.redis_retry`(R2, GET)
where 2: R2$GET
Browse[2]> sys.calls()
[[1]]
R2$GET
[[2]]
`$.redis_retry`(R2, GET)

提问 #

有没有简便的方法封装R2对象，使得调用原命名函数失败时，自动执行$reconnect()并重试？

模拟Redis环境 #

若没有redux或Redis实例，可使用以下模拟版本复现上述场景：

fake_redis <- function() {
  .counter <- 0L
  env <- new.env(parent = emptyenv())
  env$GET <- function(ign) {
    if (.counter > 2) stop("counter is high")
    .counter <<- .counter + 1L
    "42"
  }
  env$reconnect <- function() .counter <<- 0L
  env
}
fakeR <- fake_redis()
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# [1] "42"
fakeR$GET("quux")
# Error in fakeR$GET("quux") : counter is high
fakeR$reconnect()
fakeR$GET("quux")
# [1] "42"

内容的提问来源于stack exchange，提问作者r2evans