diff --git a/DESCRIPTION b/DESCRIPTION index 20636bf7..49050207 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: osfr Title: R Interface to OSF -Version: 0.2.1 +Version: 0.2.2 Authors@R: c( person("Aaron", "Wolen",, "aaron@wolen.com", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-2542-2202")), diff --git a/NAMESPACE b/NAMESPACE index db06815b..a90a4524 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -11,11 +11,13 @@ S3method(osf_ls_nodes,osf_tbl_node) S3method(osf_ls_nodes,osf_tbl_user) S3method(osf_mkdir,osf_tbl_file) S3method(osf_mkdir,osf_tbl_node) +S3method(osf_mv,osf_tbl_file) S3method(osf_open,character) S3method(osf_open,default) S3method(osf_open,osf_id) S3method(osf_open,osf_tbl) S3method(osf_open,osf_tbl_file) +S3method(osf_rm,osf_tbl_file) S3method(osf_rm,osf_tbl_node) S3method(osf_upload,osf_tbl_file) S3method(osf_upload,osf_tbl_node) @@ -29,6 +31,7 @@ export(osf_download) export(osf_ls_files) export(osf_ls_nodes) export(osf_mkdir) +export(osf_mv) export(osf_open) export(osf_retrieve_file) export(osf_retrieve_node) diff --git a/NEWS.md b/NEWS.md index d748c377..3910afb4 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,18 @@ +# osfr 0.2.2 + +## New functions + +* `osf_mv()` to move files and directories to a new project, component, or +subdirectory + +## New features + +* `osf_rm()` can now delete files and directories + +## Minor improvements and fixes + +* Restructured tests to better handle environments in which `OSF_PAT` and/or `OSF_SERVER` are not defined + # osfr 0.2.1 * Minor tweaks to the website diff --git a/R/api-client-osf.R b/R/api-client-osf.R index b62372a4..aeeaff57 100644 --- a/R/api-client-osf.R +++ b/R/api-client-osf.R @@ -26,7 +26,9 @@ user_agent <- function(agent = "osfr") { headers <- list( `User-Agent` = user_agent(), - `Accept-Header` = sprintf("application/vnd.api+json;version=%s", .osf_api_version) + `Accept-Header` = sprintf( + "application/vnd.api+json;version=%s", + .osf_api_version) ) if (!is.null(pat)) { @@ -46,7 +48,14 @@ user_agent <- function(agent = "osfr") { # OSF API request functions ----------------------------------------------- -.osf_request <- function(method, path, query = list(), body = NULL, verbose = FALSE, ...) { +.osf_request <- + function(method, + path, + query = list(), + body = NULL, + verbose = FALSE, + ...) { + method <- match.arg(method, c("get", "put", "patch", "post", "delete")) cli <- .osf_cli() method <- cli[[method]] @@ -54,7 +63,13 @@ user_agent <- function(agent = "osfr") { } # TODO: .osf_request and .osf_paginated_request returns should be consistent -.osf_paginated_request <- function(method, path, query = list(), n_max = 100, verbose = FALSE) { +.osf_paginated_request <- + function(method, + path, + query = list(), + n_max = 100, + verbose = FALSE) { + items <- list() i <- 1 retrieved <- 0 @@ -72,7 +87,9 @@ user_agent <- function(agent = "osfr") { items <- c(items, out$data) if (verbose && n_max > 10) { - if (i == 1) message(sprintf("Retrieving %i of %i available items:", n_max, total)) + if (i == 1) { + message(sprintf("Retrieving %i of %i available items:", n_max, total)) + } message(sprintf("..retrieved %i items", retrieved), appendLF = TRUE) } diff --git a/R/api-client-wb.R b/R/api-client-wb.R index 38e78249..884d8d03 100644 --- a/R/api-client-wb.R +++ b/R/api-client-wb.R @@ -8,7 +8,12 @@ #' a trailing flash when referring to a folder #' #' @noRd -.wb_api_path <- function(id, fid = NULL, provider = "osfstorage", type = "folder") { +.wb_api_path <- + function(id, + fid = NULL, + provider = "osfstorage", + type = "folder") { + type <- match.arg(type, c("folder", "file")) api_v <- floor(.wb_api_version) if (is.null(fid)) { @@ -51,8 +56,15 @@ # Waterbutler request functions ------------------------------------------- -.wb_request <- function(method, path, query = list(), body = NULL, verbose = FALSE, ...) { - method <- match.arg(method, c("get", "put", "patch", "delete")) +.wb_request <- + function(method, + path, + query = list(), + body = NULL, + verbose = FALSE, + ...) { + + method <- match.arg(method, c("get", "put", "patch", "post", "delete")) cli <- .wb_cli() method <- cli[[method]] method(path, query, body = body, ...) diff --git a/R/api-endpoints-wb.R b/R/api-endpoints-wb.R index 5c911eaf..047e1d6e 100644 --- a/R/api-endpoints-wb.R +++ b/R/api-endpoints-wb.R @@ -59,7 +59,8 @@ type <- match.arg(type, c("file", "folder")) query <- list() if (zip) query$zip <- "" - res <- .wb_request("get", .wb_api_path(id, fid, type = type), query, disk = path) + api_path <- .wb_api_path(id, fid, type = type) + res <- .wb_request("get", api_path, query, disk = path) if (res$status_code == 200) return(TRUE) if (res$status_code == 404) { msg <- sprintf("The requested %s (%s) could not be found in node `%s`", diff --git a/R/osf_create.R b/R/osf_create.R index def88671..c3c0d669 100644 --- a/R/osf_create.R +++ b/R/osf_create.R @@ -76,7 +76,7 @@ osf_create_component <- category = NULL) { if (missing(x) || !inherits(x, "osf_tbl_node")) - abort("`x` must be an `osf_tbl_node` referencing an existing project/component. ") + abort("`x` must be an `osf_tbl_node` referencing an existing project/component.") if (missing(title)) abort("Must define a title for the new component.") out <- .osf_node_create( diff --git a/R/osf_ls_files.R b/R/osf_ls_files.R index 58592071..094960c3 100644 --- a/R/osf_ls_files.R +++ b/R/osf_ls_files.R @@ -53,7 +53,13 @@ osf_ls_files.osf_tbl_node <- verbose = FALSE) { x <- make_single(x) - .osf_list_files(x, path, type, pattern, n_max, verbose) + + if (!is.null(path) && path != ".") { + leaf_dir <- recurse_path(x, path, missing_action = "error", verbose) + return(osf_ls_files(leaf_dir, path = ".", type, pattern, n_max, verbose)) + } + + .osf_list_files(x, type, pattern, n_max, verbose) } #' @export @@ -69,33 +75,31 @@ osf_ls_files.osf_tbl_file <- if (is_osf_file(x)) { abort("Listing an `osf_tbl_file` requires a directory\n* `x` contains a file") } - .osf_list_files(x, path, type, pattern, n_max, verbose) + + # walk down path tree and replace x with the leaf directory + if (!is.null(path) && path != ".") { + x <- recurse_path(x, path, missing_action = "error", verbose = verbose) + } + + .osf_list_files(x, type, pattern, n_max, verbose) } -.osf_list_files <- function(x, path, type, pattern, n_max, verbose) { +#' Internal list files method +#' +#' This requires an API path to more easily support different storage providers +#' in the future when listing from a node. +#' @return An `osf_tbl_file`. +#' @noRd +.osf_list_files <- function(x, type, pattern, n_max, verbose) { - # manually construct path for nodes because the provided files endpoint is - # for listing storage providers + # manually construct the API path because the 'files' endpoint for nodes lists + # the enabled storage providers api_path <- switch(class(x)[1], osf_tbl_node = .osf_api_path(sprintf("nodes/%s/files/osfstorage/", as_id(x))), osf_tbl_file = crul::url_parse(get_relation(x, "files"))$path ) - # recurse if path contains subdirectories - path <- path %||% "." - if (path != ".") { - path_root <- fs::path_split(path)[[1]][1] - root_dir <- find_exact_match(x, name = path_root, type = "folder") - if (nrow(root_dir) == 0) { - abort(sprintf("Can't find path `%s` within `%s`", path, x$name)) - } - - next_path <- fs::path_rel(path, path_root) - res <- .osf_list_files(root_dir, next_path, type, pattern, n_max, verbose) - return(as_osf_tbl(res, "osf_tbl_file")) - } - res <- .osf_paginated_request( method = "get", path = api_path, diff --git a/R/osf_ls_nodes.R b/R/osf_ls_nodes.R index 64a62b81..897cb338 100644 --- a/R/osf_ls_nodes.R +++ b/R/osf_ls_nodes.R @@ -41,7 +41,14 @@ osf_ls_nodes.osf_tbl_node <- n_max = 10, verbose = FALSE) { x <- make_single(x) - out <- .osf_node_children(as_id(x), n_max, filter_nodes(pattern = pattern), verbose) + + out <- .osf_node_children( + id = as_id(x), + n_max = n_max, + query = filter_nodes(pattern = pattern), + verbose = verbose + ) + raise_error(out) as_osf_tbl(out, "osf_tbl_node") } @@ -53,7 +60,14 @@ osf_ls_nodes.osf_tbl_user <- n_max = 10, verbose = FALSE) { x <- make_single(x) - out <- .osf_user_nodes(as_id(x), n_max, filter_nodes(pattern = pattern), verbose) + + out <- .osf_user_nodes( + id = as_id(x), + n_max = n_max, + query = filter_nodes(pattern = pattern), + verbose = verbose + ) + raise_error(out) as_osf_tbl(out, "osf_tbl_node") } diff --git a/R/osf_mkdir.R b/R/osf_mkdir.R index c39c8038..27207990 100644 --- a/R/osf_mkdir.R +++ b/R/osf_mkdir.R @@ -36,58 +36,74 @@ osf_mkdir <- function(x, path, verbose = FALSE) { #' @export osf_mkdir.osf_tbl_node <- function(x, path, verbose = FALSE) { - x <- make_single(x) - id <- as_id(x) + recurse_path(x, path, missing_action = "create", verbose) +} - # does path root already exist? - path_root <- fs::path_split(path)[[1]][1] - items <- osf_ls_files(x, type = "folder", pattern = path_root) - dir_root <- items[which(items$name == path_root), ] +#' @export +osf_mkdir.osf_tbl_file <- function(x, path, verbose = FALSE) { + if (is_osf_file(x)) abort("Can't create directories within a file.") + x <- make_single(x) + recurse_path(x, path, missing_action = "create", verbose) +} - if (nrow(dir_root) == 0) { - res <- .wb_create_folder(id = id, name = path_root) - raise_error(res) - dir_id <- gsub("/", "", res$data$attributes$path, fixed = TRUE) - dir_root <- osf_retrieve_file(dir_id) - msg <- sprintf("Created directory '%s/' in node %s", path_root, id) - } else { - msg <- sprintf("Directory '%s/' already exists in node %s", path_root, id) - } - if (verbose) message(msg) +#' Create a single folder on OSF +#' +#' This wraps the create folder endpoint on Waterbutler but retrieves the newly +#' created directory from OSF because Waterbutler returns only a subset of the +#' information provided by OSF. +#' +#' @param id GUID for an OSF project or component +#' @param name Name of the new directory (note: this must be the name of a +#' single directory, not a path) +#' @param fid Optional, provide a Waterbutler folder ID to create the new folder +#' within the specified existing folder. +#' @noRd - # recurse to the next-level if there is a subfolder - path_next <- fs::path_rel(path, path_root) - if (path_next == ".") { - out <- dir_root - } else { - out <- osf_mkdir(dir_root, path_next, verbose) - } - out +.osf_mkdir <- function(id, name, fid = NULL) { + res <- .wb_create_folder(id, name, fid) + raise_error(res) + dir_id <- gsub("/", "", res$data$attributes$path, fixed = TRUE) + osf_retrieve_file(dir_id) } -#' @export -osf_mkdir.osf_tbl_file <- function(x, path, verbose = FALSE) { - x <- make_single(x) - id <- as_id(x) - if (is_osf_file(x)) abort("Can't create directories within a file.") - # does path root already exist? +#' Recurse a directory path +#' +#' Given a path like 'root/subdir1/subdir2', this will retrieve each directory +#' level from OSF and return the leaf directory. The `missing_action` argument +#' determines what happens if an intermediate directory does not exist. +#' +#' @param x An `osf_tbl_node` or an `osf_tbl_file` with a directory. +#' @param path A path of directories. +#' @param missing_action Either `"error"` or `"create"` to create the missing +#' directory. +#' @noRd +recurse_path <- function(x, path, missing_action = "error", verbose = FALSE) { + missing_action <- match.arg(missing_action, c("error", "create")) + path_root <- fs::path_split(path)[[1]][1] - items <- osf_ls_files(x, type = "folder", pattern = path_root) - dir_root <- items[which(items$name == path_root), ] + root_dir <- osf_ls_files(x, type = "folder", pattern = path_root) - if (nrow(dir_root) == 0) { - res <- .wb_create_folder(id = get_parent_id(x), name = path_root, fid = id) - raise_error(res) + if (nrow(root_dir) == 0) { + if (missing_action == "error") { + abort(sprintf("Can't find directory '%s' in `%s`", path_root, x$name)) + } - dir_id <- gsub("/", "", res$data$attributes$path, fixed = TRUE) - dir_root <- osf_retrieve_file(dir_id) - msg <- sprintf("Created sub-directory '%s/' in directory '%s/'", + # create the missing directory + if (inherits(x, "osf_tbl_node")) { + root_dir <- .osf_mkdir(as_id(x), name = path_root) + msg <- sprintf("Created directory '%s/' in node %s", + path_root, as_id(x)) + } else { + root_dir <- .osf_mkdir(get_parent_id(x), name = path_root, fid = as_id(x)) + msg <- sprintf("Created sub-directory '%s/' in directory '%s/'", path_root, x$name) + } + } else { - msg <- sprintf("Sub-directory '%s/' already exists in directory '%s/'", + msg <- sprintf("Navigating to sub-directory '%s/' in '%s'", path_root, x$name) } @@ -96,9 +112,9 @@ osf_mkdir.osf_tbl_file <- function(x, path, verbose = FALSE) { # recurse to the next-level if there is a subfolder path_next <- fs::path_rel(path, path_root) if (path_next == ".") { - out <- dir_root + out <- root_dir } else { - out <- osf_mkdir(dir_root, path_next, verbose) + out <- Recall(root_dir, path_next, missing_action, verbose) } out } diff --git a/R/osf_mv.R b/R/osf_mv.R new file mode 100644 index 00000000..4a7181ce --- /dev/null +++ b/R/osf_mv.R @@ -0,0 +1,113 @@ +#' Move a file or directory +#' +#' Use `osf_mv()` to move a file or directory to a new project, component, or +#' subdirectory. +#' +#' @param x An [`osf_tbl_file`] containing a single file or directory. +#' @param to The destination where the file or directory will be copied to. This +#' can be one of the following: +#' * An [`osf_tbl_node`] with a single project or component. +#' * An [`osf_tbl_file`] with a single directory. +#' @param overwrite Logical, if a file or directory with the same name already +#' exists at the destination should it be replaced with `x`? +#' @template verbose +#' +#' @return An [`osf_tbl_file`] containing the updated OSF file. +#' +#' @examples +#' \dontrun{ +#' # Create an example file to upload to our example project +#' project <- osf_create_project("Flower Data") +#' +#' write.csv(iris, file = "iris.csv") +#' data_file <- osf_upload(project,"iris.csv") +#' +#' # Create a new directory to move our file to +#' data_dir <- osf_mkdir(project, "data") +#' +#' # Move the file to our data directory +#' data_file <- osf_mv(data_file, to = data_dir) +#' +#' # Move our data directory to a new component +#' data_comp <- osf_create_component(project, title = "data", category = "data") +#' data_file %>% +#' osf_mv(to = data_comp) %>% +#' osf_open() +#' } +#' +#' @export +osf_mv <- function(x, to, overwrite = FALSE, verbose = FALSE) { + UseMethod("osf_mv") +} + +#' @export +osf_mv.osf_tbl_file <- function(x, to, overwrite = FALSE, verbose = FALSE) { + x <- make_single(x) + out <- .wb_file_move( + x, + to = to, + action = "move", + overwrite = overwrite, + verbose = verbose + ) + as_osf_tbl(out["data"], subclass = "osf_tbl_file") +} + + +#' Internal method for moving/copying files +#' @noRd +#' @references +#' https://waterbutler.readthedocs.io/en/latest/api.html#actions +.wb_file_move <- function(x, to, action, overwrite, verbose) { + action <- match.arg(action, c("move", "copy")) + conflict <- ifelse(overwrite, "replace", "warn") + + if (inherits(to, "osf_tbl_file")) { + if (is_osf_file(to)) { + abort("If `to` is an `osf_tbl_file` it must contain a directory, not a file.") + } + + # verify destination is not a child of x + is_child_dest <- fs::path_has_parent( + get_meta(to, "attributes", "materialized_path"), + get_meta(x, "attributes", "materialized_path") + ) + if (is_child_dest) abort("Can't move a parent directory into its child.") + } + + api_url <- get_meta(x, "links", "move") + api_path <- crul::url_parse(api_url)$path + + req <- modifyList( + build_move_request(to), + list(action = action, conflict = conflict) + ) + + res <- .wb_request("post", api_path, body = req, encode = "json") + out <- process_response(res) + raise_error(out) + + if (verbose) message(sprintf("Moved '%s' to '%s'.", x$name, to$name)) + + # retrieve osf representation of file + file_id <- strsplit(out$data$id, split = "/", fixed = TRUE)[[1]][2] + .osf_file_retrieve(file_id) +} + + +# Construct the move/copy request's body +build_move_request <- function(x) UseMethod("build_move_request") + +build_move_request.osf_tbl_file <- function(x) { + list( + path = get_meta(x, "attributes", "path") + ) +} + +build_move_request.osf_tbl_node <- function(x) { + list( + path = "/", + resource = unclass(as_id(x)), + provider = "osfstorage" + ) +} diff --git a/R/osf_rm.R b/R/osf_rm.R index 1b6dba3c..775670dc 100644 --- a/R/osf_rm.R +++ b/R/osf_rm.R @@ -1,20 +1,24 @@ -#' Delete projects or components from OSF +#' Delete an entity from OSF #' #' @description -#' Use `osf_rm()` to *permanently* delete a project or component from OSF, -#' including any uploaded files, wiki content, or comments contained therein. -#' Because this process is irreversible, osfr will first open the item in your -#' web browser so you can verify the item before proceeding. +#' Use `osf_rm()` to **permanently** delete a project, component, file or +#' directory from OSF, including any uploaded files, wiki content, or comments +#' contained therein. Because this process is **irreversible**, osfr will first +#' open the item in your web browser so you can verify what is about to be +#' deleted before proceeding. #' -#' If the project or component contains sub-components, those must be deleted -#' first. Setting `recursive = TRUE` will attempt to remove the hierarchy -#' of sub-components before deleting the top-level entity. +#' If the project or component targeted for deletion contains sub-components, +#' those must be deleted first. Setting `recursive = TRUE` will attempt to +#' remove the hierarchy of sub-components before deleting the top-level entity. #' #' *Note: This functionality is limited to contributors with admin-level #' permissions.* #' -#' @param x an [`osf_tbl_node`] -#' @param recursive Remove all sub-components before deleting the top-level entity. +#' @param x One of the following: +#' * An [`osf_tbl_node`] with a single OSF project or component. +#' * An [`osf_tbl_file`] containing a single directory or file. +#' @param recursive Remove all sub-components before deleting the top-level +#' entity. This only applies when deleting projects or components. #' @param check If `FALSE` deletion will proceed without opening the item or #' requesting verification---this effectively removes your safety net. #' @template verbose @@ -28,12 +32,21 @@ #' } #' #' @export -osf_rm <- function(x, recursive = FALSE, verbose = FALSE, check = TRUE) { +osf_rm <- + function(x, + recursive = FALSE, + verbose = FALSE, + check = TRUE) { UseMethod("osf_rm") } #' @export -osf_rm.osf_tbl_node <- function(x, recursive = FALSE, verbose = FALSE, check = TRUE) { +osf_rm.osf_tbl_node <- + function(x, + recursive = FALSE, + verbose = FALSE, + check = TRUE) { + x <- make_single(x) id <- as_id(x) @@ -41,7 +54,8 @@ osf_rm.osf_tbl_node <- function(x, recursive = FALSE, verbose = FALSE, check = T child_ids <- recurse_node(id, maxdepth = Inf) if (verbose) { message( - sprintf("Retrieved %i components under node: %s", length(child_ids), id)) + sprintf("Retrieved %i components under node: %s", length(child_ids), id) + ) } # reverse to begin with the most deeply nested node @@ -49,7 +63,7 @@ osf_rm.osf_tbl_node <- function(x, recursive = FALSE, verbose = FALSE, check = T child <- child_ids[i] if (child == id) break if (check) { - if (!rm_check(child)) return(invisible()) + if (!rm_check(child, "node")) return(invisible()) } .osf_node_delete(child) if (verbose) { @@ -60,7 +74,7 @@ osf_rm.osf_tbl_node <- function(x, recursive = FALSE, verbose = FALSE, check = T } if (check) { - if (!rm_check(id)) return(invisible()) + if (!rm_check(id, "node")) return(invisible()) } out <- .osf_node_delete(id) if (isTRUE(out)) { @@ -69,10 +83,46 @@ osf_rm.osf_tbl_node <- function(x, recursive = FALSE, verbose = FALSE, check = T } } -rm_check <- function(id) { +#' @export +osf_rm.osf_tbl_file <- + function(x, + recursive = FALSE, + verbose = FALSE, + check = TRUE) { + + x <- make_single(x) + id <- as_id(x) + + type <- get_meta(x, "attributes", "kind") + endpoint <- get_meta(x, "links", "delete") + + if (check) { + if (!rm_check(id, type)) return(invisible()) + } + + res <- .wb_request("delete", crul::url_parse(endpoint)$path) + if (res$status_code == 204) { + if (verbose) message(sprintf("Deleted file %s", id)) + return(invisible(TRUE)) + } else if (res$status_code == 404) { + abort("The specified file is no longer available.") + } else { + raise_error(process_response(res)) + } +} + + +#' Remove check +#' Open the item targeted for deletion on OSF and ask the user to verify they +#' want to proceed. +#' @param id GUID +#' @param type a character describing the entity type (e.g., file, folder) +#' @noRd +rm_check <- function(id, type) { osf_open(id) question <- sprintf( - "I just opened node '%s' in your browser.\nAre you sure you want to PERMANENTLY delete it?", + "I just opened %s '%s' in your browser.\nAre you sure you want to PERMANENTLY delete it?", + type, id ) yesno_menu(question) diff --git a/R/osf_upload.R b/R/osf_upload.R index db43269b..4be81572 100644 --- a/R/osf_upload.R +++ b/R/osf_upload.R @@ -45,7 +45,9 @@ osf_upload <- verbose = FALSE) { if (!file.exists(path)) abort(sprintf("Can't find file:\n %s", path)) - if (is_dir(path)) abort("`path` must point to a file\n* Uploading directories is not supported") + if (is_dir(path)) { + abort("`path` must point to a file\n* Uploading directories is not supported") + } UseMethod("osf_upload") } diff --git a/R/utils-api-responses.R b/R/utils-api-responses.R index 540e7261..ff3f5383 100644 --- a/R/utils-api-responses.R +++ b/R/utils-api-responses.R @@ -23,7 +23,7 @@ process_response <- function(res) { if (res$status_code > 500) { abort(paste0( "Encountered an unexpected error with the OSF API\n", - "Please report this at https://github.com/aaronwolen/osfr/issues\n", + "Please report this at https://github.com/centerforopenscience/osfr/issues\n", "* Status code: ", res$status_code, "\n", "* Request: ", res$request$url$url )) @@ -89,8 +89,8 @@ parse_datetime_attrs <- function(x) { stopifnot("attributes" %in% names(x)) x$attributes <- purrr::modify_at(x$attributes, - .at = c("date_registered", "date_created", "date_modified", "modified_utc"), - .f = parse_datetime + .at = c("date_registered", "date_created", "date_modified", "modified_utc"), + .f = parse_datetime ) return(x) diff --git a/R/utils.R b/R/utils.R index a64dd744..9513da4a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -32,23 +32,6 @@ is_osf_file <- function(x) { kind == "file" } -#' Return an OSF file or folder based on name matching -#' -#' Useful in situations where we need to know if a file or directory already -#' exists on OSF and want to retrieve it without knowing its ID. This is just a -#' wrapper around `osf_ls_files` that verifies a returned entity's name exactly -#' matches the specified `name` argument. This isn't possible with -#' `osf_ls_files` since OSF API uses substring matching. -#' -#' @param name string containing the exact name to be matched against -#' @return an [`osf_tbl_file`] containing a single matching entity or zero rows -#' if no match was found -#' @noRd -find_exact_match <- function(x, name, type = "files") { - items <- osf_ls_files(x, pattern = name, type = type) - items[items$name == name, ] -} - # extract OSF and Waterbutler identifiers from known URL schemes extract_osf_id <- function(url) { @@ -126,9 +109,25 @@ osf_dev_off <- function() { #' @noRd yesno_menu <- function(question) { - yeses <- c("Yes", "Definitely", "For sure", "Yup", "Yeah", "Absolutely", "Yes, 100%") - nos <- c("No way", "Not yet", "I don't think so", "No", "Nope", "Uhhhh... Maybe?", - "No. That's my final answer") + yeses <- c( + "Yes", + "Definitely", + "For sure", + "Yup", + "Yeah", + "Absolutely", + "Yes, 100%" + ) + + nos <- c( + "No way", + "Not yet", + "I don't think so", + "No", + "Nope", + "Uhhhh... Maybe?", + "No. That's my final answer" + ) qs <- c(sample(yeses, 1), sample(nos, 2)) rand <- sample(length(qs)) diff --git a/man/osf_mv.Rd b/man/osf_mv.Rd new file mode 100644 index 00000000..70695f90 --- /dev/null +++ b/man/osf_mv.Rd @@ -0,0 +1,53 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/osf_mv.R +\name{osf_mv} +\alias{osf_mv} +\title{Move a file or directory} +\usage{ +osf_mv(x, to, overwrite = FALSE, verbose = FALSE) +} +\arguments{ +\item{x}{An \code{\link{osf_tbl_file}} containing a single file or directory.} + +\item{to}{The destination where the file or directory will be copied to. This +can be one of the following: +\itemize{ +\item An \code{\link{osf_tbl_node}} with a single project or component. +\item An \code{\link{osf_tbl_file}} with a single directory. +}} + +\item{overwrite}{Logical, if a file or directory with the same name already +exists at the destination should it be replaced with \code{x}?} + +\item{verbose}{Logical, indicating whether to print informative messages +about interactions with the OSF API (default \code{FALSE}).} +} +\value{ +An \code{\link{osf_tbl_file}} containing the updated OSF file. +} +\description{ +Use \code{osf_mv()} to move a file or directory to a new project, component, or +subdirectory. +} +\examples{ +\dontrun{ +# Create an example file to upload to our example project +project <- osf_create_project("Flower Data") + +write.csv(iris, file = "iris.csv") +data_file <- osf_upload(project,"iris.csv") + +# Create a new directory to move our file to +data_dir <- osf_mkdir(project, "data") + +# Move the file to our data directory +data_file <- osf_mv(data_file, to = data_dir) + +# Move our data directory to a new component +data_comp <- osf_create_component(project, title = "data", category = "data") +data_file \%>\% + osf_mv(to = data_comp) \%>\% + osf_open() +} + +} diff --git a/man/osf_rm.Rd b/man/osf_rm.Rd index 5d83b287..aa70d7e0 100644 --- a/man/osf_rm.Rd +++ b/man/osf_rm.Rd @@ -2,14 +2,19 @@ % Please edit documentation in R/osf_rm.R \name{osf_rm} \alias{osf_rm} -\title{Delete projects or components from OSF} +\title{Delete an entity from OSF} \usage{ osf_rm(x, recursive = FALSE, verbose = FALSE, check = TRUE) } \arguments{ -\item{x}{an \code{\link{osf_tbl_node}}} +\item{x}{One of the following: +\itemize{ +\item An \code{\link{osf_tbl_node}} with a single OSF project or component. +\item An \code{\link{osf_tbl_file}} containing a single directory or file. +}} -\item{recursive}{Remove all sub-components before deleting the top-level entity.} +\item{recursive}{Remove all sub-components before deleting the top-level +entity. This only applies when deleting projects or components.} \item{verbose}{Logical, indicating whether to print informative messages about interactions with the OSF API (default \code{FALSE}).} @@ -21,14 +26,15 @@ requesting verification---this effectively removes your safety net.} Invisibly returns \code{TRUE} if deletion was successful. } \description{ -Use \code{osf_rm()} to \emph{permanently} delete a project or component from OSF, -including any uploaded files, wiki content, or comments contained therein. -Because this process is irreversible, osfr will first open the item in your -web browser so you can verify the item before proceeding. +Use \code{osf_rm()} to \strong{permanently} delete a project, component, file or +directory from OSF, including any uploaded files, wiki content, or comments +contained therein. Because this process is \strong{irreversible}, osfr will first +open the item in your web browser so you can verify what is about to be +deleted before proceeding. -If the project or component contains sub-components, those must be deleted -first. Setting \code{recursive = TRUE} will attempt to remove the hierarchy -of sub-components before deleting the top-level entity. +If the project or component targeted for deletion contains sub-components, +those must be deleted first. Setting \code{recursive = TRUE} will attempt to +remove the hierarchy of sub-components before deleting the top-level entity. \emph{Note: This functionality is limited to contributors with admin-level permissions.} diff --git a/pkgdown/_pkgdown.yml b/pkgdown/_pkgdown.yml index 65b96e46..e9bd7ccf 100644 --- a/pkgdown/_pkgdown.yml +++ b/pkgdown/_pkgdown.yml @@ -30,6 +30,7 @@ reference: contents: - '`osf_create`' - '`osf_mkdir`' + - '`osf_mv`' - '`osf_rm`' - '`osf_upload`' diff --git a/tests/testthat/helpers.R b/tests/testthat/helpers.R new file mode 100644 index 00000000..6c24fd34 --- /dev/null +++ b/tests/testthat/helpers.R @@ -0,0 +1,24 @@ +# for tests that must be executed on test.osf.io +on_test_server <- function() { + Sys.getenv("OSF_SERVER") == "test" +} + +skip_on_production_server <- function() { + testthat::skip_if_not( + on_test_server(), + "OSF_SERVER not set to 'test'." + ) +} + + +# for tests that require authenticated access +has_pat <- function() { + nzchar(Sys.getenv("OSF_PAT")) +} + +skip_if_no_pat <- function() { + testthat::skip_if_not( + has_pat(), + "No PAT detected." + ) +} diff --git a/tests/testthat/test-authentication.R b/tests/testthat/test-authentication.R index e14af77e..56df18a9 100644 --- a/tests/testthat/test-authentication.R +++ b/tests/testthat/test-authentication.R @@ -1,9 +1,29 @@ context("Authentication") + +# setup ------------------------------------------------------------------- + # Record developer PAT for OSF test server and unset variable for tests -test_pat <- Sys.getenv("OSF_PAT") -Sys.unsetenv("OSF_PAT") +setup({ + if (has_pat()) { + test_pat <<- Sys.getenv("OSF_PAT") + Sys.unsetenv("OSF_PAT") + } +}) + +# Restore variables +teardown({ + Sys.unsetenv("OSF_PAT") + options(osfr.pat = NULL) + + if (exists("test_pat")) { + Sys.setenv(OSF_PAT = test_pat) + suppressMessages(osf_auth()) + } +}) + +# tests ------------------------------------------------------------------- test_that("osf_auth() warns no PAT is found", { expect_warning(osf_auth(), "No PAT found") expect_null(getOption("osfr.pat")) @@ -13,21 +33,20 @@ test_that("osf_auth() defines osfr.pat from token arg", { options(osfr.pat = NULL) expect_message( - osf_auth(test_pat), + osf_auth("fake_token"), "Registered PAT from the provided token" ) - expect_equal(test_pat, getOption("osfr.pat")) + expect_equal("fake_token", getOption("osfr.pat")) }) -# Restore variables -Sys.setenv(OSF_PAT = test_pat) test_that("osf_auth() defines osfr.pat from OSF_PAT", { + Sys.setenv(OSF_PAT = "fake_token") options(osfr.pat = NULL) expect_message( osf_auth(), "Registered PAT from the OSF_PAT environment variable" ) - expect_equal(test_pat, getOption("osfr.pat")) + expect_equal("fake_token", getOption("osfr.pat")) }) diff --git a/tests/testthat/test-directories.R b/tests/testthat/test-directories.R index 159f7e7b..a9d051b3 100644 --- a/tests/testthat/test-directories.R +++ b/tests/testthat/test-directories.R @@ -2,28 +2,44 @@ context("Directories") # setup ------------------------------------------------------------------- -p1 <- osf_create_project(title = "osfr-component-tests") +setup({ + if (has_pat()) { + p1 <<- osf_create_project(title = "osfr-test-directories") + } +}) +teardown({ + if (has_pat()) { + osf_rm(p1, recursive = TRUE, check = FALSE) + } +}) -# tests ------------------------------------------------------------------- +# tests ------------------------------------------------------------------- test_that("empty project/folder returns a osf_tbl_file with 0 rows", { + skip_if_no_pat() + out <- osf_ls_files(p1) expect_s3_class(out, "osf_tbl_file") expect_equal(nrow(out), 0) }) test_that("listing a non-existent folder errors", { - expect_error(osf_ls_files(p1, path = "data"), "Can't find path") + skip_if_no_pat() + expect_error(osf_ls_files(p1, path = "data"), "Can't find directory") }) test_that("create a top-level directory", { + skip_if_no_pat() + d1 <- osf_mkdir(p1, path = "dir1") expect_s3_class(d1, "osf_tbl_file") expect_equal(d1$name, "dir1") }) test_that("list a top-level directory", { + skip_if_no_pat() + out <- osf_ls_files(p1) expect_s3_class(out, "osf_tbl_file") expect_equal(nrow(out), 1) @@ -32,12 +48,16 @@ test_that("list a top-level directory", { test_that("create a subdirectory within an existing directory", { + skip_if_no_pat() + d11 <- osf_mkdir(p1, path = "dir1/dir11") expect_s3_class(d11, "osf_tbl_file") expect_equal(d11$name, "dir11") }) test_that("list a subdirectory", { + skip_if_no_pat() + out <- osf_ls_files(p1) expect_equal(nrow(out), 1) expect_equal(out$name, "dir1") @@ -48,6 +68,8 @@ test_that("list a subdirectory", { }) test_that("create a subdirectory within a non-existent parent directory", { + skip_if_no_pat() + d21 <- osf_mkdir(p1, path = "dir2/dir21") expect_s3_class(d21, "osf_tbl_file") expect_equal(d21$name, "dir21") @@ -55,7 +77,3 @@ test_that("create a subdirectory within a non-existent parent directory", { d2_attrs <- d21$meta[[1]]$attributes expect_equal(d2_attrs$materialized_path, "/dir2/dir21/") }) - - -# cleanup ----------------------------------------------------------------- -osf_rm(p1, recursive = TRUE, check = FALSE) diff --git a/tests/testthat/test-files.R b/tests/testthat/test-files.R index ba5fe0b2..a45c94b7 100644 --- a/tests/testthat/test-files.R +++ b/tests/testthat/test-files.R @@ -1,10 +1,26 @@ context("Uploading") + # setup ------------------------------------------------------------------- -txt.file <- file.path(tempdir(), "osfr-test-file.txt") -writeLines("Lorem ipsum dolor sit amet, consectetur", txt.file) +infile <- tempfile("osfr-local-file-", fileext = ".txt") +outfile <- basename(infile) + +setup({ + writeLines("Lorem ipsum dolor sit amet, consectetur", infile) + if (has_pat()) { + p1 <<- osf_create_project(title = "osfr-test-files-1") + p2 <<- osf_create_project(title = "osfr-test-files-2") + } +}) -p1 <- osf_create_project("File Tests") +teardown({ + unlink(outfile) + + if (has_pat()) { + osf_rm(p1, recursive = TRUE, check = FALSE) + osf_rm(p2, recursive = TRUE, check = FALSE) + } +}) # tests ------------------------------------------------------------------- @@ -12,54 +28,67 @@ test_that("non-existent file is detected", { expect_error(osf_upload(p1, "non-existent-file"), "Can't find file") }) -f1 <- osf_upload(p1, txt.file) - test_that("file is uploaded to project root", { + skip_if_no_pat() + + f1 <<- osf_upload(p1, infile) expect_s3_class(f1, "osf_tbl_file") - expect_match(f1$name, basename(txt.file)) + expect_match(f1$name, outfile) }) test_that("uploaded file can be retrieved", { + skip_if_no_pat() + f2 <- osf_retrieve_file(as_id(f1)) expect_identical(f1, f2) }) test_that("upload fails if the file already exists", { - expect_error(osf_upload(p1, txt.file), "File already exists at destination") + skip_if_no_pat() + expect_error(osf_upload(p1, infile), "File already exists at destination") }) -writeLines("Lorem ipsum dolor sit amet, consectetur, ea duo posse", txt.file) test_that("upload can overwrite existing files", { - f1 <- osf_upload(p1, txt.file, overwrite = TRUE) + skip_if_no_pat() + + writeLines("Lorem ipsum dolor sit amet, consectetur, ea duo posse", infile) + skip_if_no_pat() + + f1 <- osf_upload(p1, infile, overwrite = TRUE) expect_equal(f1$meta[[1]]$attributes$current_version, 2) expect_s3_class(f1, "osf_tbl_file") }) test_that("user is warned that path info is removed from upload name", { + skip_if_no_pat() + expect_warning( - osf_upload(p1, txt.file, name = "path/file.txt"), + osf_upload(p1, infile, name = "path/file.txt"), "Removing path information" ) }) -d1 <- osf_mkdir(p1, "data") -f2 <- osf_upload(d1, txt.file) test_that("file can be uploaded to a directory", { + skip_if_no_pat() + + d1 <<- osf_mkdir(p1, "data") + f2 <<- osf_upload(d1, infile) expect_s3_class(f2, "osf_tbl_file") }) test_that("attempting to list an osf_tbl_file with a file errors", { + skip_if_no_pat() expect_error(osf_ls_files(f1), "Listing an `osf_tbl_file` requires a dir") }) context("Downloading") +test_that("a file can be downloaded from a project", { -outfile <- tempfile(fileext = ".txt") + skip_if_no_pat() -test_that("a file can be downloaded from a project", { out <- osf_download(f1, path = outfile) expect_s3_class(out, "osf_tbl_file") expect_identical(out$local_path, outfile) @@ -67,17 +96,29 @@ test_that("a file can be downloaded from a project", { }) test_that("an existing file won't be overwritten", { - expect_error(osf_download(f1, path = outfile), "A file exists at the specified") - expect_s3_class(osf_download(f1, path = outfile, overwrite = TRUE), "osf_tbl_file") + skip_if_no_pat() + + expect_error( + osf_download(f1, path = outfile), + "A file exists at the specified" + ) + expect_s3_class( + osf_download(f1, path = outfile, overwrite = TRUE), + "osf_tbl_file" + ) }) test_that("a non-existant path throws an error", { + skip_if_no_pat() + expect_error( osf_download(f1, path = "ddd/test.txt"), "The directory specified in `path` does not exist.") }) test_that("a file can be downloaded from a directory", { + skip_if_no_pat() + outfile <- tempfile(fileext = ".txt") out <- osf_download(f2, path = outfile) expect_s3_class(out, "osf_tbl_file") @@ -86,17 +127,101 @@ test_that("a file can be downloaded from a directory", { }) test_that("a directory can be downloaded as a zip file", { + skip_if_no_pat() + + d1_files <- osf_ls_files(d1, n_max = Inf) outfile <- tempfile(fileext = ".zip") + out <- osf_download(d1, path = outfile) expect_s3_class(out, "osf_tbl_file") expect_true(file.exists(outfile)) + expect_equal( + sort(unzip(outfile, list = TRUE)$Name), + sort(d1_files$name) + ) +}) + + +context("Moving/copying files") + +test_that("moving to a destination with an existing file throws an error", { + expect_error(osf_mv(f1, d1), "Cannot complete action: file or folder") +}) + +test_that("moving can overwrite an existing file", { + skip_if_no_pat() + + f1 <- osf_mv(f1, d1, overwrite = TRUE) + expect_s3_class(f1, "osf_tbl_file") + expect_match( - unzip(outfile, list = TRUE)$Name[1], - basename(txt.file) + get_meta(f1, "attributes", "materialized_path"), + file.path(d1$name, f1$name) ) }) +test_that("moving destination can be the parent node", { + skip_if_no_pat() -# cleanup ----------------------------------------------------------------- -osf_rm(p1, recursive = TRUE, check = FALSE) + f1 <- osf_mv(f1, p1) + expect_s3_class(f1, "osf_tbl_file") + + expect_match( + get_meta(f1, "attributes", "materialized_path"), + paste0("/", f1$name) + ) +}) + +test_that("moving destination can be a different node", { + skip_if_no_pat() + + f1 <- osf_mv(f1, p2) + expect_match(get_parent_id(f1), as_id(p2)) +}) + +test_that("directories can be moved to a sibling directory", { + d2 <- osf_mkdir(p1, "d2") + d1 <- osf_mv(d1, d2) + expect_s3_class(f1, "osf_tbl_file") + + expect_match( + paste0("/", file.path(d2$name, d1$name), "/"), + get_meta(d1, "attributes", "materialized_path") + ) +}) + +test_that("moving a parent directory to a child directory errors", { + skip_if_no_pat() + + parent <- osf_mkdir(p1, "parent") + child <- osf_mkdir(p1, "parent/child") + expect_error( + osf_mv(parent, child), + "Can't move a parent directory into its child" + ) +}) + + +context("Deleting files") + +test_that("a single file can be deleted", { + skip_if_no_pat() + + f1 <- osf_refresh(f1) + expect_true(osf_rm(f1, check = FALSE)) +}) + +test_that("an empty directory can be deleted", { + skip_if_no_pat() + + d2 <- osf_mkdir(p1, "d2") + expect_true(osf_rm(d2, check = FALSE)) +}) + +test_that("a non-empty directory can be deleted", { + skip_if_no_pat() + + d3 <- osf_mkdir(p1, "d1/d2/d3") + expect_true(osf_rm(d3, check = FALSE)) +}) diff --git a/tests/testthat/test-identifiers.R b/tests/testthat/test-identifiers.R index b90b656e..a2c34a13 100644 --- a/tests/testthat/test-identifiers.R +++ b/tests/testthat/test-identifiers.R @@ -22,5 +22,6 @@ test_that("GUIDs and Waterbutler IDs are detected in OSF URLs", { }) test_that("special identifier 'me' is recognized", { + skip_if_no_pat() expect_match(id_type("me"), "users") }) diff --git a/tests/testthat/test-nodes.R b/tests/testthat/test-nodes.R index 7163668c..5c3e6b16 100644 --- a/tests/testthat/test-nodes.R +++ b/tests/testthat/test-nodes.R @@ -1,17 +1,30 @@ context("Node creation") -p1 <- osf_create_project(title = "osfr-project-tests") +# setup ------------------------------------------------------------------- +setup({ + if (has_pat()) { + p1 <<- osf_create_project(title = "osfr-test-nodes") + } +}) + +# teardown happens within node deletion tests + + +# tests ------------------------------------------------------------------- test_that("minimal project with default settings was created", { + skip_if_no_pat() + expect_s3_class(p1, "osf_tbl_node") expect_false(get_meta(p1, "attributes", "public")) - expect_match(p1$name, "osfr-project-tests") + expect_match(p1$name, "osfr-test-nodes") expect_null(get_parent_id(p1)) }) -c1 <- osf_create_component(p1, title = "component-1") - test_that("minimal component with default settings was created", { + skip_if_no_pat() + + c1 <<- osf_create_component(p1, title = "component-1") expect_s3_class(c1, "osf_tbl_node") expect_false(get_meta(c1, "attributes", "public")) expect_match(c1$name, "component-1") @@ -19,15 +32,20 @@ test_that("minimal component with default settings was created", { }) test_that("node creation errors without a title", { + skip_if_no_pat() + expect_error(osf_create_project(), "Must define a title") expect_error(osf_create_component(p1), "Must define a title") }) test_that("component creation errors with providing a parent node", { + skip_if_no_pat() expect_error(osf_create_component(), "`x` must be an `osf_tbl_node`") }) test_that("nested nodes can be created", { + skip_if_no_pat() + c11 <- osf_create_component(c1, title = "component-1-1") expect_s3_class(c11, "osf_tbl_node") expect_match(get_parent_id(c11), c1$id) @@ -37,37 +55,48 @@ test_that("nested nodes can be created", { expect_match(get_parent_id(c12), c1$id) }) + context("Node categories") test_that("default project category is 'project'", { + skip_if_no_pat() expect_match(get_meta(p1, "attributes", "category"), "project") }) test_that("default component category is empty (i.e., uncategorized)", { + skip_if_no_pat() expect_match(get_meta(c1, "attributes", "category"), "") }) test_that("an invalid or ambiguous category errors", { + skip_if_no_pat() + expect_error(osf_create_project("Bad category", category = "pr")) expect_error(osf_create_component(p1, "Bad category", category = "pr")) }) -p2 <- osf_create_project("osfr-project-category-test", category = "Analysis") -c2 <- osf_create_component(p2, "osfr-component-category-test", category = "Data") - test_that("a valid category can be specified", { + skip_if_no_pat() + + p2 <<- osf_create_project("osfr-project-category-test", category = "Analysis") + c2 <- osf_create_component(p2, "osfr-component-category-test", category = "Data") expect_match(get_meta(p2, "attributes", "category"), "analysis") expect_match(get_meta(c2, "attributes", "category"), "data") }) + context("Node deletion") test_that("deleting non-empty project/component fails", { + skip_if_no_pat() + expect_error(osf_rm(p1, check = FALSE), "Any child components must be deleted") expect_error(osf_rm(c1, check = FALSE), "Any child components must be deleted") }) test_that("non-empty project can be recursively deleted", { + skip_if_no_pat() + out <- osf_rm(p1, recursive = TRUE, check = FALSE) expect_true(out) out <- osf_rm(p2, recursive = TRUE, check = FALSE) diff --git a/tests/testthat/test-osf_ls.R b/tests/testthat/test-osf_ls.R index 7142bede..7bcca1cf 100644 --- a/tests/testthat/test-osf_ls.R +++ b/tests/testthat/test-osf_ls.R @@ -1,30 +1,45 @@ context("Listing nodes") -# Retrieve public OSF project and components required for tests -# (created using data-raw/create-test-project.R) -test_proj <- osf_retrieve_node("brfza") -test_comp <- osf_retrieve_node("rxwhk") +# setup ------------------------------------------------------------------- +setup({ + # Retrieve public OSF project and components required for tests + # (created using data-raw/create-test-project.R) + if (on_test_server()) { + p1 <<- osf_retrieve_node("brfza") + c1 <<- osf_retrieve_node("rxwhk") + d1 <<- osf_retrieve_file("5c34b68a44cd030016942349") + } +}) + + +# tests ------------------------------------------------------------------- test_that("`n_max` controls number of returned nodes", { - out <- osf_ls_nodes(test_comp, n_max = 10) + skip_on_production_server() + + out <- osf_ls_nodes(c1, n_max = 10) expect_s3_class(out, "osf_tbl_node") expect_equal(nrow(out), 10) - out <- osf_ls_nodes(test_comp, n_max = 20) + out <- osf_ls_nodes(c1, n_max = 20) expect_equal(nrow(out), 20) }) test_that("`pattern` filters nodes by name", { - out <- osf_ls_nodes(test_comp, pattern = "component-01") + skip_on_production_server() + + out <- osf_ls_nodes(c1, pattern = "component-01") expect_equal(nrow(out), 1) - out <- osf_ls_nodes(test_comp, pattern = "component-0") + out <- osf_ls_nodes(c1, pattern = "component-0") expect_equal(nrow(out), 9) }) test_that("messages are printed with `verbose` enabled", { + skip_on_production_server() + expect_message( - osf_ls_nodes(test_comp, n_max = 20, verbose = TRUE), + osf_ls_nodes(c1, n_max = 20, verbose = TRUE), "Retrieving \\d{2} of \\d{2} available items" ) }) @@ -33,7 +48,9 @@ test_that("messages are printed with `verbose` enabled", { context("Listing files and directories") test_that("both files and directories are listed", { - out <- osf_ls_files(test_proj) + skip_on_production_server() + + out <- osf_ls_files(p1) expect_s3_class(out, "osf_tbl_file") expect_equal(nrow(out), 2) expect_identical( @@ -43,39 +60,46 @@ test_that("both files and directories are listed", { }) test_that("`type` can filters for files", { - out <- osf_ls_files(test_proj, type = "file") + skip_on_production_server() + + out <- osf_ls_files(p1, type = "file") expect_equal(nrow(out), 1) expect_match(get_meta(out, "attributes", "kind"), "file") }) test_that("`type` can filters for files", { - out <- osf_ls_files(test_proj, type = "folder") + skip_on_production_server() + + out <- osf_ls_files(p1, type = "folder") expect_equal(nrow(out), 1) expect_match(get_meta(out, "attributes", "kind"), "folder") }) - -test_dir <- osf_ls_files(test_proj, type = "folder") - test_that("n_max controls number of returned files", { - out <- osf_ls_files(test_dir, n_max = 10) + skip_on_production_server() + + out <- osf_ls_files(d1, n_max = 10) expect_equal(nrow(out), 10) - out <- osf_ls_files(test_dir, n_max = 20) + out <- osf_ls_files(d1, n_max = 20) expect_equal(nrow(out), 20) }) test_that("`pattern` filters files by name", { - out <- osf_ls_files(test_dir, pattern = ".txt", n_max = 10) + skip_on_production_server() + + out <- osf_ls_files(d1, pattern = ".txt", n_max = 10) expect_match(out$name, "\\.txt$") - out <- osf_ls_files(test_dir, pattern = ".png", n_max = 10) + out <- osf_ls_files(d1, pattern = ".png", n_max = 10) expect_match(out$name, "\\.png$") }) test_that("messages are printed with `verbose` enabled", { + skip_on_production_server() + expect_message( - osf_ls_files(test_dir, n_max = 20, verbose = TRUE), + osf_ls_files(d1, n_max = 20, verbose = TRUE), "Retrieving \\d{2} of \\d{2} available items" ) }) diff --git a/tests/testthat/test-osf_tbl.R b/tests/testthat/test-osf_tbl.R index badb8842..47c9c78e 100644 --- a/tests/testthat/test-osf_tbl.R +++ b/tests/testthat/test-osf_tbl.R @@ -15,14 +15,17 @@ test_that("empty list returns empty osf_tbl", { context("osf_tbl validation") -user_tbl <- osf_retrieve_user("me") -user_tbl$foo <- "bar" - test_that("valid osf_tbls are passed through validation", { + skip_on_production_server() + + user_tbl <<- osf_retrieve_user("dguxh") + user_tbl$foo <<- "bar" expect_s3_class(rebuild_osf_tbl(user_tbl), "osf_tbl_user") }) test_that("osf_tbls missing required columns are detected", { + skip_on_production_server() + expect_true(has_osf_tbl_colnames(user_tbl)) expect_false(has_osf_tbl_colnames(user_tbl[-1])) expect_false(has_osf_tbl_colnames(user_tbl[-2])) @@ -30,14 +33,17 @@ test_that("osf_tbls missing required columns are detected", { }) test_that("osf_tbls with incorrect column types are detected", { + skip_on_production_server() + user_tbl$id <- as.factor(user_tbl$id) expect_false(has_osf_tbl_coltypes(user_tbl)) }) -proj_tbl <- osf_retrieve_node("brfza") - test_that("can't combine osf_tbls with different subclasses", { - proj_tbl$foo <- "barr" + skip_on_production_server() + + proj_tbl <- osf_retrieve_node("brfza") + proj_tbl$foo <- "bar" out <- rbind(user_tbl, proj_tbl) expect_identical(class(out), c("tbl_df", "tbl", "data.frame")) })