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.

96 lines
2.8 KiB

преди 7 години
#' Create an httr verb request function from an HAR request
#'
преди 7 години
#' This function is very useful if you used `splashr` to find XHR requests in a dynamic
#' page and want to be able to make a call directly to that XHR resource. Once you
#' 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 години
#'
#' @md
#' @param entry HAR entry
преди 7 години
#' @param quiet quiet (no messages)
#' @export
преди 6 години
as_httr_req <- function(entry, quiet=TRUE) {
req <- entry$request
req$headers <- purrr::map(req$headers, "value") %>%
setNames(map_chr(req$headers, "name"))
ml <- getOption("deparse.max.lines")
options(deparse.max.lines=10000)
template <- "httr::VERB(verb = '%s', url = '%s' %s%s%s%s%s%s)"
hdrs <- enc <- bdy <- ckies <- auth <- verbos <- cfg <- ""
if (length(req$headers) > 0) {
# try to determine encoding
ct_idx <- which(grepl("content-type", names(req$headers), ignore.case=TRUE))
if (length(ct_idx) > 0) {
# retrieve & delete the content type
ct <- req$headers[[ct_idx]]
req$headers[[ct_idx]] <- NULL
if (stringi::stri_detect_regex(ct, "multipart")) {
enc <- ", encode = 'multipart'"
} else if (stringi::stri_detect_regex(ct, "form")) {
enc <- ", encode = 'form'"
} else if (stringi::stri_detect_regex(ct, "json")) {
enc <- ", encode = 'json'"
} else {
enc <- ""
}
}
hdrs <- paste0(capture.output(dput(req$headers, control=NULL)),
collapse="")
hdrs <- sub("^list", ", httr::add_headers", hdrs)
}
if (length(req$data) > 0) {
bdy_bits <- paste0(capture.output(dput(parse_query(req$data), control=NULL)),
collapse="")
bdy <- sprintf(", body = %s", bdy_bits)
}
if (length(req$url_parts$username) > 0) {
auth <- sprintf(", httr::authenticate(user='%s', password='%s')",
req$url_parts$username, req$url_parts$password)
}
if (length(req$verbose) > 0) {
verbos <- ", httr::verbose()"
}
if (length(req$cookies) > 0) {
ckies <- paste0(capture.output(dput(req$cookies, control=NULL)),
collapse="")
ckies <- sub("^list", ", httr::set_cookies", ckies)
}
REQ_URL <- req$url
out <- sprintf(template, toupper(req$method), REQ_URL, auth, verbos, hdrs, ckies, bdy, enc)
# this does a half-decent job formatting the R function text
fil <- tempfile(fileext=".R")
on.exit(unlink(fil))
formatR::tidy_source(text=out, width.cutoff=30, indent=4, file=fil)
tmp <- paste0(readLines(fil), collapse="\n")
if (!quiet) cat(tmp, "\n")
# make a bona fide R function
f <- function() {}
formals(f) <- NULL
environment(f) <- parent.frame()
body(f) <- as.expression(parse(text=tmp))
options(deparse.max.lines=ml)
return(f)
}