|
| 1 | +cache <- new.env(parent = emptyenv()) |
| 2 | + |
| 3 | +cache_timeout <- function() { |
| 4 | + as.numeric(Sys.getenv("R_VERSION_CACHE_TIMEOUT", 3600)) |
| 5 | +} |
| 6 | + |
| 7 | +version_api_url <- function() { |
| 8 | + Sys.getenv("R_VERSION_API_URL", "https://api.r-hub.io/rversions") |
| 9 | +} |
| 10 | + |
| 11 | +#' @importFrom curl curl_fetch_memory |
| 12 | + |
| 13 | +api <- function(endpoint) { |
| 14 | + if (!is.null(value <- cache[[endpoint]]) && |
| 15 | + Sys.time() - value$time < cache_timeout()) { |
| 16 | + return(value$value) |
| 17 | + } |
| 18 | + |
| 19 | + url <- file.path(version_api_url(), endpoint) |
| 20 | + resp <- curl::curl_fetch_memory(url) |
| 21 | + if (resp$status_code != 200) { |
| 22 | + stop("Failed to fetch ", url, "\n", rawToChar(resp$content)) |
| 23 | + } |
| 24 | + |
| 25 | + cache[[endpoint]] <- list( |
| 26 | + time = Sys.time(), |
| 27 | + value = json$parse(rawToChar(resp$content)) |
| 28 | + ) |
| 29 | + |
| 30 | + cache[[endpoint]]$value |
| 31 | +} |
| 32 | + |
| 33 | +api_version_df <- function(endpoint, dots = TRUE) { |
| 34 | + obj <- api(endpoint) |
| 35 | + |
| 36 | + obj <- lapply(obj, function(x) { |
| 37 | + x <- as.list(x) |
| 38 | + if (is.null(x$nickname)) { |
| 39 | + x$nickname <- NA_character_ |
| 40 | + } |
| 41 | + x |
| 42 | + }) |
| 43 | + |
| 44 | + df <- list_as_df(obj) |
| 45 | + df <- as_version_df(df, dots) |
| 46 | + df |
| 47 | +} |
| 48 | + |
| 49 | +api_version_df1 <- function(endpoint, dots = TRUE) { |
| 50 | + obj <- as.list(api(endpoint)) |
| 51 | + |
| 52 | + if (is.null(obj$nickname)) { |
| 53 | + obj$nickname <- NA_character_ |
| 54 | + } |
| 55 | + if (is.null(obj$date)) { |
| 56 | + obj$date <- NA_character_ |
| 57 | + } |
| 58 | + |
| 59 | + df <- list_as_df(list(obj)) |
| 60 | + df <- as_version_df(df, dots) |
| 61 | + df |
| 62 | +} |
| 63 | + |
| 64 | +list_as_df <- function(x) { |
| 65 | + df <- do.call(rbind.data.frame, x) |
| 66 | + df <- as_data_frame(df) |
| 67 | + df |
| 68 | +} |
| 69 | + |
| 70 | +as_version_df <- function(df, dots = TRUE) { |
| 71 | + df$date <- parse_iso_8601(df$date) |
| 72 | + df$version <- to_dots(df$version, dots) |
| 73 | + df$semver <- package_version(df$semver) |
| 74 | + df$URL <- df$URL %||% df$url |
| 75 | + |
| 76 | + cols <- c("version", "date", "nickname", "semver", "URL") |
| 77 | + df <- df[intersect(cols, names(df))] |
| 78 | + |
| 79 | + rownames(df) <- NULL |
| 80 | + df |
| 81 | +} |
| 82 | + |
| 83 | +to_dots <- function(x, dots) { |
| 84 | + if (dots) { |
| 85 | + gsub("-", ".", x, fixed = TRUE) |
| 86 | + } else { |
| 87 | + gsub(".", "-", x, fixed = TRUE) |
| 88 | + } |
| 89 | +} |
0 commit comments