Support non-blocking (de)registration in the latest SewerRat API.

Author: LTLA

R/deregister.R

@@ -10,6 +10,9 @@
 #'
 #' @return On success, the directory is deregistered and NULL is invisibly returned.
 #'
+#' If \code{block=FALSE}, the function returns before confirmation of successful deregistration from the SewerRat API.
+#' This can be useful for asynchronous processing of directories with many files. 
+#'
 #' @author Aaron Lun
 #'
 #' @examples
@@ -27,12 +30,12 @@
 #' query("bar", url=info$url)
 #' @export
 #' @import httr2
-deregister <- function(dir, url, retry=3, wait=1) {
+deregister <- function(dir, url, retry=3, wait=1, block=TRUE) {
     dir <- clean_path(dir)
 
     req <- request(paste0(url, "/deregister/start"))
     req <- req_method(req, "POST")
-    req <- req_body_json(req, list(path=dir))
+    req <- req_body_json(req, list(path=dir, block=block))
     req <- redirect_post(req)
     req <- handle_error(req)
     res <- req_perform(req)
@@ -45,7 +48,7 @@ deregister <- function(dir, url, retry=3, wait=1) {
 
         req <- request(paste0(url, "/deregister/finish"))
         req <- req_method(req, "POST")
-        req <- req_body_json(req, list(path=dir))
+        req <- req_body_json(req, list(path=dir, block=block))
         req <- redirect_post(req)
         req <- handle_error(req)
         res <- req_perform(req)

R/register.R

@@ -8,10 +8,14 @@
 #' @param names Character vector containing the base names of the metadata files.
 #' @param url String containing the URL to the SewerRat REST API.
 #' @param retry,wait Deprecated arguments, ignored.
+#' @param block Logical scalar indicating whether to block on successful registration.
 #'
 #' @return On success, the directory is registered and NULL is invisibly returned.
 #' A warning is raised if any particular metadata file cannot be indexed.
 #'
+#' If \code{block=FALSE}, the function returns before confirmation of successful registration from the SewerRat API.
+#' This can be useful for asynchronous processing of directories with many files. 
+#'
 #' @author Aaron Lun
 #'
 #' @examples
@@ -28,7 +32,7 @@
 #' query("Aaron", url=info$url)
 #' @export
 #' @import httr2
-register <- function(dir, names, url, retry=3, wait=1) {
+register <- function(dir, names, url, retry=3, wait=1, block=TRUE) {
     dir <- clean_path(dir)
     stopifnot(length(names) > 0)
 
@@ -46,7 +50,7 @@ register <- function(dir, names, url, retry=3, wait=1) {
 
     req <- request(paste0(url, "/register/finish"))
     req <- req_method(req, "POST")
-    req <- req_body_json(req, list(path=dir, base=as.list(names)))
+    req <- req_body_json(req, list(path=dir, base=as.list(names), block=block))
     req <- redirect_post(req)
     req <- handle_error(req)
     res <- req_perform(req)

R/startSewerRat.R

@@ -25,7 +25,7 @@
 #' startSewerRat() # initialize a new instance.
 #' 
 #' @export
-startSewerRat <- function(db=tempfile(fileext=".sqlite3"), port=NULL, wait = 1, version = "1.1.0", overwrite = FALSE) {
+startSewerRat <- function(db=tempfile(fileext=".sqlite3"), port=NULL, wait = 1, version = "1.1.1", overwrite = FALSE) {
     if (!is.null(running$active)) {
         return(list(new=FALSE, port=running$port, url=assemble_url(running$port)))
     }

man/deregister.Rd

@@ -16,4 +16,29 @@ test_that("(de)registration works as expected", {
     expect_identical(length(res), 0L)
 })
 
+test_that("(de)registration works as expected when delayed", {
+    res <- query("aaron", url=info$url)
+    expect_identical(length(res), 0L)
+
+    register(mydir, "metadata.json", url=info$url, block=FALSE)
+    for (x in seq_len(10)) {
+        Sys.sleep(0.1)
+        res <- query("aaron", url=info$url)
+        if (length(res) == 1L) {
+            break
+        }
+    }
+    expect_identical(length(res), 1L)
+
+    deregister(mydir, url=info$url, block=FALSE)
+    for (x in seq_len(10)) {
+        Sys.sleep(0.1)
+        res <- query("aaron", url=info$url)
+        if (length(res) == 0L) {
+            break
+        }
+    }
+    expect_identical(length(res), 0L)
+})
+
 })()