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.

117 lines
4.3KB

  1. .tidy_one_entry <- function(x, include_content = TRUE) {
  2. .x <- x
  3. if (length(.x[["timings"]])) {
  4. data.frame(
  5. stage = names(.x[["timings"]]),
  6. value = unlist(.x[["timings"]], use.names = FALSE),
  7. stringsAsFactors = FALSE
  8. ) -> timings
  9. } else {
  10. timings <- data.frame(stringsAsFactors = FALSE)
  11. }
  12. class(timings) <- c("tbl_df", "tbl", "data.frame")
  13. if (length(.x[["request"]][["headers"]])) {
  14. data.frame(
  15. name =vapply(.x[["request"]][["headers"]], `[[`, character(1), "name", USE.NAMES = FALSE),
  16. value = vapply(.x[["request"]][["headers"]], `[[`, character(1), "value", USE.NAMES = FALSE),
  17. stringsAsFactors = FALSE
  18. ) -> req_headers
  19. } else {
  20. req_headers <- data.frame(stringsAsFactors = FALSE)
  21. }
  22. class(req_headers) <- c("tbl_df", "tbl", "data.frame")
  23. if (length(.x[["response"]][["headers"]])) {
  24. data.frame(
  25. name =vapply(.x[["response"]][["headers"]], `[[`, character(1), "name", USE.NAMES = FALSE),
  26. value = vapply(.x[["response"]][["headers"]], `[[`, character(1), "value", USE.NAMES = FALSE),
  27. stringsAsFactors = FALSE
  28. ) -> headers
  29. } else {
  30. headers <- data.frame(stringsAsFactors = FALSE)
  31. }
  32. class(headers) <- c("tbl_df", "tbl", "data.frame")
  33. if (length(.x[["request"]][["cookies"]])) {
  34. data.frame(
  35. name =vapply(.x[["request"]][["cookies"]], `[[`, character(1), "name", USE.NAMES = FALSE),
  36. value = vapply(.x[["request"]][["cookies"]], `[[`, character(1), "value", USE.NAMES = FALSE),
  37. stringsAsFactors = FALSE
  38. ) -> req_cookies
  39. } else {
  40. req_cookies <- data.frame(stringsAsFactors = FALSE)
  41. }
  42. class(req_cookies) <- c("tbl_df", "tbl", "data.frame")
  43. if (length(.x[["response"]][["cookies"]])) {
  44. data.frame(
  45. name =vapply(.x[["response"]][["cookies"]], `[[`, character(1), "name", USE.NAMES = FALSE),
  46. value = vapply(.x[["response"]][["cookies"]], `[[`, character(1), "value", USE.NAMES = FALSE),
  47. stringsAsFactors = FALSE
  48. ) -> res_cookies
  49. } else {
  50. res_cookies <- data.frame(stringsAsFactors = FALSE)
  51. }
  52. class(res_cookies) <- c("tbl_df", "tbl", "data.frame")
  53. data.frame(
  54. status = .x[["response"]][["status"]] %l0% NA_character_,
  55. started = .x[["startedDateTime"]] %l0% NA_character_,
  56. total_time = .x[["time"]] %l0% NA_integer_,
  57. page_ref = .x[["pageref"]] %l0% NA_character_,
  58. timings = I(list(timings)),
  59. req_url = .x[["request"]][["url"]] %l0% NA_character_,
  60. req_method = .x[["request"]][["method"]] %l0% NA_character_,
  61. req_http_version = .x[["request"]][["httpVersion"]] %l0% NA_character_,
  62. req_hdr_size = .x[["request"]][["headersSize"]] %l0% NA_character_,
  63. req_headers = I(list(req_headers)),
  64. req_cookies = I(list(req_cookies)),
  65. resp_url = .x[["response"]][["url"]] %l0% NA_character_,
  66. resp_rdrurl = .x[["response"]][["redirectURL"]] %l0% NA_character_,
  67. resp_type = .x[["response"]][["content"]][["mimeType"]] %l0% NA_character_,
  68. resp_size = .x[["resonse"]][["bodySize"]] %l0% NA_integer_,
  69. resp_cookies = I(list(res_cookies)),
  70. resp_headers = I(list(headers)),
  71. resp_encoding = .x[["resonse"]][["content"]][["encoding"]] %l0% NA_character_,
  72. resp_content_size = as.numeric(.x[["response"]][["content"]][["size"]]) %l0% NA_real_,
  73. stringsAsFactors = FALSE
  74. ) -> out
  75. if (include_content) out$resp_content <- .x[["response"]][["content"]][["text"]] %l0% NA_character_
  76. class(out) <- c("tbl_df", "tbl", "data.frame")
  77. out
  78. }
  79. #' Turn a gnHARly HAR object into a tidy data frame (tibble)
  80. #'
  81. #' @md
  82. #' @param x A `harentry` object
  83. #' @param include_content if `TRUE` (the default) the encoded element content will be returned in the data frame
  84. #' @return data frame (tibble)
  85. #' @export
  86. tidy_har <- function(.x, include_content = TRUE) {
  87. if (inherits(.x, "har")) {
  88. out <- tidy_har(.x[["log"]][["entries"]], include_content = include_content)
  89. } else if (inherits(.x, "harlog")) {
  90. out <- tidy_har(.x[["entries"]], include_content = include_content)
  91. } else if (inherits(.x, "harentries")) {
  92. out <- do.call(rbind.data.frame, lapply(.x, .tidy_one_entry, include_content = include_content))
  93. class(out) <- c("tbl_df", "tbl", "data.frame")
  94. } else if (inherits(.x, "harentry")) {
  95. out <- .tidy_one_entry(.x, include_content = include_content)
  96. } else {
  97. stopifnot(inherits(.x, "harentries"))
  98. }
  99. out
  100. }