@ -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 | |||
} |