peilaus alkaen https://git.sr.ht/~hrbrmstr/splashr
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
179 rivejä
4.3 KiB
179 rivejä
4.3 KiB
splash_url <- function(splash_obj) { sprintf("http://%s:%s", splash_obj$host, splash_obj$port) }
|
|
|
|
#' Configure parameters for connecting to a Splash server
|
|
#'
|
|
#'
|
|
#' @md
|
|
#' @note There is a quick "helper" object named `splash_local` which is preconfigured
|
|
#' with `localhost` as the host name.
|
|
#' @param host host or IP address
|
|
#' @param port port the server is running on (default is 8050)
|
|
#' @param user,pass leave `NULL` if basic auth is not configured. Otherwise,
|
|
#' fill in what you need for basic authentication.
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' }
|
|
splash <- function(host, port=8050L, user=NULL, pass=NULL) {
|
|
obj <- list(host=host, port=port, user=user, pass=pass)
|
|
class(obj) <- c("splashr", "list")
|
|
obj
|
|
}
|
|
|
|
#' Print for splashr
|
|
#'
|
|
#' @md
|
|
#' @param x a splashr object
|
|
#' @param ... unused
|
|
#' @keywords internal
|
|
#' @return x
|
|
#' @export
|
|
print.splashr <- function(x, ...) {
|
|
|
|
cat(
|
|
"<splashr instance connection; ",
|
|
if (length(x$user)) sprintf("%s@", x$user) else "",
|
|
x$host, ":", x$port, ">\n", sep=""
|
|
)
|
|
|
|
invisible(x)
|
|
|
|
}
|
|
|
|
#' @rdname splash
|
|
#' @export
|
|
splash_local <- splash("localhost")
|
|
|
|
s_GET <- purrr::safely(GET)
|
|
|
|
#' Test if a Splash server is up
|
|
#'
|
|
#' @md
|
|
#' @param splash_obj A splash connection object
|
|
#' @family splash_info_functions
|
|
#' @return `TRUE` if Slash server is running, otherwise `FALSE`
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' splash_active(sp)
|
|
#' }
|
|
splash_active <- function(splash_obj = splash_local) {
|
|
|
|
if (is.null(splash_obj$user)) {
|
|
res <- s_GET(splash_url(splash_obj), path="_ping")
|
|
} else {
|
|
res <- s_GET(splash_url(splash_obj), path="_ping",
|
|
httr::authenticate(splash_obj$user, splash_obj$pass))
|
|
}
|
|
|
|
if (is.null(res$result)) return(FALSE)
|
|
if (httr::status_code(res$result) >=300) return(FALSE)
|
|
|
|
httr::content(res$result, as="text", encoding="UTF-8") %>%
|
|
jsonlite::fromJSON() -> out
|
|
|
|
out$url <- splash_url(splash_obj)
|
|
|
|
message(sprintf("Status of splash instance on [%s]: %s. Max RSS: %s Mb\n",
|
|
out$url, out$status, scales::comma(out$maxrss/1024/1024)))
|
|
|
|
if ("status" %in% names(out)) return(out$status == "ok")
|
|
|
|
return(FALSE)
|
|
|
|
}
|
|
|
|
#' Get Splash version information
|
|
#'
|
|
#' @param splash_obj A splash connection object
|
|
#' @family splash_info_functions
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' splash_version(sp)
|
|
#' }
|
|
splash_version <- function(splash_obj = splash_local) {
|
|
execute_lua(splash_obj, '
|
|
function main(splash)
|
|
return splash:get_version()
|
|
end
|
|
') -> res
|
|
jsonlite::fromJSON(rawToChar(res))
|
|
}
|
|
|
|
#' Get information about requests/responses for the pages loaded
|
|
#'
|
|
#' @param splash_obj A splash connection object
|
|
#' @family splash_info_functions
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' splash_history(sp)
|
|
#' }
|
|
splash_history <- function(splash_obj = splash_local) {
|
|
execute_lua(splash_obj, '
|
|
function main(splash)
|
|
return splash:history()
|
|
end
|
|
') -> res
|
|
jsonlite::fromJSON(rawToChar(res))
|
|
}
|
|
|
|
|
|
#' Get Splash performance-related statistics
|
|
#'
|
|
#' @param splash_obj A splash connection object
|
|
#' @family splash_info_functions
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' splash_perf_stats(sp)
|
|
#' }
|
|
splash_perf_stats <- function(splash_obj = splash_local) {
|
|
execute_lua(splash_obj, '
|
|
function main(splash)
|
|
return splash:get_perf_stats()
|
|
end
|
|
') -> res
|
|
jsonlite::fromJSON(rawToChar(res))
|
|
}
|
|
|
|
#' Retrieve debug-level info for a Splash server
|
|
#'
|
|
#' @param splash_obj A splash connection object
|
|
#' @family splash_info_functions
|
|
#' @export
|
|
#' @examples \dontrun{
|
|
#' sp <- splash()
|
|
#' splash_debug(sp)
|
|
#' }
|
|
splash_debug <- function(splash_obj = splash_local) {
|
|
|
|
if (is.null(splash_obj$user)) {
|
|
httr::GET(splash_url(splash_obj), path="_debug") %>%
|
|
httr::stop_for_status() %>%
|
|
httr::content(as="text", encoding="UTF-8") %>%
|
|
jsonlite::fromJSON() -> out
|
|
} else {
|
|
httr::GET(splash_url(splash_obj), path="_debug",
|
|
httr::authenticate(splash_obj$user, splash_obj$pass)) %>%
|
|
httr::stop_for_status() %>%
|
|
httr::content(as="text", encoding="UTF-8") %>%
|
|
jsonlite::fromJSON() -> out
|
|
}
|
|
|
|
out$url <- splash_url(splash_obj)
|
|
|
|
class(out) <- c("splash_debug", class(out))
|
|
|
|
out
|
|
|
|
}
|
|
|
|
#' @rdname splash_debug
|
|
#' @keywords internal
|
|
#' @export
|
|
print.splash_debug <- function(x, ...) {
|
|
print(str(x))
|
|
invisible(x)
|
|
}
|
|
|