R/splashr.r

In hrbrmstr/splashr: Tools to Work with the 'Splash' 'JavaScript' Rendering and Scraping Service

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)
}