store called results in Aio

Author: shikokuchuo

NAMESPACE

@@ -8,12 +8,13 @@ S3method(close,nanoContext)
 S3method(close,nanoDialer)
 S3method(close,nanoListener)
 S3method(close,nanoSocket)
-S3method(print,nano)
 S3method(print,nanoContext)
 S3method(print,nanoDialer)
 S3method(print,nanoListener)
 S3method(print,nanoObject)
 S3method(print,nanoSocket)
+S3method(print,recvAio)
+S3method(print,sendAio)
 S3method(setopt,nanoContext)
 S3method(setopt,nanoDialer)
 S3method(setopt,nanoListener)

R/context.R

@@ -104,20 +104,15 @@ ctx_send <- function(context, data, mode = c("serial", "raw"), timeout, echo = T
 #' @inheritParams recv
 #' @inheritParams send_aio
 #'
-#' @return Named list of 2 elements: 'raw' containing a list of received raw
-#'     vectors and 'data' containing a list of converted R objects, or else a
-#'     list of converted R objects if keep.raw is set to FALSE.
+#' @return Named list of 2 elements: 'raw' containing the received raw vector
+#'     and 'data' containing the converted R object, or else the converted R
+#'     object if 'keep.raw' is set to FALSE.
 #'
-#'     Note: a list of lists is always returned even when n = 1. To access the
-#'     first raw element, for example, use \code{$raw[[1]]} and the first data
-#'     element use \code{$data[[1]]}.
-#'
-#' @details Async recv will block while awaiting all 'n' messages to arrive. Set
-#'     a timeout to ensure that the function returns under all scenarios.
+#' @details Async recv will block while awaiting the receive operation to complete.
+#'     Set a timeout to ensure that the function returns under all scenarios.
 #'
 #'     In case of an error in unserialisation or data conversion, the function
-#'     will still return a list of received raw vectors to allow the data to be
-#'     recovered.
+#'     will still return the received raw vector to allow the data to be recovered.
 #'
 #' @examples
 #' req <- socket("req", listen = "inproc://nanonext")

R/nano.R

@@ -201,12 +201,31 @@ print.nanoListener <- function(x, ...) {
 
 #' @export
 #'
-print.nano <- function(x, ...) {
+print.recvAio <- function(x, ...) {
 
-  klass <- attr(x, "class")[1L]
-  switch(klass,
-         recvAio = cat("< recvAio > - use aio_call() to retrieve message\n"),
-         sendAio = cat("< sendAio > - use aio_call() to retrieve result\n"))
+  cat("< recvAio >\n")
+  is.null(attr(x, "raw")) && is.null(attr(x, "data")) && {
+    cat(": use aio_call() to retrieve message\n")
+    return(invisible(x))
+  }
+  if (!is.null(attr(x, "raw")))
+    cat(" - $raw for raw message\n")
+  if (!is.null(attr(x, "data")))
+    cat(" - $data for message data\n")
+  invisible(x)
+
+}
+
+#' @export
+#'
+print.sendAio <- function(x, ...) {
+
+  cat("< sendAio >\n")
+  if (is.null(attr(x, "result"))) {
+    cat(": use aio_call() to retrieve result\n")
+  } else {
+    cat(" - $result for send result\n")
+  }
   invisible(x)
 
 }

R/sendrecv.R

@@ -72,7 +72,6 @@ send <- function(socket,
 #' aio_call(aio)
 #'
 #' aio <- send_aio(pub, "message 1", mode = "raw", timeout = 100)
-#' aio
 #' aio_call(aio)
 #'
 #' close(pub)
@@ -182,14 +181,18 @@ recv <- function(socket,
 #' res <- recv_aio(s2, timeout = 100, keep.raw = FALSE)
 #' res
 #' aio_call(res)
+#' res
 #'
 #' send_aio(s1, c(1.1, 2.2, 3.3), mode = "raw", timeout = 100)
 #' res <- recv_aio(s2, mode = "double", timeout = 100)
 #' aio_call(res)
+#' res
 #'
 #' send_aio(s1, "message 1", mode = "raw", timeout = 100)
 #' res <- recv_aio(s2, mode = "character", timeout = 100)
 #' aio_call(res)
+#' res$raw
+#' res$data
 #'
 #' close(s1)
 #' close(s2)
@@ -208,10 +211,9 @@ recv_aio <- function(socket,
   if (is.integer(aio)) {
     message(aio, " : ", nng_error(aio))
   } else {
-    attr(aio, "mode") <- mode
-    attr(aio, "keep.raw") <- missing(keep.raw) || isTRUE(keep.raw)
+    attr(aio, "callparams") <- list(mode, missing(keep.raw) || isTRUE(keep.raw))
   }
-  invisible(aio)
+  aio
 
 }
 
@@ -228,17 +230,24 @@ recv_aio <- function(socket,
 #'     the converted R object, or else just the converted R object depending on
 #'     the parameters set.
 #'
+#' @details For a 'recvAio', in case of an error in unserialisation or data
+#'     conversion, the received raw vector will be saved in $raw to allow the
+#'     data to be recovered.
+#'
 #' @examples
 #' s1 <- socket("pair", listen = "inproc://nanonext")
 #' s2 <- socket("pair", dial = "inproc://nanonext")
 #'
-#' status <- send_aio(s1, data.frame(a = 1, b = 2), timeout = 100)
-#' status
-#' aio_call(status)
-#'
-#' res <- recv_aio(s2, timeout = 100, keep.raw = FALSE)
+#' res <- send_aio(s1, data.frame(a = 1, b = 2), timeout = 100)
 #' res
 #' aio_call(res)
+#' res
+#' res$result
+#'
+#' res <- recv_aio(s2, timeout = 100)
+#' res
+#' aio_call(res)$data
+#' res
 #'
 #' close(s1)
 #' close(s2)
@@ -248,28 +257,36 @@ recv_aio <- function(socket,
 aio_call <- function(aio) {
 
   if (inherits(aio, "recvAio")) {
+
+    mode <- attr(aio, "callparams")[[1L]]
+    keep.raw <- attr(aio, "callparams")[[2L]]
     res <- .Call(rnng_aio_get_msg, aio)
+    if (keep.raw) attr(aio, "raw") <- res
     is.integer(res) && {
       message(res, " : ", nng_error(res))
-      return(invisible(res))
+      return(invisible(aio))
     }
-    on.exit(expr = return(res))
-    mode <- attr(aio, "mode")
+    on.exit(expr = {
+      attr(aio, "raw") <- res
+      return(invisible(aio))
+    })
     data <- switch(mode,
                    serial = unserialize(connection = res),
                    character = (r <- readBin(con = res, what = mode, n = length(res)))[r != ""],
                    raw = res,
                    readBin(con = res, what = mode, n = length(res)))
+    attr(aio, "data") <- data
     on.exit(expr = NULL)
-    if (attr(aio, "keep.raw")) list(raw = res, data = data) else data
+    invisible(aio)
 
   } else if (inherits(aio, "sendAio")) {
+
     res <- .Call(rnng_aio_result, aio)
+    attr(aio, "result") <- res
     if (res) {
       message(res, " : ", nng_error(res))
-      return(invisible(res))
     }
-    res
+    invisible(aio)
 
   } else {
     stop("this function may only be used on an Aio")