Tools to Work with the 'Splash' JavaScript Rendering Service in R
Nie możesz wybrać więcej, niż 25 tematów Tematy muszą się zaczynać od litery lub cyfry, mogą zawierać myślniki ('-') i mogą mieć do 35 znaków.

96 wiersze
2.8KB

  1. #' Create an httr verb request function from an HAR request
  2. #'
  3. #' This function is very useful if you used `splashr` to find XHR requests in a dynamic
  4. #' page and want to be able to make a call directly to that XHR resource. Once you
  5. #' identify the proper HAR entry, pass it to this function and fully working function
  6. #' that makes an `httr::VERB()` request will be created and returned.
  7. #'
  8. #' @md
  9. #' @param entry HAR entry
  10. #' @param quiet quiet (no messages)
  11. #' @export
  12. as_httr_req <- function(entry, quiet=TRUE) {
  13. req <- entry$request
  14. req$headers <- purrr::map(req$headers, "value") %>%
  15. setNames(map_chr(req$headers, "name"))
  16. ml <- getOption("deparse.max.lines")
  17. options(deparse.max.lines=10000)
  18. template <- "httr::VERB(verb = '%s', url = '%s' %s%s%s%s%s%s)"
  19. hdrs <- enc <- bdy <- ckies <- auth <- verbos <- cfg <- ""
  20. if (length(req$headers) > 0) {
  21. # try to determine encoding
  22. ct_idx <- which(grepl("content-type", names(req$headers), ignore.case=TRUE))
  23. if (length(ct_idx) > 0) {
  24. # retrieve & delete the content type
  25. ct <- req$headers[[ct_idx]]
  26. req$headers[[ct_idx]] <- NULL
  27. if (stringi::stri_detect_regex(ct, "multipart")) {
  28. enc <- ", encode = 'multipart'"
  29. } else if (stringi::stri_detect_regex(ct, "form")) {
  30. enc <- ", encode = 'form'"
  31. } else if (stringi::stri_detect_regex(ct, "json")) {
  32. enc <- ", encode = 'json'"
  33. } else {
  34. enc <- ""
  35. }
  36. }
  37. hdrs <- paste0(capture.output(dput(req$headers, control=NULL)),
  38. collapse="")
  39. hdrs <- sub("^list", ", httr::add_headers", hdrs)
  40. }
  41. if (length(req$data) > 0) {
  42. bdy_bits <- paste0(capture.output(dput(parse_query(req$data), control=NULL)),
  43. collapse="")
  44. bdy <- sprintf(", body = %s", bdy_bits)
  45. }
  46. if (length(req$url_parts$username) > 0) {
  47. auth <- sprintf(", httr::authenticate(user='%s', password='%s')",
  48. req$url_parts$username, req$url_parts$password)
  49. }
  50. if (length(req$verbose) > 0) {
  51. verbos <- ", httr::verbose()"
  52. }
  53. if (length(req$cookies) > 0) {
  54. ckies <- paste0(capture.output(dput(req$cookies, control=NULL)),
  55. collapse="")
  56. ckies <- sub("^list", ", httr::set_cookies", ckies)
  57. }
  58. REQ_URL <- req$url
  59. out <- sprintf(template, toupper(req$method), REQ_URL, auth, verbos, hdrs, ckies, bdy, enc)
  60. # this does a half-decent job formatting the R function text
  61. fil <- tempfile(fileext=".R")
  62. on.exit(unlink(fil))
  63. formatR::tidy_source(text=out, width.cutoff=30, indent=4, file=fil)
  64. tmp <- paste0(readLines(fil), collapse="\n")
  65. if (!quiet) cat(tmp, "\n")
  66. # make a bona fide R function
  67. f <- function() {}
  68. formals(f) <- NULL
  69. environment(f) <- parent.frame()
  70. body(f) <- as.expression(parse(text=tmp))
  71. options(deparse.max.lines=ml)
  72. return(f)
  73. }