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.

184 lines
5.0KB

  1. #' Retrieve the body content of a HAR entry
  2. #'
  3. #' @md
  4. #' @param har_resp_obj HAR response object
  5. #' @param type return type. If `raw` (default) then a raw vector of the content is returned.
  6. #' If `text` then a character vector.
  7. #' @family splash_har_helpers
  8. #' @return A `raw` vector of the content or `NULL` or a `character` if `type` == `text`
  9. #' @export
  10. get_response_body <- function(har_resp_obj, type=c("raw", "text")) {
  11. type <- match.arg(type, c("raw", "text"))
  12. resp <- har_resp_obj$response$content$text
  13. if (resp == "") return(NULL)
  14. tmp <- openssl::base64_decode(resp)
  15. if (type == "text") tmp <- readBin(tmp, "character")
  16. tmp
  17. }
  18. #' Retrieve or test content type of a HAR request object
  19. #'
  20. #' @param har_resp_obj a reponse object from [render_har()] or [execute_lua()]
  21. #' @family splash_har_helpers
  22. #' @export
  23. get_content_type <- function(har_resp_obj) {
  24. ctype <- har_resp_obj$response$content$mimeType
  25. if (ctype == "") return(NA_character_)
  26. if (any(grepl(";", ctype))) ctype <- gsub(";.*$", "", ctype)
  27. ctype
  28. }
  29. #' @md
  30. #' @rdname get_content_type
  31. #' @param type content type to compare to (default: "`application/json`")
  32. #' @export
  33. is_content_type <- function(har_resp_obj, type="application/json") {
  34. get_content_type(har_resp_obj) == type
  35. }
  36. #' @rdname get_content_type
  37. #' @export
  38. is_json <- function(har_resp_obj) { is_content_type(har_resp_obj) }
  39. #' @rdname get_content_type
  40. #' @export
  41. is_xml <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/xml") }
  42. #' @rdname get_content_type
  43. #' @export
  44. is_css <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/css") }
  45. #' @rdname get_content_type
  46. #' @export
  47. is_plain <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/plain") }
  48. #' @rdname get_content_type
  49. #' @export
  50. is_binary <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/octet-stream") }
  51. #' @rdname get_content_type
  52. #' @export
  53. is_javascript <- function(har_resp_obj) {
  54. is_content_type(har_resp_obj, type="text/javascript") |
  55. is_content_type(har_resp_obj, type="text/x-javascript")
  56. }
  57. #' @rdname get_content_type
  58. #' @export
  59. is_html <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/html") }
  60. #' @rdname get_content_type
  61. #' @export
  62. is_jpeg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/jpeg") }
  63. #' @rdname get_content_type
  64. #' @export
  65. is_png <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/png") }
  66. #' @rdname get_content_type
  67. #' @export
  68. is_svg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/svg+xml") }
  69. #' @rdname get_content_type
  70. #' @export
  71. is_gif <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/gif") }
  72. #' @rdname get_content_type
  73. #' @export
  74. is_xhr <- function(har_resp_obj) {
  75. if (is.null(har_resp_obj$request$headers)) return(NA)
  76. if (length(har_resp_obj$request$headers)==0) return(NA)
  77. y <- map(har_resp_obj$request$headers, "value")
  78. names(y) <- tolower(map_chr(har_resp_obj$request$headers, "name"))
  79. if ("x-requested-with" %in% names(y)) {
  80. return(tolower("xmlhttprequest") == tolower(y[["x-requested-with"]]))
  81. } else {
  82. return(FALSE)
  83. }
  84. }
  85. #' Retrieve request URL
  86. #'
  87. #' @param har_resp_obj HAR response object
  88. #' @family splash_har_helpers
  89. #' @export
  90. get_request_url <- function(har_resp_obj) {
  91. utype <- har_resp_obj$request$url
  92. if (utype == "") return(NA_character_)
  93. utype
  94. }
  95. #' Retrieve or test request type
  96. #'
  97. #' @param har_resp_obj HAR response object
  98. #' @family splash_har_helpers
  99. #' @export
  100. get_request_type <- function(har_resp_obj) {
  101. rtype <- har_resp_obj$request$method
  102. if (rtype == "") return(NA_character_)
  103. rtype
  104. }
  105. #' @rdname get_request_type
  106. #' @export
  107. is_get <- function(har_resp_obj) { get_request_type(har_resp_obj) == "GET" }
  108. #' @rdname get_request_type
  109. #' @export
  110. is_post <- function(har_resp_obj) { get_request_type(har_resp_obj) == "POST" }
  111. #' Retrieve just the HAR entries from a splashr request
  112. #'
  113. #' @param x can be a `har` object, `harlog` object or `harentries` object
  114. #' @export
  115. har_entries <- function(x) {
  116. if (inherits(x, "har")) {
  117. x$log$entries
  118. } else if (inherits(x, "harlog")) {
  119. x$entries
  120. } else if (inherits(x, "harentries")) {
  121. x
  122. } else {
  123. NULL
  124. }
  125. }
  126. #' Retrieve an entry by index from a HAR object
  127. #'
  128. #' @param x can be a `har` object, `harlog` object or `harentries` object
  129. #' @param i index of the HAR entry to retrieve
  130. #' @family splash_har_helpers
  131. #' @export
  132. get_har_entry <- function(x, i=1) {
  133. if (inherits(x, "har")) {
  134. x$log$entries[[i]]
  135. } else if (inherits(x, "harlog")) {
  136. x$entries[[i]]
  137. } else if (inherits(x, "harentries")) {
  138. x[[i]]
  139. } else {
  140. NULL
  141. }
  142. }
  143. #' Retrieves number of HAR entries in a response
  144. #'
  145. #' @param x can be a `har` object, `harlog` object or `harentries` object
  146. #' @family splash_har_helpers
  147. #' @export
  148. har_entry_count <- function(x) {
  149. if (inherits(x, "har")) {
  150. length(x$log$entries)
  151. } else if (inherits(x, "harlog")) {
  152. length(x$entries)
  153. } else if (inherits(x, "harentries")) {
  154. length(x)
  155. } else {
  156. NULL
  157. }
  158. }