|
| 1 | +#' Use a Google Drive folder as a board |
| 2 | +#' |
| 3 | +#' Pin data to a folder in Google Drive using the googledrive package. |
| 4 | +#' |
| 5 | +#' @inheritParams new_board |
| 6 | +#' @param path Path to existing directory on Google Drive to store pins. Can be |
| 7 | +#' given as an actual path like `"path/to/folder"` (character), a file id or |
| 8 | +#' URL marked with [googledrive::as_id()], or a [googledrive::dribble]. |
| 9 | +#' |
| 10 | +#' @details |
| 11 | +#' * The functions in pins do not create a new Google Drive folder. You can |
| 12 | +#' create a new folder from R with [googledrive::drive_mkdir()], and then set |
| 13 | +#' the sharing for your folder with [googledrive::drive_share()]. |
| 14 | +#' * If you have problems with authentication to Google Drive, learn more at |
| 15 | +#' [googledrive::drive_auth()]. |
| 16 | +#' * `board_gdrive()` is powered by the googledrive package, which is a |
| 17 | +#' suggested dependency of pins (not required for pins in general). If |
| 18 | +#' you run into errors when deploying content to a server like |
| 19 | +#' <https://www.shinyapps.io> or [Connect](https://posit.co/products/enterprise/connect/), |
| 20 | +#' add `requireNamespace("googledrive")` to your app or document for [automatic |
| 21 | +#' dependency discovery](https://docs.posit.co/connect/user/troubleshooting/#render-missing-r-package). |
| 22 | +#' |
| 23 | +#' @export |
| 24 | +#' |
| 25 | +#' @examples |
| 26 | +#' \dontrun{ |
| 27 | +#' board <- board_gdrive("folder-for-my-pins") |
| 28 | +#' board %>% pin_write(1:10, "great-integers", type = "json") |
| 29 | +#' board %>% pin_read("great-integers") |
| 30 | +#' } |
| 31 | +board_gdrive <- function(path, |
| 32 | + versioned = TRUE, |
| 33 | + cache = NULL) { |
| 34 | + check_installed("googledrive") |
| 35 | + dribble <- googledrive::as_dribble(path) |
| 36 | + |
| 37 | + if (!googledrive::single_file(dribble) || !googledrive::is_folder(dribble)) { |
| 38 | + cli::cli_abort(c( |
| 39 | + "{.arg path} must resolve to a single existing Drive folder", |
| 40 | + i = "Consider creating your pin board with {.fun googledrive::drive_mkdir}" |
| 41 | + )) |
| 42 | + } |
| 43 | + |
| 44 | + cache <- cache %||% board_cache_path(paste0("gdrive-", hash(dribble$id))) |
| 45 | + new_board_v1( |
| 46 | + "pins_board_gdrive", |
| 47 | + dribble = dribble, |
| 48 | + cache = cache, |
| 49 | + versioned = versioned |
| 50 | + ) |
| 51 | +} |
| 52 | + |
| 53 | +board_gdrive_test <- function(...) { |
| 54 | + skip_if_missing_envvars( |
| 55 | + tests = "board_gdrive()", |
| 56 | + envvars = c("PINS_GDRIVE_USE_PERSONAL") |
| 57 | + ) |
| 58 | + |
| 59 | + board_gdrive("pins-testing", cache = tempfile()) |
| 60 | +} |
| 61 | + |
| 62 | +#' @export |
| 63 | +pin_list.pins_board_gdrive <- function(board, ...) { |
| 64 | + googledrive::drive_ls(board$dribble)$name |
| 65 | +} |
| 66 | + |
| 67 | +#' @export |
| 68 | +pin_exists.pins_board_gdrive <- function(board, name, ...) { |
| 69 | + all_names <- googledrive::drive_ls(board$dribble$name)$name |
| 70 | + name %in% all_names |
| 71 | +} |
| 72 | + |
| 73 | +#' @export |
| 74 | +pin_delete.pins_board_gdrive <- function(board, names, ...) { |
| 75 | + for (name in names) { |
| 76 | + check_pin_exists(board, name) |
| 77 | + gdrive_delete_dir(board, name) |
| 78 | + } |
| 79 | + invisible(board) |
| 80 | +} |
| 81 | + |
| 82 | +#' @export |
| 83 | +pin_version_delete.pins_board_gdrive <- function(board, name, version, ...) { |
| 84 | + gdrive_delete_dir(board, fs::path(name, version)) |
| 85 | +} |
| 86 | + |
| 87 | +#' @export |
| 88 | +pin_versions.pins_board_gdrive <- function(board, name, ...) { |
| 89 | + check_pin_exists(board, name) |
| 90 | + path <- fs::path(board$dribble$path, name) |
| 91 | + version_from_path(sort(googledrive::drive_ls(path)$name)) |
| 92 | +} |
| 93 | + |
| 94 | + |
| 95 | +#' @export |
| 96 | +pin_meta.pins_board_gdrive <- function(board, name, version = NULL, ...) { |
| 97 | + googledrive::local_drive_quiet() |
| 98 | + check_pin_exists(board, name) |
| 99 | + version <- check_pin_version(board, name, version) |
| 100 | + metadata_key <- fs::path(name, version, "data.txt") |
| 101 | + |
| 102 | + if (!gdrive_file_exists(board, metadata_key)) { |
| 103 | + abort_pin_version_missing(version) |
| 104 | + } |
| 105 | + |
| 106 | + path_version <- fs::path(board$cache, name, version) |
| 107 | + fs::dir_create(path_version) |
| 108 | + |
| 109 | + gdrive_download(board, metadata_key) |
| 110 | + local_meta( |
| 111 | + read_meta(fs::path(board$cache, name, version)), |
| 112 | + name = name, |
| 113 | + dir = path_version, |
| 114 | + version = version |
| 115 | + ) |
| 116 | +} |
| 117 | + |
| 118 | +#' @export |
| 119 | +pin_fetch.pins_board_gdrive <- function(board, name, version = NULL, ...) { |
| 120 | + googledrive::local_drive_quiet() |
| 121 | + meta <- pin_meta(board, name, version = version) |
| 122 | + cache_touch(board, meta) |
| 123 | + |
| 124 | + for (file in meta$file) { |
| 125 | + key <- fs::path(name, meta$local$version, file) |
| 126 | + gdrive_download(board, key) |
| 127 | + } |
| 128 | + |
| 129 | + meta |
| 130 | +} |
| 131 | + |
| 132 | +#' @export |
| 133 | +pin_store.pins_board_gdrive <- function(board, name, paths, metadata, |
| 134 | + versioned = NULL, ...) { |
| 135 | + googledrive::local_drive_quiet() |
| 136 | + check_pin_name(name) |
| 137 | + version <- version_setup(board, name, version_name(metadata), versioned = versioned) |
| 138 | + |
| 139 | + gdrive_mkdir(board$dribble$name, name) |
| 140 | + gdrive_mkdir(fs::path(board$dribble$name, name), version) |
| 141 | + |
| 142 | + version_dir <- fs::path(name, version) |
| 143 | + |
| 144 | + # Upload metadata |
| 145 | + temp_file <- withr::local_tempfile() |
| 146 | + yaml::write_yaml(metadata, file = temp_file) |
| 147 | + googledrive::drive_upload( |
| 148 | + temp_file, |
| 149 | + fs::path(board$dribble$path, version_dir, "data.txt") |
| 150 | + ) |
| 151 | + |
| 152 | + # Upload files |
| 153 | + for (path in paths) { |
| 154 | + googledrive::drive_upload( |
| 155 | + path, |
| 156 | + fs::path(board$dribble$path, version_dir, fs::path_file(path)) |
| 157 | + ) |
| 158 | + } |
| 159 | + |
| 160 | + name |
| 161 | +} |
| 162 | + |
| 163 | + |
| 164 | +#' @rdname required_pkgs.pins_board |
| 165 | +#' @export |
| 166 | +required_pkgs.pins_board_gdrive <- function(x, ...) { |
| 167 | + ellipsis::check_dots_empty() |
| 168 | + "googledrive" |
| 169 | +} |
| 170 | + |
| 171 | + |
| 172 | +# Helpers ----------------------------------------------------------------- |
| 173 | + |
| 174 | +gdrive_file_exists <- function(board, name) { |
| 175 | + path <- fs::path(board$dribble$name, fs::path_dir(name)) |
| 176 | + name <- fs::path_file(name) |
| 177 | + possibly_drive_ls <- purrr::possibly(googledrive::drive_ls) |
| 178 | + all_names <- possibly_drive_ls(path) |
| 179 | + name %in% all_names$name |
| 180 | +} |
| 181 | + |
| 182 | +gdrive_delete_dir <- function(board, dir) { |
| 183 | + path <- fs::path(board$dribble$path, dir) |
| 184 | + googledrive::drive_trash(path) |
| 185 | + invisible() |
| 186 | +} |
| 187 | + |
| 188 | +gdrive_download <- function(board, key) { |
| 189 | + path <- fs::path(board$cache, key) |
| 190 | + if (!fs::file_exists(path)) { |
| 191 | + googledrive::drive_download(key, path) |
| 192 | + fs::file_chmod(path, "u=r") |
| 193 | + } |
| 194 | + path |
| 195 | +} |
| 196 | + |
| 197 | +gdrive_mkdir <- function(dir, name) { |
| 198 | + dribble <- googledrive::as_dribble(fs::path(dir, name)) |
| 199 | + if (googledrive::no_file(dribble) || !googledrive::is_folder(dribble)) { |
| 200 | + googledrive::drive_mkdir(name, dir, overwrite = FALSE) |
| 201 | + } |
| 202 | + invisible() |
| 203 | +} |
0 commit comments