renv_system_exec <- function(command,
args = NULL,
action = "executing command",
success = 0L,
stream = FALSE,
quiet = NULL)
{
# be quiet when running tests by default
quiet <- quiet %||% renv_tests_running()
# handle 'stream' specially
if (stream) {
# form stdout, stderr
stdout <- stderr <- if (quiet) FALSE else ""
# execute command
status <- suppressWarnings(
if (is.null(args))
system(command, ignore.stdout = quiet, ignore.stderr = quiet)
else
system2(command, args, stdout = stdout, stderr = stderr)
)
# check for error
status <- status %||% 0L
if (!is.null(success) && !status %in% success) {
fmt <- "error %s [error code %i]"
stopf(fmt, action, status)
}
# return status code
return(status)
}
# suppress warnings as some successful commands may return a non-zero exit
# code, whereas R will always warn on such error codes
output <- suppressWarnings(
if (is.null(args))
system(command, intern = TRUE)
else
system2(command, args, stdout = TRUE, stderr = TRUE)
)
# extract status code from result
status <- attr(output, "status") %||% 0L
# if this status matches an expected 'success' code, return output
if (is.null(success) || status %in% success)
return(output)
# otherwise, notify the user that things went wrong
abort(
sprintf("error %s [error code %i]", action, status),
body = renv_system_exec_details(command, args, output)
)
}
renv_system_exec_details <- function(command, args, output) {
# get header, giving the command that was run
cmdline <- paste(command, paste(args, collapse = " "))
underline <- paste(rep.int("=", min(80L, nchar(cmdline))), collapse = "")
header <- c(cmdline, underline)
# truncate output (avoid overwhelming console)
body <- if (length(output) > 200L)
c(head(output, n = 100L), "< ... >", tail(output, n = 100L))
else
output
c(header, "", body)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.