add is_nano, is_aio & remove deprecated funcs

Author: shikokuchuo

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: nanonext
 Type: Package
 Title: NNG (Nanomsg Next Gen) Lightweight Messaging Library
-Version: 0.4.0
+Version: 0.4.0.9000
 Description: R binding for NNG (Nanomsg Next Gen), a successor to ZeroMQ. NNG is 
     a socket library providing high-performance scalability protocols,
     implementing a cross-platform standard for messaging and communications.

NAMESPACE

@@ -1,6 +1,7 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method("$",nano)
+S3method("$<-",nano)
 S3method("$<-",nanoObject)
 S3method("$<-",recvAio)
 S3method("$<-",sendAio)
@@ -47,10 +48,11 @@ export(.mirai_scm)
 export(call_aio)
 export(context)
 export(dial)
+export(is_aio)
 export(is_error_value)
+export(is_nano)
 export(is_nul_byte)
 export(listen)
-export(logging)
 export(messenger)
 export(nano)
 export(nano_init)
@@ -59,12 +61,10 @@ export(nng_error)
 export(nng_version)
 export(recv)
 export(recv_aio)
-export(recv_ctx)
 export(reply)
 export(request)
 export(send)
 export(send_aio)
-export(send_ctx)
 export(setopt)
 export(socket)
 export(stop_aio)

NEWS.md

@@ -1,3 +1,14 @@
+# nanonext 0.4.0.9000 (under development)
+
+#### New Features
+
+* Added convenience auxiliary functions `is_nano()` and `is_aio()`.
+
+#### Updates
+
+* Deprecated `send_ctx()`, `recv_ctx()` and logging are removed.
+* Internal performance optimisations.
+
 # nanonext 0.4.0
 
 #### New Features

R/context.R

@@ -21,9 +21,8 @@
 #'
 #'     Note: not every protocol supports creation of separate contexts.
 #'
-#'     To send and receive over a context use \code{\link{send_ctx}} and
-#'     \code{\link{recv_ctx}} respectively. It is also possible to perform async
-#'     send and receive over a context using \code{\link{send_aio}} and
+#'     To send and receive over a context use \code{\link{send}} and
+#'     \code{\link{recv}} or their async counterparts \code{\link{send_aio}} and
 #'     \code{\link{recv_aio}}.
 #'
 #' @examples
@@ -125,9 +124,7 @@ reply <- function(context,
   data <- execute(data, ...)
   data <- encode(data = data, mode = send_mode)
   on.exit()
-  res <- .Call(rnng_ctx_send, context, data, timeout)
-  is.integer(res) && return(invisible(res))
-  invisible(0L)
+  invisible(.Call(rnng_ctx_send, context, data, timeout))
 
 }
 
@@ -257,80 +254,3 @@ request <- function(context,
 
 }
 
-# Deprecated - do not use ------------------------------------------------------
-
-#' Send over Context
-#'
-#' Send data over a Context [Deprecated].
-#'
-#' @param context a Context.
-#' @inheritParams send
-#' @inheritParams send_aio
-#'
-#' @return Raw vector of sent data, or (invisibly) an integer exit code (zero on
-#'     success) if 'echo' is set to FALSE.
-#'
-#' @details Will block if the send is in progress and has not yet completed -
-#'     certain protocol / transport combinations may limit the number of messages
-#'     that can be queued if they have yet to be received. Set a timeout to
-#'     ensure the function returns under all scenarios.
-#'
-#' @keywords internal
-#' @export
-#'
-send_ctx <- function(context, data, mode = c("serial", "raw"), timeout = -2L, echo = TRUE) {
-
-  mode <- match.arg2(mode, c("serial", "raw"))
-  force(data)
-  data <- encode(data = data, mode = mode)
-  res <- .Call(rnng_ctx_send, context, data, timeout)
-  is.integer(res) && return(invisible(res))
-  if (missing(echo) || isTRUE(echo)) res else invisible(0L)
-
-}
-
-#' Receive over Context
-#'
-#' Receive data over a Context [Deprecated].
-#'
-#' @param context a Context.
-#' @inheritParams recv
-#' @inheritParams send_aio
-#'
-#' @return Named list of 2 elements: 'raw' containing the received raw vector
-#'     and 'data' containing the converted object, or else the converted object
-#'     if 'keep.raw' is set to FALSE.
-#'
-#' @details 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, an integer 'errorValue' is returned (to be
-#'     distiguishable from an integer message value). This can be verified using
-#'     \code{\link{is_error_value}}.
-#'
-#'     If the raw data was successfully received but an error occurred in
-#'     unserialisation or data conversion (for example if the incorrect mode was
-#'     specified), the received raw vector will always be returned to allow for
-#'     the data to be recovered.
-#'
-#' @keywords internal
-#' @export
-#'
-recv_ctx <- function(context,
-                     mode = c("serial", "character", "complex", "double",
-                              "integer", "logical", "numeric", "raw"),
-                     timeout = -2L,
-                     keep.raw = TRUE) {
-
-  mode <- match.arg2(mode, c("serial", "character", "complex", "double",
-                             "integer", "logical", "numeric", "raw"))
-  res <- .Call(rnng_ctx_recv, context, timeout)
-  is.integer(res) && return(invisible(res))
-  on.exit(expr = return(res))
-  data <- decode(con = res, mode = mode)
-  on.exit()
-  missing(data) && return(.Call(rnng_scm))
-  if (missing(keep.raw) || isTRUE(keep.raw)) list(raw = res, data = data) else data
-
-}
-

R/listdial.R

@@ -73,18 +73,14 @@ dial <- function(socket,
                  url = "inproc://nanonext",
                  autostart = TRUE) {
 
-  if (missing(autostart) || isTRUE(autostart)) {
-    res <- .Call(rnng_dial, socket, url)
-    is.integer(res) && return(invisible(res))
-    if (.logging.) loginfo(evt = "dial start", pkey = "sock", pval = attr(res, "socket"),
-                           skey = "url", sval = url)
-
+  res <- if (missing(autostart) || isTRUE(autostart)) {
+    .Call(rnng_dial, socket, url)
   } else {
-    res <- .Call(rnng_dialer_create, socket, url)
-    is.integer(res) && return(invisible(res))
-
+    .Call(rnng_dialer_create, socket, url)
   }
 
+  is.integer(res) && return(invisible(res))
+
   if (is.environment(socket)) {
 
     socket[["dialer"]] <- c(.subset2(socket, "dialer"), res)
@@ -181,18 +177,14 @@ listen <- function(socket,
                    url = "inproc://nanonext",
                    autostart = TRUE) {
 
-  if (missing(autostart) || isTRUE(autostart)) {
-    res <- .Call(rnng_listen, socket, url)
-    is.integer(res) && return(invisible(res))
-    if (.logging.) loginfo(evt = "list start", pkey = "sock", pval = attr(res, "socket"),
-                           skey = "url", sval = url)
-
+  res <- if (missing(autostart) || isTRUE(autostart)) {
+    .Call(rnng_listen, socket, url)
   } else {
-    res <- .Call(rnng_listener_create, socket, url)
-    is.integer(res) && return(invisible(res))
-
+    .Call(rnng_listener_create, socket, url)
   }
 
+  is.integer(res) && return(invisible(res))
+
   if (is.environment(socket)) {
 
     socket[["listener"]] <- c(.subset2(socket, "listener"), res)

R/methods.R

@@ -26,10 +26,6 @@ NULL
 #'
 start.nanoListener <- function(x, ...) {
 
-  if (.logging.) {
-    loginfo(evt = "list start", pkey = "sock", pval = attr(x, "socket"),
-            skey = "url", sval = attr(x, "url"))
-  }
   invisible(.Call(rnng_listener_start, x))
 
 }
@@ -40,10 +36,6 @@ start.nanoListener <- function(x, ...) {
 #'
 start.nanoDialer <- function(x, async = TRUE, ...) {
 
-  if (.logging.) {
-    loginfo(evt = "dial start", pkey = "sock", pval = attr(x, "socket"),
-            skey = "url", sval = attr(x, "url"))
-  }
   invisible(.Call(rnng_dialer_start, x, async))
 
 }
@@ -83,10 +75,6 @@ NULL
 #'
 close.nanoSocket <- function(con, ...) {
 
-  if (.logging.) {
-    loginfo(evt = "sock close", pkey = "id", pval = attr(con, "id"),
-            skey = "protocol", sval = attr(con, "protocol"))
-  }
   invisible(.Call(rnng_close, con))
 
 }
@@ -107,10 +95,6 @@ close.nanoContext <- function(con, ...) {
 #'
 close.nanoDialer <- function(con, ...) {
 
-  if (.logging.) {
-    loginfo(evt = "dial close", pkey = "sock", pval = attr(con, "socket"),
-            skey = "url", sval = attr(con, "url"))
-  }
   invisible(.Call(rnng_dialer_close, con))
 
 }
@@ -121,10 +105,6 @@ close.nanoDialer <- function(con, ...) {
 #'
 close.nanoListener <- function(con, ...) {
 
-  if (.logging.) {
-    loginfo(evt = "list close", pkey = "sock", pval = attr(con, "socket"),
-            skey = "url", sval = attr(con, "url"))
-  }
   invisible(.Call(rnng_listener_close, con))
 
 }
@@ -135,10 +115,6 @@ close.nanoListener <- function(con, ...) {
 #'
 close.nanoStream <- function(con, ...) {
 
-  pkey <- if (is.null(attr(con, "dialer"))) "list" else "dial"
-  sval <- attr(con, "url")
-  if (.logging.) loginfo(evt = "stream close", pkey = pkey, pval = 1,
-                         skey = "url", sval = sval)
   invisible(.Call(rnng_stream_close, con))
 
 }

R/nano.R

@@ -267,6 +267,12 @@ print.sendAio <- function(x, ...) {
 
 }
 
+#' @export
+#'
+`$<-.nano` <- function(x, name, value) {
+  x
+}
+
 #' @export
 #'
 `$<-.nanoObject` <- function(x, name, value) {

R/nanonext-package.R

@@ -126,14 +126,6 @@
 #'
 NULL
 
-.onLoad <- function(libname, pkgname) {
-  .logging. <- switch(tolower(Sys.getenv("NANONEXT_LOG")),
-                              info = TRUE,
-                              FALSE)
-  .logging. <<- .logging.
-  invisible()
-}
-
 .onUnload <- function(libpath) {
   if (!is.null(warn <- getOption("nanonext.original.warn"))) {
     options(warn = warn)
@@ -142,4 +134,3 @@ NULL
   invisible()
 }
 
-.logging. <- FALSE

R/protocol.R

@@ -38,10 +38,6 @@
 #'
 subscribe <- function(socket, topic = NULL) {
 
-  if (.logging.) {
-    loginfo(evt = "subscribe", pkey = "sock", pval = attr(socket, "id"),
-            skey = "topic", sval = if (is.null(topic)) "ALL" else topic)
-  }
   invisible(.Call(rnng_socket_set, socket, 5L, "sub:subscribe", topic))
 
 }
@@ -88,10 +84,6 @@ subscribe <- function(socket, topic = NULL) {
 #'
 unsubscribe <- function(socket, topic = NULL) {
 
-  if (.logging.) {
-    loginfo(evt = "unsubscribe", pkey = "sock", pval = attr(socket, "id"),
-            skey = "topic", sval = if (is.null(topic)) "ALL" else topic)
-  }
   invisible(.Call(rnng_socket_set, socket, 5L, "sub:unsubscribe", topic))
 
 }
@@ -140,10 +132,6 @@ unsubscribe <- function(socket, topic = NULL) {
 #'
 survey_time <- function(socket, time) {
 
-  if (.logging.) {
-    loginfo(evt = "survey", pkey = "sock", pval = attr(socket, "id"),
-            skey = "set time", sval = as.character(time))
-  }
   invisible(.Call(rnng_socket_set, socket, 3L, "surveyor:survey-time", time))
 
 }

R/sendrecv.R

@@ -78,8 +78,8 @@ send.nanoSocket <- function(con,
   force(data)
   data <- encode(data = data, mode = mode)
   res <- .Call(rnng_send, con, data, block)
-  is.integer(res) && return(invisible(res))
-  if (missing(echo) || isTRUE(echo)) res else invisible(0L)
+  res && return(invisible(res))
+  if (missing(echo) || isTRUE(echo)) data else invisible(res)
 
 }
 
@@ -98,8 +98,8 @@ send.nanoContext <- function(con,
   data <- encode(data = data, mode = mode)
   if (missing(block) || isTRUE(block)) block <- -2L
   res <- .Call(rnng_ctx_send, con, data, block)
-  is.integer(res) && return(invisible(res))
-  if (missing(echo) || isTRUE(echo)) res else invisible(0L)
+  res && return(invisible(res))
+  if (missing(echo) || isTRUE(echo)) data else invisible(res)
 
 }
 
@@ -117,8 +117,8 @@ send.nanoStream <- function(con,
   data <- encode(data = data, mode = 2L)
   if (missing(block) || isTRUE(block)) block <- -2L
   res <- .Call(rnng_stream_send, con, data, block)
-  is.integer(res) && return(invisible(res))
-  if (missing(echo) || isTRUE(echo)) res else invisible(0L)
+  res && return(invisible(res))
+  if (missing(echo) || isTRUE(echo)) data else invisible(res)
 
 }