Nelze vybrat více než 25 témat
Téma musí začínat písmenem nebo číslem, může obsahovat pomlčky („-“) a může být dlouhé až 35 znaků.
241 lines
6.7 KiB
241 lines
6.7 KiB
#' Retrieve the body content of a HAR entry
|
|
#'
|
|
#' @md
|
|
#' @param har_resp_obj HAR response object
|
|
#' @param type return type. If `raw` (default) then a raw vector of the content is returned.
|
|
#' If `text` then a character vector.
|
|
#' @family splash_har_helpers
|
|
#' @return A `raw` vector of the content or `NULL` or a `character` if `type` == `text`
|
|
#' @export
|
|
get_response_body <- function(har_resp_obj, type=c("raw", "text")) {
|
|
type <- match.arg(type, c("raw", "text"))
|
|
resp <- har_resp_obj$response$content$text
|
|
if (resp == "") return(NULL)
|
|
tmp <- openssl::base64_decode(resp)
|
|
if (type == "text") tmp <- readBin(tmp, "character")
|
|
tmp
|
|
}
|
|
|
|
#' Retrieve or test content type of a HAR request object
|
|
#'
|
|
#' @param har_resp_obj a reponse object from [render_har()] or [execute_lua()]
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_content_type <- function(har_resp_obj) {
|
|
ctype <- har_resp_obj$response$content$mimeType
|
|
if (ctype == "") return(NA_character_)
|
|
if (any(grepl(";", ctype))) ctype <- gsub(";.*$", "", ctype)
|
|
ctype
|
|
}
|
|
|
|
#' @md
|
|
#' @rdname get_content_type
|
|
#' @param type content type to compare to (default: "`application/json`")
|
|
#' @export
|
|
is_content_type <- function(har_resp_obj, type="application/json") {
|
|
res <- get_content_type(har_resp_obj) == type
|
|
if (is.na(res)) res <- FALSE
|
|
res
|
|
}
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_json <- function(har_resp_obj) { is_content_type(har_resp_obj) }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_xml <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/xml") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_css <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/css") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_plain <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/plain") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_binary <- function(har_resp_obj) { is_content_type(har_resp_obj, type="application/octet-stream") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_javascript <- function(har_resp_obj) {
|
|
is_content_type(har_resp_obj, type="text/javascript") |
|
|
is_content_type(har_resp_obj, type="text/x-javascript")
|
|
}
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_html <- function(har_resp_obj) { is_content_type(har_resp_obj, type="text/html") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_jpeg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/jpeg") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_png <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/png") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_svg <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/svg+xml") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_gif <- function(har_resp_obj) { is_content_type(har_resp_obj, type="image/gif") }
|
|
|
|
#' @rdname get_content_type
|
|
#' @export
|
|
is_xhr <- function(har_resp_obj) {
|
|
|
|
if (is.null(har_resp_obj$request$headers)) return(NA)
|
|
if (length(har_resp_obj$request$headers)==0) return(NA)
|
|
|
|
y <- map(har_resp_obj$request$headers, "value")
|
|
names(y) <- tolower(map_chr(har_resp_obj$request$headers, "name"))
|
|
|
|
if ("x-requested-with" %in% names(y)) {
|
|
return(tolower("xmlhttprequest") == tolower(y[["x-requested-with"]]))
|
|
} else {
|
|
return(FALSE)
|
|
}
|
|
|
|
}
|
|
|
|
#' Retrieve response headers as a data frame
|
|
#'
|
|
#' @md
|
|
#' @param har_resp_obj HAR response object
|
|
#' @note the `name` column that contains the header key is normalized to lower case
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_headers <- function(har_resp_obj) {
|
|
if (length(har_resp_obj$response$headers)) {
|
|
do.call(
|
|
rbind.data.frame,
|
|
lapply(har_resp_obj$response$headers, as.data.frame, stringsAsFactors=FALSE)
|
|
) -> ret
|
|
ret[["name"]] <- tolower(ret[["name"]])
|
|
class(ret) <- c("tbl_df", "tbl", "data.frame")
|
|
ret
|
|
}
|
|
}
|
|
|
|
#' Retrieve the value of a specific response header
|
|
#'
|
|
#' @md
|
|
#' @param har_resp_obj HAR response object
|
|
#' @param header the header you want the value for
|
|
#' @note the `name` column that contains the header key is normalized to lower case
|
|
#' as is the passed-in requested header. Also, if there is more than one only
|
|
#' the first is returned.
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_header_val <- function(har_resp_obj, header) {
|
|
if (length(har_resp_obj$response$headers)) {
|
|
header <- tolower(header)
|
|
do.call(
|
|
rbind.data.frame,
|
|
lapply(har_resp_obj$response$headers, as.data.frame, stringsAsFactors=FALSE)
|
|
) -> ret
|
|
ret[["name"]] <- tolower(ret[["name"]])
|
|
ret <- unlist(ret[ret$name == header, "value"], use.names = FALSE)
|
|
if (length(ret)) ret <- ret[1] else ret <- NA_character_
|
|
ret
|
|
} else {
|
|
NA_character_
|
|
}
|
|
}
|
|
|
|
#' Retrieve request URL
|
|
#'
|
|
#' @param har_resp_obj HAR response object
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_request_url <- function(har_resp_obj) {
|
|
utype <- har_resp_obj$request$url
|
|
if (utype == "") utype <- NA_character_
|
|
utype
|
|
}
|
|
|
|
#' Retrieve response URL
|
|
#'
|
|
#' @param har_resp_obj HAR response object
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_response_url <- function(har_resp_obj) {
|
|
utype <- har_resp_obj$response$url
|
|
if (utype == "") utype <- NA_character_
|
|
utype
|
|
}
|
|
|
|
#' Retrieve or test request type
|
|
#'
|
|
#' @param har_resp_obj HAR response object
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_request_type <- function(har_resp_obj) {
|
|
rtype <- har_resp_obj$request$method
|
|
if (rtype == "") return(NA_character_)
|
|
rtype
|
|
}
|
|
|
|
#' @rdname get_request_type
|
|
#' @export
|
|
is_get <- function(har_resp_obj) { get_request_type(har_resp_obj) == "GET" }
|
|
|
|
#' @rdname get_request_type
|
|
#' @export
|
|
is_post <- function(har_resp_obj) { get_request_type(har_resp_obj) == "POST" }
|
|
|
|
#' Retrieve just the HAR entries from a splashr request
|
|
#'
|
|
#' @param x can be a `har` object, `harlog` object or `harentries` object
|
|
#' @export
|
|
har_entries <- function(x) {
|
|
if (inherits(x, "har")) {
|
|
x$log$entries
|
|
} else if (inherits(x, "harlog")) {
|
|
x$entries
|
|
} else if (inherits(x, "harentries")) {
|
|
x
|
|
} else {
|
|
NULL
|
|
}
|
|
}
|
|
|
|
#' Retrieve an entry by index from a HAR object
|
|
#'
|
|
#' @param x can be a `har` object, `harlog` object or `harentries` object
|
|
#' @param i index of the HAR entry to retrieve
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
get_har_entry <- function(x, i=1) {
|
|
if (inherits(x, "har")) {
|
|
x$log$entries[[i]]
|
|
} else if (inherits(x, "harlog")) {
|
|
x$entries[[i]]
|
|
} else if (inherits(x, "harentries")) {
|
|
x[[i]]
|
|
} else {
|
|
NULL
|
|
}
|
|
}
|
|
|
|
#' Retrieves number of HAR entries in a response
|
|
#'
|
|
#' @param x can be a `har` object, `harlog` object or `harentries` object
|
|
#' @family splash_har_helpers
|
|
#' @export
|
|
har_entry_count <- function(x) {
|
|
if (inherits(x, "har")) {
|
|
length(x$log$entries)
|
|
} else if (inherits(x, "harlog")) {
|
|
length(x$entries)
|
|
} else if (inherits(x, "harentries")) {
|
|
length(x)
|
|
} else {
|
|
NULL
|
|
}
|
|
}
|
|
|