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.

154 lines
3.8KB

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