mirror of https://git.sr.ht/~hrbrmstr/splashr
boB Rudis
7 years ago
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