Tools to Work with the 'Splash' JavaScript Rendering Service in R
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.

180 lines
4.3KB

  1. splash_url <- function(splash_obj) { sprintf("http://%s:%s", splash_obj$host, splash_obj$port) }
  2. #' Configure parameters for connecting to a Splash server
  3. #'
  4. #'
  5. #' @md
  6. #' @note There is a quick "helper" object named `splash_local` which is preconfigured
  7. #' with `localhost` as the host name.
  8. #' @param host host or IP address
  9. #' @param port port the server is running on (default is 8050)
  10. #' @param user,pass leave `NULL` if basic auth is not configured. Otherwise,
  11. #' fill in what you need for basic authentication.
  12. #' @export
  13. #' @examples \dontrun{
  14. #' sp <- splash()
  15. #' }
  16. splash <- function(host, port=8050L, user=NULL, pass=NULL) {
  17. obj <- list(host=host, port=port, user=user, pass=pass)
  18. class(obj) <- c("splashr", "list")
  19. obj
  20. }
  21. #' Print for splashr
  22. #'
  23. #' @md
  24. #' @param x a splashr object
  25. #' @param ... unused
  26. #' @keywords internal
  27. #' @return x
  28. #' @export
  29. print.splashr <- function(x, ...) {
  30. cat(
  31. "<splashr instance connection; ",
  32. if (length(x$user)) sprintf("%s@", x$user) else "",
  33. x$host, ":", x$port, ">\n", sep=""
  34. )
  35. invisible(x)
  36. }
  37. #' @rdname splash
  38. #' @export
  39. splash_local <- splash("localhost")
  40. s_GET <- purrr::safely(GET)
  41. #' Test if a Splash server is up
  42. #'
  43. #' @md
  44. #' @param splash_obj A splash connection object
  45. #' @family splash_info_functions
  46. #' @return `TRUE` if Slash server is running, otherwise `FALSE`
  47. #' @export
  48. #' @examples \dontrun{
  49. #' sp <- splash()
  50. #' splash_active(sp)
  51. #' }
  52. splash_active <- function(splash_obj = splash_local) {
  53. if (is.null(splash_obj$user)) {
  54. res <- s_GET(splash_url(splash_obj), path="_ping")
  55. } else {
  56. res <- s_GET(splash_url(splash_obj), path="_ping",
  57. httr::authenticate(splash_obj$user, splash_obj$pass))
  58. }
  59. if (is.null(res$result)) return(FALSE)
  60. if (httr::status_code(res$result) >=300) return(FALSE)
  61. httr::content(res$result, as="text", encoding="UTF-8") %>%
  62. jsonlite::fromJSON() -> out
  63. out$url <- splash_url(splash_obj)
  64. message(sprintf("Status of splash instance on [%s]: %s. Max RSS: %s Mb\n",
  65. out$url, out$status, scales::comma(out$maxrss/1024/1024)))
  66. if ("status" %in% names(out)) return(out$status == "ok")
  67. return(FALSE)
  68. }
  69. #' Get Splash version information
  70. #'
  71. #' @param splash_obj A splash connection object
  72. #' @family splash_info_functions
  73. #' @export
  74. #' @examples \dontrun{
  75. #' sp <- splash()
  76. #' splash_version(sp)
  77. #' }
  78. splash_version <- function(splash_obj = splash_local) {
  79. execute_lua(splash_obj, '
  80. function main(splash)
  81. return splash:get_version()
  82. end
  83. ') -> res
  84. jsonlite::fromJSON(rawToChar(res))
  85. }
  86. #' Get information about requests/responses for the pages loaded
  87. #'
  88. #' @param splash_obj A splash connection object
  89. #' @family splash_info_functions
  90. #' @export
  91. #' @examples \dontrun{
  92. #' sp <- splash()
  93. #' splash_history(sp)
  94. #' }
  95. splash_history <- function(splash_obj = splash_local) {
  96. execute_lua(splash_obj, '
  97. function main(splash)
  98. return splash:history()
  99. end
  100. ') -> res
  101. jsonlite::fromJSON(rawToChar(res))
  102. }
  103. #' Get Splash performance-related statistics
  104. #'
  105. #' @param splash_obj A splash connection object
  106. #' @family splash_info_functions
  107. #' @export
  108. #' @examples \dontrun{
  109. #' sp <- splash()
  110. #' splash_perf_stats(sp)
  111. #' }
  112. splash_perf_stats <- function(splash_obj = splash_local) {
  113. execute_lua(splash_obj, '
  114. function main(splash)
  115. return splash:get_perf_stats()
  116. end
  117. ') -> res
  118. jsonlite::fromJSON(rawToChar(res))
  119. }
  120. #' Retrieve debug-level info for a Splash server
  121. #'
  122. #' @param splash_obj A splash connection object
  123. #' @family splash_info_functions
  124. #' @export
  125. #' @examples \dontrun{
  126. #' sp <- splash()
  127. #' splash_debug(sp)
  128. #' }
  129. splash_debug <- function(splash_obj = splash_local) {
  130. if (is.null(splash_obj$user)) {
  131. httr::GET(splash_url(splash_obj), path="_debug") %>%
  132. httr::stop_for_status() %>%
  133. httr::content(as="text", encoding="UTF-8") %>%
  134. jsonlite::fromJSON() -> out
  135. } else {
  136. httr::GET(splash_url(splash_obj), path="_debug",
  137. httr::authenticate(splash_obj$user, splash_obj$pass)) %>%
  138. httr::stop_for_status() %>%
  139. httr::content(as="text", encoding="UTF-8") %>%
  140. jsonlite::fromJSON() -> out
  141. }
  142. out$url <- splash_url(splash_obj)
  143. class(out) <- c("splash_debug", class(out))
  144. out
  145. }
  146. #' @rdname splash_debug
  147. #' @keywords internal
  148. #' @export
  149. print.splash_debug <- function(x, ...) {
  150. print(str(x))
  151. invisible(x)
  152. }