1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
|
get_method <- function(x) {
x <- as.character(x)
tmp <- grep(
"(get)$|(post)$|(put)$|(delete)$|(options)$|(patch)$|(head)$",
tolower(x), value = TRUE)
tmp <- sub("httr::", "", tmp)
if (length(tmp) == 0) NULL else tmp
}
is_url <- function(x) {
grepl(
"https?://", x, ignore.case = TRUE) ||
grepl("localhost:[0-9]{4}", x, ignore.case = TRUE
)
}
get_uri <- function(x) {
x <- as.character(x)
tmp <- x[vapply(x, is_url, logical(1))]
if (length(tmp) == 0) NULL else tmp
}
get_host <- function(x) {
eval(parse(text = x))(x)$hostname
}
get_path <- function(x) {
eval(parse(text = vcr_c$uri_parser))(x)$path
}
get_query <- function(x) {
if ("query" %in% names(x)) {
x[["query"]]
} else {
NULL
}
}
parseurl <- function(x) {
tmp <- urltools::url_parse(x)
tmp <- as.list(tmp)
if (!is.na(tmp$parameter)) {
tmp$parameter <- sapply(strsplit(tmp$parameter, "&")[[1]], function(z) {
zz <- strsplit(z, split = "=")[[1]]
as.list(stats::setNames(zz[2], zz[1]))
}, USE.NAMES = FALSE)
}
tmp
}
|
