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.

124 lines
3.4KB

  1. #' Retrieve the body content of a HAR entry
  2. #'
  3. #' @md
  4. #' @param har_resp_obj HAR response object
  5. #' @return A `raw` vector of the content or `NULL`
  6. #' @export
  7. get_response_body <- function(har_resp_obj) {
  8. resp <- har_resp_obj$response$content$text
  9. if (resp == "") return(NULL)
  10. openssl::base64_decode(resp)
  11. }
  12. #' Retrieve or test content type of a HAR request object
  13. #'
  14. #' @export
  15. get_content_type <- function(har_resp_obj) {
  16. ctype <- har_resp_obj$response$content$mimeType
  17. if (ctype == "") return(NA_character_)
  18. if (any(grepl(";", ctype))) ctype <- gsub(";.*$", "", ctype)
  19. ctype
  20. }
  21. #' @md
  22. #' @rdname get_content_type
  23. #' @param type content type to compare to (default: "`application/json`")
  24. #' @export
  25. is_content_type <- function(har_resp_obj, type="application/json") {
  26. get_content_type(har_resp_obj) == type
  27. }
  28. #' @rdname get_content_type
  29. #' @param har_resp_obj a reponse object from [render_har()] or [execute_lua()]
  30. #' @export
  31. is_json <- function(har_resp_obj) { is_content_type(har_resp_obj) }
  32. #' @rdname get_content_type
  33. #' @export
  34. is_xml <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/xml") }
  35. #' @rdname get_content_type
  36. #' @export
  37. is_css <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/css") }
  38. #' @rdname get_content_type
  39. #' @export
  40. is_plain <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/plain") }
  41. #' @rdname get_content_type
  42. #' @export
  43. is_binary <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/octet-stream") }
  44. #' @rdname get_content_type
  45. #' @export
  46. is_javascript <- function(har_resp_obj) {
  47. is_content_type(har_resp_obj, type="text/javascript") |
  48. is_content_type(har_resp_obj, type="text/x-javascript")
  49. }
  50. #' @rdname get_content_type
  51. #' @export
  52. is_html <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/html") }
  53. #' @rdname get_content_type
  54. #' @export
  55. is_jpeg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/jpeg") }
  56. #' @rdname get_content_type
  57. #' @export
  58. is_png <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/png") }
  59. #' @rdname get_content_type
  60. #' @export
  61. is_svg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/svg+xml") }
  62. #' @rdname get_content_type
  63. #' @export
  64. is_gif <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/gif") }
  65. #' @rdname get_content_type
  66. #' @export
  67. is_xhr <- function(har_resp_obj) {
  68. if (is.null(har_resp_obj$request$headers)) return(NA)
  69. if (length(har_resp_obj$request$headers)==0) return(NA)
  70. y <- map(har_resp_obj$request$headers, "value")
  71. names(y) <- tolower(map_chr(har_resp_obj$request$headers, "name"))
  72. if ("x-requested-with" %in% names(y)) {
  73. return(tolower("xmlhttprequest") == tolower(y[["x-requested-with"]]))
  74. } else {
  75. return(FALSE)
  76. }
  77. }
  78. #' Retrieve request URL
  79. #'
  80. #' @param har_resp_obj HAR response object
  81. #' @export
  82. get_request_url <- function(har_resp_obj) {
  83. utype <- har_resp_obj$request$url
  84. if (utype == "") return(NA_character_)
  85. utype
  86. }
  87. #' Retrieve or test request type
  88. #'
  89. #' @param har_resp_obj HAR response object
  90. #' @export
  91. get_request_type <- function(har_resp_obj) {
  92. rtype <- har_resp_obj$request$method
  93. if (rtype == "") return(NA_character_)
  94. rtype
  95. }
  96. #' @rdname get_request_type
  97. #' @export
  98. is_get <- function(har_resp_obj) { get_request_type(har_resp_obj) == "GET" }
  99. #' @rdname get_request_type
  100. #' @export
  101. is_post <- function(har_resp_obj) { get_request_type(har_resp_obj) == "POST" }