Browse Source

pre-CRAN flight check

0.6.0
boB Rudis 1 year ago
parent
commit
34c15bb3f0
No known key found for this signature in database GPG Key ID: 1D7529BE14E2BBA9
4 changed files with 136 additions and 14 deletions
  1. +42
    -13
      R/docker-splash.r
  2. +90
    -0
      R/utils-safely.R
  3. +3
    -0
      man/install_splash.Rd
  4. +1
    -1
      man/start_splash.Rd

+ 42
- 13
R/docker-splash.r View File

@@ -2,6 +2,7 @@
#'
#' @md
#' @param tag Splash Docker image tag to install
#' @return a `docker_image` object or `NULL` if an error occurred.
#' @export
#' @family splash_docker_helpers
#' @examples \dontrun{
@@ -10,8 +11,22 @@
#' stop_splash(splash_container)
#' }
install_splash <- function(tag="latest") {

docker <- stevedore::docker_client()
res <- docker$image$pull("scrapinghub/splash", tag=tag, stream=stdout())

tryCatch(
docker$image$pull("scrapinghub/splash", tag=tag, stream=stdout()),
error = function(e) {
message("Error pulling image from DockerHub.\n", e)
return(NULL)
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
) -> res

invisible(res)

}

#' Start a Splash server Docker container
@@ -33,7 +48,7 @@ install_splash <- function(tag="latest") {
#' Defaults to `FALSE`.
#' @param ... passed on to Splash instance launch parameters
#' @family splash_docker_helpers
#' @return `stevedor` container object
#' @return `stevedore` container object
#' @export
#' @examples \dontrun{
#' install_splash()
@@ -44,15 +59,24 @@ start_splash <- function(tag="latest", container_name = "splashr", remove=FALSE,

docker <- stevedore::docker_client()

docker$container$run(
image = sprintf("scrapinghub/splash:%s", tag),
name = container_name,
ports = c("5023:5023", "8051:8051", "8050:8050"),
detach = TRUE,
rm = remove,
tty = TRUE,
"--disable-browser-caches",
...
tryCatch(
docker$container$run(
image = sprintf("scrapinghub/splash:%s", tag),
name = container_name,
ports = c("5023:5023", "8051:8051", "8050:8050"),
detach = TRUE,
rm = remove,
tty = TRUE,
"--disable-browser-caches",
...
),
error = function(e) {
message("Error pulling image from DockerHub.")
return(NULL)
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
) -> splash_inst

invisible(splash_inst)
@@ -73,8 +97,10 @@ start_splash <- function(tag="latest", container_name = "splashr", remove=FALSE,
#' stop_splash(splash_container)
#' }
stop_splash <- function(splash_container) {
splash_container$stop()
splash_container$remove()
if (inherits(splash_container, "stevedore_object")) {
splash_container$stop()
splash_container$remove()
}
invisible(NULL)
}

@@ -90,7 +116,9 @@ stop_splash <- function(splash_container) {
killall_splash <- function() {

docker <- stevedore::docker_client()

x <- docker$container$list(all=TRUE)

for (i in 1:nrow(x)) {
if (grepl("bin/splash", x$command[i])) {
message(sprintf("Pruning: %s...", x$id[i]))
@@ -101,6 +129,7 @@ killall_splash <- function() {
}
}
}

}




+ 90
- 0
R/utils-safely.R View File

@@ -0,0 +1,90 @@
# Less cool counterparts to purrr's side-effect capture-rs
#
# Most of the helper functions are 100% from output.R in purrr repo
#
# @param quiet Hide errors (`TRUE`, the default), or display them
# as they occur?
# @param otherwise Default value to use when an error occurs.
#
# @return `safely`: wrapped function instead returns a list with
# components `result` and `error`. One value is always `NULL`.
#
# `quietly`: wrapped function instead returns a list with components
# `result`, `output`, `messages` and `warnings`.
#
# `possibly`: wrapped function uses a default value (`otherwise`)
# whenever an error occurs.
safely <- function(.f, otherwise = NULL, quiet = TRUE) {
function(...) capture_error(.f(...), otherwise, quiet)
}

quietly <- function(.f) {
function(...) capture_output(.f(...))
}

possibly <- function(.f, otherwise, quiet = TRUE) {
force(otherwise)
function(...) {
tryCatch(.f(...),
error = function(e) {
if (!quiet)
message("Error: ", e$message)
otherwise
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
)
}
}

capture_error <- function(code, otherwise = NULL, quiet = TRUE) {
tryCatch(
list(result = code, error = NULL),
error = function(e) {
if (!quiet)
message("Error: ", e$message)

list(result = otherwise, error = e)
},
interrupt = function(e) {
stop("Terminated by user", call. = FALSE)
}
)
}

capture_output <- function(code) {
warnings <- character()
wHandler <- function(w) {
warnings <<- c(warnings, w$message)
invokeRestart("muffleWarning")
}

messages <- character()
mHandler <- function(m) {
messages <<- c(messages, m$message)
invokeRestart("muffleMessage")
}

temp <- file()
sink(temp)
on.exit({
sink()
close(temp)
})

result <- withCallingHandlers(
code,
warning = wHandler,
message = mHandler
)

output <- paste0(readLines(temp, warn = FALSE), collapse = "\n")

list(
result = result,
output = output,
warnings = warnings,
messages = messages
)
}

+ 3
- 0
man/install_splash.Rd View File

@@ -9,6 +9,9 @@ install_splash(tag = "latest")
\arguments{
\item{tag}{Splash Docker image tag to install}
}
\value{
a \code{docker_image} object or \code{NULL} if an error occurred.
}
\description{
Retrieve the Docker image for Splash
}


+ 1
- 1
man/start_splash.Rd View File

@@ -18,7 +18,7 @@ Defaults to `FALSE`.}
\item{...}{passed on to Splash instance launch parameters}
}
\value{
`stevedor` container object
`stevedore` container object
}
\description{
If using this in an automation context, you should consider adding a


Loading…
Cancel
Save