|
| 1 | +#' Find the target row from a `pak::pkg_download()` result |
| 2 | +#' |
| 3 | +#' Filters `dl_info` to rows where `direct` is `TRUE` if the column exists, |
| 4 | +#' and matches `pkg_ref` if provided. Always returns a 1-row data frame. |
| 5 | +#' |
| 6 | +#' @param dl_info Data frame returned by `pak::pkg_download()`. |
| 7 | +#' @param pkg_ref Optional package reference requested from pak. |
| 8 | +#' @return One-row data frame. |
| 9 | +#' @keywords internal |
| 10 | +#' @noRd |
| 11 | +find_pak_target_row <- function(dl_info, pkg_ref = NULL) { |
| 12 | + if (!is.data.frame(dl_info) || nrow(dl_info) < 1L) { |
| 13 | + stop("No package download information returned by pak.") |
| 14 | + } |
| 15 | + |
| 16 | + if ("direct" %in% names(dl_info)) { |
| 17 | + direct <- !is.na(dl_info$direct) & dl_info$direct |
| 18 | + if (any(direct)) { |
| 19 | + dl_info <- dl_info[direct, , drop = FALSE] |
| 20 | + } |
| 21 | + } |
| 22 | + |
| 23 | + if (!is.null(pkg_ref) && "ref" %in% names(dl_info)) { |
| 24 | + exact_ref <- !is.na(dl_info$ref) & dl_info$ref == pkg_ref |
| 25 | + if (any(exact_ref)) { |
| 26 | + dl_info <- dl_info[exact_ref, , drop = FALSE] |
| 27 | + } |
| 28 | + } |
| 29 | + |
| 30 | + dl_info[1L, , drop = FALSE] |
| 31 | +} |
| 32 | + |
| 33 | +#' Safely extract a single character value from a one-row data frame |
| 34 | +#' |
| 35 | +#' Returns `NA_character_` if the column is missing or the value is `NULL`. |
| 36 | +#' |
| 37 | +#' @param row One-row data frame. |
| 38 | +#' @param col Column name to extract. |
| 39 | +#' @return Single character value, or `NA_character_`. |
| 40 | +#' @keywords internal |
| 41 | +#' @noRd |
| 42 | +pak_row_value <- function(row, col) { |
| 43 | + if (!col %in% names(row)) { |
| 44 | + return(NA_character_) |
| 45 | + } |
| 46 | + val <- row[[col]][1L] |
| 47 | + if (is.null(val)) { |
| 48 | + return(NA_character_) |
| 49 | + } |
| 50 | + as.character(val) |
| 51 | +} |
| 52 | + |
| 53 | +#' Select the archive downloaded by pak |
| 54 | +#' |
| 55 | +#' @param dl_info Data frame returned by `pak::pkg_download()`. |
| 56 | +#' @param dest_dir Destination directory passed to `pak::pkg_download()`. |
| 57 | +#' @param pkg_ref Package reference requested from pak. |
| 58 | +#' @return Path to a usable `.tar.gz` archive. |
| 59 | +#' @keywords internal |
| 60 | +#' @noRd |
| 61 | +select_pak_download_archive <- function(dl_info, dest_dir, pkg_ref = NULL) { |
| 62 | + row <- find_pak_target_row(dl_info, pkg_ref) |
| 63 | + paths <- pak_download_paths(row, dest_dir) |
| 64 | + |
| 65 | + for (path in paths) { |
| 66 | + archive <- pak_materialize_archive(path, dest_dir) |
| 67 | + if (!is.null(archive)) { |
| 68 | + return(archive) |
| 69 | + } |
| 70 | + } |
| 71 | + |
| 72 | + fallback_name <- pak_row_value(row, "package") |
| 73 | + stop(sprintf( |
| 74 | + "No downloaded archive found in %s for '%s'.", |
| 75 | + dest_dir, |
| 76 | + pkg_ref %||% (if (is.na(fallback_name)) "requested package" else fallback_name) |
| 77 | + )) |
| 78 | +} |
| 79 | + |
| 80 | +pak_download_paths <- function(row, dest_dir) { |
| 81 | + values <- character() |
| 82 | + |
| 83 | + if ("fulltarget" %in% names(row) && !is.na(row$fulltarget[1L])) { |
| 84 | + values <- c(values, row$fulltarget[1L]) |
| 85 | + } |
| 86 | + |
| 87 | + if ("target" %in% names(row) && !is.na(row$target[1L])) { |
| 88 | + target <- row$target[1L] |
| 89 | + # Recognize POSIX absolute, Windows drive-letter, and Windows UNC paths. |
| 90 | + if (grepl("^(/|[A-Za-z]:|\\\\\\\\)", target)) { |
| 91 | + values <- c(values, target) |
| 92 | + } else { |
| 93 | + values <- c(values, file.path(dest_dir, target)) |
| 94 | + } |
| 95 | + values <- c(values, file.path(dest_dir, basename(target))) |
| 96 | + } |
| 97 | + |
| 98 | + unique(values[nzchar(values)]) |
| 99 | +} |
| 100 | + |
| 101 | +pak_materialize_archive <- function(path, dest_dir) { |
| 102 | + archive <- file.path(dest_dir, basename(sub("-t$", "", path))) |
| 103 | + |
| 104 | + if (file.exists(path) && !dir.exists(path)) { |
| 105 | + return(copy_pak_archive(path, archive)) |
| 106 | + } |
| 107 | + |
| 108 | + tree_path <- if (grepl("-t$", path)) path else paste0(path, "-t") |
| 109 | + if (file.exists(tree_path) && !dir.exists(tree_path)) { |
| 110 | + return(copy_pak_archive(tree_path, archive)) |
| 111 | + } |
| 112 | + |
| 113 | + if (dir.exists(tree_path)) { |
| 114 | + return(tar_pak_tree(tree_path, archive)) |
| 115 | + } |
| 116 | + |
| 117 | + if (file.exists(archive) && !dir.exists(archive)) { |
| 118 | + return(archive) |
| 119 | + } |
| 120 | + |
| 121 | + NULL |
| 122 | +} |
| 123 | + |
| 124 | +copy_pak_archive <- function(from, to) { |
| 125 | + from_norm <- normalizePath(from, mustWork = TRUE) |
| 126 | + to_norm <- normalizePath(to, mustWork = FALSE) |
| 127 | + |
| 128 | + if (from_norm == to_norm) { |
| 129 | + return(to) |
| 130 | + } |
| 131 | + |
| 132 | + if (file.exists(to)) { |
| 133 | + unlink(to, recursive = TRUE) |
| 134 | + } |
| 135 | + |
| 136 | + if (!dir.exists(dirname(to))) { |
| 137 | + dir.create(dirname(to), recursive = TRUE, showWarnings = FALSE) |
| 138 | + } |
| 139 | + |
| 140 | + ok <- file.copy(from, to, overwrite = TRUE) |
| 141 | + if (!isTRUE(ok)) { |
| 142 | + stop(sprintf("Failed to copy downloaded archive to %s.", to)) |
| 143 | + } |
| 144 | + |
| 145 | + to |
| 146 | +} |
| 147 | + |
| 148 | +tar_pak_tree <- function(tree_path, archive) { |
| 149 | + files <- list.files(tree_path, all.files = TRUE, no.. = TRUE) |
| 150 | + if (length(files) < 1L) { |
| 151 | + stop(sprintf("Downloaded package tree is empty: %s.", tree_path)) |
| 152 | + } |
| 153 | + |
| 154 | + if (file.exists(archive)) { |
| 155 | + unlink(archive, recursive = TRUE) |
| 156 | + } |
| 157 | + |
| 158 | + if (!dir.exists(dirname(archive))) { |
| 159 | + dir.create(dirname(archive), recursive = TRUE, showWarnings = FALSE) |
| 160 | + } |
| 161 | + |
| 162 | + # utils::tar() needs relative file paths to avoid absolute paths in archives. |
| 163 | + archive <- normalizePath(archive, mustWork = FALSE) |
| 164 | + old_wd <- setwd(tree_path) |
| 165 | + on.exit(setwd(old_wd), add = TRUE) |
| 166 | + |
| 167 | + utils::tar( |
| 168 | + tarfile = archive, |
| 169 | + files = files, |
| 170 | + compression = "gzip", |
| 171 | + tar = "internal" |
| 172 | + ) |
| 173 | + |
| 174 | + if (!file.exists(archive)) { |
| 175 | + stop(sprintf( |
| 176 | + "Failed to create archive from downloaded package tree: %s.", |
| 177 | + archive |
| 178 | + )) |
| 179 | + } |
| 180 | + |
| 181 | + archive |
| 182 | +} |
0 commit comments