Add threaded timer, decrease verbosity, reimplement Aios as environments

Author: shikokuchuo

NAMESPACE

@@ -33,6 +33,7 @@ export(listen)
 export(nano)
 export(ncurl)
 export(nng_error)
+export(nng_timer)
 export(nng_version)
 export(recv)
 export(recv_aio)

NEWS.md

@@ -6,9 +6,11 @@
 * New `ctx_rep()` and `ctx_req()` functions implement the full logic of an RPC server/client. Designed to be run in separate processes, the server will await data and apply an arbitrary function before returning a result, whilst the client will send data to the server and await a response.
 * New `ncurl()` minimalistic http(s) client.
 * Allows setting the environment variable 'NANONEXT_TLS' prior to package installation to enable TLS where the system NNG library has been built with TLS support (using Mbed TLS).
+* New `nng_timer()` utility as a demonstration of NNG's multithreading capabilities.
 
 #### Updates
 
+* Successful starts of dialers/listeners and successful close operations no longer print a message to stdout for less verbosity by default. The state of respective objects can always be queried by their state attribute using `$state`
 * All send and receive functions, e.g. `send()`/`recv()`, gain a revised 'mode' argument. This now permits the choice of whether to use R serialization, consolidating the functionality of the '_vec' series of functions.
 * Functions 'send_vec' and 'recv_vec' are deprecated and will be removed in a future release.
 

R/aio.R

@@ -45,32 +45,31 @@ 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
+    mode <- aio[["callparams"]][[1L]]
+    keep.raw <- aio[["callparams"]][[2L]]
+    res <- .Call(rnng_aio_get_msg, aio[["aio"]])
+    if (keep.raw) aio[["raw"]] <- res
     is.integer(res) && {
       message(res, " : ", nng_error(res))
       return(invisible(aio))
     }
     on.exit(expr = {
-      attr(aio, "raw") <- res
+      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)))
-    if (is.null(data)) data <- list(NULL)
-    attr(aio, "data") <- data
+    aio[["data"]] <- data
     on.exit(expr = NULL)
     invisible(aio)
 
   } else if (inherits(aio, "sendAio")) {
 
-    res <- .Call(rnng_aio_result, aio)
-    attr(aio, "result") <- res
+    res <- .Call(rnng_aio_result, aio[["aio"]])
+    aio[["result"]] <- res
     if (res) {
       message(res, " : ", nng_error(res))
     }
@@ -99,7 +98,7 @@ aio_call <- function(aio) {
 #'
 aio_stop <- function(aio) {
 
-  invisible(.Call(rnng_aio_stop, aio))
+  invisible(.Call(rnng_aio_stop, aio[["aio"]]))
 
 }
 

R/listdial.R

@@ -81,7 +81,6 @@ dial <- function(socket,
         message(res, " : ", nng_error(res))
         return(res)
       }
-      message("dialer started...")
     } else {
       res <- .Call(rnng_dialer_create, socket[["socket"]], url)
       if (is.integer(res)) {
@@ -107,7 +106,6 @@ dial <- function(socket,
         message(res, " : ", nng_error(res))
         return(res)
       }
-      message("dialer started...")
     } else {
       res <- .Call(rnng_dialer_create, socket, url)
       if (is.integer(res)) {
@@ -204,7 +202,6 @@ listen <- function(socket,
         message(res, " : ", nng_error(res))
         return(res)
       }
-      message("listener started...")
     } else {
       res <- .Call(rnng_listener_create, socket[["socket"]], url)
       if (is.integer(res)) {
@@ -230,7 +227,6 @@ listen <- function(socket,
         message(res, " : ", nng_error(res))
         return(res)
       }
-      message("listener started...")
     } else {
       res <- .Call(rnng_listener_create, socket, url)
       if (is.integer(res)) {

R/methods.R

@@ -27,7 +27,7 @@ NULL
 start.nanoListener <- function(x, ...) {
 
   xc <- .Call(rnng_listener_start, x)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("listener started...")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }
@@ -39,7 +39,7 @@ start.nanoListener <- function(x, ...) {
 start.nanoDialer <- function(x, async = TRUE, ...) {
 
   xc <- .Call(rnng_dialer_start, x, async)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("dialer started...")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }
@@ -76,7 +76,7 @@ NULL
 close.nanoSocket <- function(con, ...) {
 
   xc <- .Call(rnng_close, con)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("socket closed")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }
@@ -88,7 +88,7 @@ close.nanoSocket <- function(con, ...) {
 close.nanoContext <- function(con, ...) {
 
   xc <- .Call(rnng_ctx_close, con)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("context closed")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }
@@ -100,7 +100,7 @@ close.nanoContext <- function(con, ...) {
 close.nanoDialer <- function(con, ...) {
 
   xc <- .Call(rnng_dialer_close, con)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("dialer closed")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }
@@ -112,7 +112,7 @@ close.nanoDialer <- function(con, ...) {
 close.nanoListener <- function(con, ...) {
 
   xc <- .Call(rnng_listener_close, con)
-  if (xc) message(xc, " : ", nng_error(xc)) else message("listener closed")
+  if (xc) message(xc, " : ", nng_error(xc))
   invisible(xc)
 
 }

R/nano.R

@@ -209,13 +209,13 @@ print.nanoListener <- function(x, ...) {
 print.recvAio <- function(x, ...) {
 
   cat("< recvAio >\n")
-  is.null(attr(x, "raw")) && is.null(attr(x, "data")) && {
+  is.null(x[["raw"]]) && is.null(x[["data"]]) && {
     cat(": use aio_call() to retrieve message\n")
     return(invisible(x))
   }
-  if (!is.null(attr(x, "raw")))
+  if (!is.null(x[["raw"]]))
     cat(" - $raw for raw message\n")
-  if (!is.null(attr(x, "data")))
+  if (!is.null(x[["data"]]))
     cat(" - $data for message data\n")
   invisible(x)
 
@@ -226,7 +226,7 @@ print.recvAio <- function(x, ...) {
 print.sendAio <- function(x, ...) {
 
   cat("< sendAio >\n")
-  if (is.null(attr(x, "result"))) {
+  if (is.null(x[["result"]])) {
     cat(": use aio_call() to retrieve result\n")
   } else {
     cat(" - $result for send result\n")

R/sendrecv.R

@@ -58,7 +58,7 @@ send <- function(socket,
 #' @param timeout in ms. If unspecified, a socket-specific default timeout will
 #'     be used.
 #'
-#' @return A send Aio (object of class 'sendAio' and 'nano').
+#' @return A send Aio (object of class 'sendAio').
 #'
 #' @details Async send is always non-blocking. To wait for and check the result
 #'     of the send operation, use \code{\link{aio_call}} on the returned 'sendAio'
@@ -71,7 +71,7 @@ send <- function(socket,
 #' aio
 #' aio_call(aio)$result
 #'
-#' aio <- send_aio(pub, "message 1", mode = "raw", timeout = 100)
+#' aio <- send_aio(pub, "example message", mode = "raw", timeout = 100)
 #' aio_call(aio)$result
 #'
 #' close(pub)
@@ -86,9 +86,11 @@ send_aio <- function(socket, data, mode = c("serial", "raw"), timeout) {
   data <- switch(mode,
                  serial = serialize(object = data, connection = NULL),
                  raw = if (is.raw(data)) data else writeBin(object = data, con = raw()))
+  env <- `class<-`(new.env(), "sendAio")
   aio <- .Call(rnng_send_aio, socket, data, timeout)
+  env[["aio"]] <- aio
   if (is.integer(aio)) message(aio, " : ", nng_error(aio))
-  invisible(aio)
+  invisible(env)
 
 }
 
@@ -128,7 +130,7 @@ send_aio <- function(socket, data, mode = c("serial", "raw"), timeout) {
 #' send(s1, c(1.1, 2.2, 3.3), mode = "raw")
 #' res <- recv(s2, mode = "double")
 #' res
-#' send(s1, "example test", mode = "raw", echo = FALSE)
+#' send(s1, "example message", mode = "raw", echo = FALSE)
 #' recv(s2, mode = "character", keep.raw = FALSE)
 #'
 #' close(s1)
@@ -167,7 +169,7 @@ recv <- function(socket,
 #' @inheritParams recv
 #' @inheritParams send_aio
 #'
-#' @return A recv Aio (object of class 'recvAio' and 'nano').
+#' @return A recv Aio (object of class 'recvAio').
 #'
 #' @details Async receive is always non-blocking. To wait for the AIO to complete
 #'     and retrieve the received message, use \code{\link{aio_call}} on the
@@ -188,7 +190,7 @@ recv <- function(socket,
 #' aio_call(res)
 #' res
 #'
-#' send_aio(s1, "message 1", mode = "raw", timeout = 100)
+#' send_aio(s1, "example message", mode = "raw", timeout = 100)
 #' res <- recv_aio(s2, mode = "character", timeout = 100)
 #' aio_call(res)
 #' res$raw
@@ -207,13 +209,15 @@ recv_aio <- function(socket,
 
   mode <- match.arg(mode)
   if (missing(timeout)) timeout <- -2L
+  env <- `class<-`(new.env(), "recvAio")
   aio <- .Call(rnng_recv_aio, socket, timeout)
+  env[["aio"]] <- aio
   if (is.integer(aio)) {
     message(aio, " : ", nng_error(aio))
   } else {
-    attr(aio, "callparams") <- list(mode, missing(keep.raw) || isTRUE(keep.raw))
+    env[["callparams"]] <- list(mode, missing(keep.raw) || isTRUE(keep.raw))
   }
-  aio
+  invisible(env)
 
 }
 

R/utils.R

@@ -45,6 +45,34 @@ nng_error <- function(error) {
 
 }
 
+#' Timer Utility
+#'
+#' Set a timer (stopwatch). Will print a message to the console (stdout) upon
+#'     completion.
+#'
+#' @param time time in ms. Non-integer values will be translated to integer using
+#'     \code{as.integer()}.
+#'
+#' @return An external pointer to the thread created by this function.
+#'
+#' @details The return value of this function should not normally be assigned as
+#'     this preserves the thread instead of it being automatically reaped during
+#'     garbage collection.
+#'
+#'     As reaping the thread waits until the timer has completed, a
+#'     possible side effect is blocking garbage collection until this has happened
+#'     (not guaranteed, as garbage collection may happen on other objects first).
+#'     If this is undesirable, assign the external pointer to an object and then
+#'     remove it after completion.
+#'
+#' @export
+#'
+nng_timer <- function(time) {
+
+  invisible(.Call(rnng_threaded_timer, as.integer(time)))
+
+}
+
 #' ncurl
 #'
 #' nano cURL - a minimalistic http(s) client.