mirror of https://git.sr.ht/~hrbrmstr/splashr
16 changed files with 333 additions and 36 deletions
@ -0,0 +1,93 @@ |
|||
#' Create an httr function from an HAR request |
|||
#' |
|||
#' @md |
|||
#' @param entry HAR entry |
|||
#' @param quiet quiet |
|||
#' @param add_clip add clip |
|||
#' @export |
|||
as_req <- function(entry, quiet=TRUE, add_clip=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 (add_clip) clipr::write_clip(tmp) |
|||
|
|||
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) |
|||
|
|||
} |
|||
@ -0,0 +1,36 @@ |
|||
#' Return a HAR entry response as an httr::response object |
|||
#' |
|||
#' @param har_entry a HAR object (should contain a response body to be most useful) |
|||
#' @export |
|||
#' @examples \dontrun{ |
|||
#' URL <- "http://www.svs.cl/portal/principal/605/w3-propertyvalue-18554.html" |
|||
#' |
|||
#' splash_local %>% |
|||
#' splash_response_body(TRUE) %>% |
|||
#' splash_go(URL) %>% |
|||
#' splash_wait(2) %>% |
|||
#' splash_har() -> har |
|||
#' |
|||
#' keep(har$log$entries, is_xhr) %>% |
|||
#' map(as_request) %>% |
|||
#' map(httr::content, as="parsed") |
|||
#' } |
|||
as_request <- function(har_entry) { |
|||
|
|||
if (length(har_entry$response$content$text) > 0) { |
|||
content_body <- openssl::base64_decode(har_entry$response$content$text) |
|||
} else { |
|||
content_body <- NULL |
|||
} |
|||
|
|||
structure(list( |
|||
url = har_entry$request$url, |
|||
status_code = har_entry$response$status, |
|||
date = lubridate::ymd_hms(har_entry$startedDateTime), |
|||
headers = setNames(map(har_entry$response$headers, "value"), |
|||
map(har_entry$response$headers, "name")) %>% |
|||
insensitive(), |
|||
content = content_body |
|||
), class="response") |
|||
|
|||
} |
|||
@ -0,0 +1,26 @@ |
|||
#' Retrieve size of content | body | headers |
|||
#' |
|||
#' @param har_resp_obj HAR response object |
|||
#' @export |
|||
get_content_size <- function(har_resp_obj) { |
|||
csize <- har_resp_obj$response$content$size |
|||
if (is.null(csize)) return(NA_real_) |
|||
return(as.numeric(csize)) |
|||
} |
|||
|
|||
#' @rdname get_content_size |
|||
#' @export |
|||
get_body_size <- function(har_resp_obj) { |
|||
bsize <- har_resp_obj$response$bodySize |
|||
if (is.null(bsize)) return(NA_real_) |
|||
return(as.numeric(bsize)) |
|||
} |
|||
|
|||
#' @rdname get_content_size |
|||
#' @export |
|||
get_headers_size <- function(har_resp_obj) { |
|||
hsize <- har_resp_obj$response$headersSize |
|||
if (is.null(hsize)) return(NA_real_) |
|||
return(as.numeric(hsize)) |
|||
} |
|||
|
|||
@ -0,0 +1,18 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/as_req.r |
|||
\name{as_req} |
|||
\alias{as_req} |
|||
\title{Create an httr function from an HAR request} |
|||
\usage{ |
|||
as_req(entry, quiet = TRUE, add_clip = TRUE) |
|||
} |
|||
\arguments{ |
|||
\item{entry}{HAR entry} |
|||
|
|||
\item{quiet}{quiet} |
|||
|
|||
\item{add_clip}{add clip} |
|||
} |
|||
\description{ |
|||
Create an httr function from an HAR request |
|||
} |
|||
@ -0,0 +1,29 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/as_request.r |
|||
\name{as_request} |
|||
\alias{as_request} |
|||
\title{Return a HAR entry response as an httr::response object} |
|||
\usage{ |
|||
as_request(har_entry) |
|||
} |
|||
\arguments{ |
|||
\item{har_entry}{a HAR object (should contain a response body to be most useful)} |
|||
} |
|||
\description{ |
|||
Return a HAR entry response as an httr::response object |
|||
} |
|||
\examples{ |
|||
\dontrun{ |
|||
URL <- "http://www.svs.cl/portal/principal/605/w3-propertyvalue-18554.html" |
|||
|
|||
splash_local \%>\% |
|||
splash_response_body(TRUE) \%>\% |
|||
splash_go(URL) \%>\% |
|||
splash_wait(2) \%>\% |
|||
splash_har() -> har |
|||
|
|||
keep(har$log$entries, is_xhr) \%>\% |
|||
map(as_request) \%>\% |
|||
map(httr::content, as="parsed") |
|||
} |
|||
} |
|||
@ -0,0 +1,20 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/helpers.r |
|||
\name{get_request_type} |
|||
\alias{get_request_type} |
|||
\alias{is_get} |
|||
\alias{is_post} |
|||
\title{Retrieve or test request type} |
|||
\usage{ |
|||
get_request_type(har_resp_obj) |
|||
|
|||
is_get(har_resp_obj) |
|||
|
|||
is_post(har_resp_obj) |
|||
} |
|||
\arguments{ |
|||
\item{har_resp_obj}{HAR response object} |
|||
} |
|||
\description{ |
|||
Retrieve or test request type |
|||
} |
|||
@ -0,0 +1,14 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/helpers.r |
|||
\name{get_request_url} |
|||
\alias{get_request_url} |
|||
\title{Retrieve request URL} |
|||
\usage{ |
|||
get_request_url(har_resp_obj) |
|||
} |
|||
\arguments{ |
|||
\item{har_resp_obj}{HAR response object} |
|||
} |
|||
\description{ |
|||
Retrieve request URL |
|||
} |
|||
@ -0,0 +1,17 @@ |
|||
% Generated by roxygen2: do not edit by hand |
|||
% Please edit documentation in R/helpers.r |
|||
\name{get_response_body} |
|||
\alias{get_response_body} |
|||
\title{Retrieve the body content of a HAR entry} |
|||
\usage{ |
|||
get_response_body(har_resp_obj) |
|||
} |
|||
\arguments{ |
|||
\item{har_resp_obj}{HAR response object} |
|||
} |
|||
\value{ |
|||
A \code{raw} vector of the content or \code{NULL} |
|||
} |
|||
\description{ |
|||
Retrieve the body content of a HAR entry |
|||
} |
|||
Loading…
Reference in new issue