diff --git a/NEWS.md b/NEWS.md index 6782a009..0f8dba86 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,7 @@ * `exportUsers` properly handles the columns random_setup, random_dashboard and random_perform. * `importUsers` and `exportUsers` weren't handling data_access_group assignment properly. * `exportUserRoles` now avoids errors when user role access columns are missing from export responses. +* `exportFileRepositoryListing` returns a data.frame with 6 columns (was 4) from REDCap version 16.0.8 and up. ## DEPRECATION NOTICES diff --git a/R/constants.R b/R/constants.R index a4ddca9a..fbbb9804 100644 --- a/R/constants.R +++ b/R/constants.R @@ -5,26 +5,6 @@ -# This is used for File Repository methods. Some calls result in a -# result of an empty string or an error. At times we prefer to return -# the empty frame to maintain consistency in outputs with recursive calls -FILE_REPOSITORY_EMPTY_FRAME <- - data.frame(folder_id = numeric(0), - doc_id = numeric(0), - name = character(0), - parent_folder = numeric(0), - stringsAsFactors = FALSE) - -# This is used for cases when an import/export/delete to the file repository -# results in no changes and an empty frame is needed for the return - -FILE_IMPORT_EXPORT_EMPTY_FRAME <- - data.frame(directory = character(0), - filename = character(0), - stringsAsFactors = FALSE) - - - # Regular Expressions ----------------------------------------------- # REGEX_CHECKBOX_FIELD_NAME - Matches the checkbox style field name @@ -32,12 +12,12 @@ FILE_IMPORT_EXPORT_EMPTY_FRAME <- # use sub(REGEX_CHECKBOX_FIELD_NAME, "\\2", x, perl = TRUE) to get the option # Using regex to parse checkbox names has some limitations and at some point # we may need to consider another strategy. REDCap permits any characters to -# be used in coding checkboxes, but when converting them to field names, -# converts non alphnumeric characters to an underscore. +# be used in coding checkboxes, but when converting them to field names, +# converts non alphnumeric characters to an underscore. # some examples -4, Option ----> checkbox____4 # k>=9, K >=9 ----> checkbox___k__9 # a___b ----> checkbox___a___b -# +# # Explanation : https://stackoverflow.com/a/76020417/1017276 # ^(.*?)___ : match anything at beginning non-greedily followed by ___ into 1st group # ___ : after that, find the first case of ___ (the REDCap UI will not permit the user to use more than one consecutive _ in field names) @@ -74,51 +54,51 @@ REGEX_FORM_NAME <- "(^[a-z]$|^[a-z][a-z,0-9]$|^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0 # REGEX_MULT_CHOICE_STRICT - matches acceptable formats for multiple choice options # It's a good idea to trim whitespace before using this -# This 'STRICT' regex requires that definitions follow the pattern of -# [code1], [label1] | [code2], [label2]. It turns out that there are ways -# that users can define multiple choice fields using only the labels -# (via the metadata CSV import and the API will actually allow it, too). +# This 'STRICT' regex requires that definitions follow the pattern of +# [code1], [label1] | [code2], [label2]. It turns out that there are ways +# that users can define multiple choice fields using only the labels +# (via the metadata CSV import and the API will actually allow it, too). # We have decided that we do not want to permit this through importMetaData # so a separate regex is needed for the import than we use for the export. # See issue 145. # Explanation - this one makes my head swim a bit, but I'll do my best. (BN) # ^ : Start of string -# [^\\|]+ : Any number of character, but the sequence may not +# [^\\|]+ : Any number of character, but the sequence may not # start with a pipe (this is the first code) # , : literal comma -# [^\\|]* : any number of characters, but the sequence may not +# [^\\|]* : any number of characters, but the sequence may not # start with a pipe (this is the first label) -# it is a lazy match, meaning it will stop the first +# it is a lazy match, meaning it will stop the first # time it hits a pipe # (?:\\|[^\\|]+,[^\\|]*)* : this is the workhorse, it's looking for a repeating pattern -# : of pipe, characters, comma, character, pipe with +# : of pipe, characters, comma, character, pipe with # : a terminating sequence of pipe, characters, comma, characters. # : That is, the last in the sequence does not end with a pipe # $ : end of string REGEX_MULT_CHOICE_STRICT <- "^[^\\|]+,[^\\|]*(?:\\|[^\\|]+,[^\\|]*)*$" -# REGEX_MULT_CHOICE - matches acceptable formats for multiple choice options, -# to include formats that use only the label. See Issue 145. -# It's a good idea to trim whitespace before using this. +# REGEX_MULT_CHOICE - matches acceptable formats for multiple choice options, +# to include formats that use only the label. See Issue 145. +# It's a good idea to trim whitespace before using this. # Explanation - uses the same pattern as REGEX_MULT_CHOICE_STRICT and also includes the following # for matching shorthand multiple choice fields. # ^ : Start of string # (?:[^|,]+\|)+ : Look for a repeating pattern of character, pipe, character, where -# the last in the sequence does not end with a pipe and characters +# the last in the sequence does not end with a pipe and characters # do not include commas -# [^|,]+ : any number of characters, but the sequence may not +# [^|,]+ : any number of characters, but the sequence may not # include a pipe or comma # $ : end of string REGEX_MULT_CHOICE <- "^(^[^\\|]+,[^\\|]*(?:\\|[^\\|]+,[^\\|]*)*$|^(?:[^|,]+\\|)+[^|,]+$)$" - + # REGEX_SLIDER - matches acceptable definition of slider bar settings # Specifically, low point | midpoint | high point -# Any of the three values may be missing, but the two pipes must be +# Any of the three values may be missing, but the two pipes must be # present. # This is fairly permissive, but it seems to match REDCap behaviors -# REDCap does not actually restrict what characters can go between the pipes, +# REDCap does not actually restrict what characters can go between the pipes, # although it produces weird results when you include a pipe within the labels. # Example: this | and|or | that will produce labels "this", "and", and "or | that" in the UI. # Explanation diff --git a/R/deleteFileRepository.R b/R/deleteFileRepository.R index 8f670920..27153712 100644 --- a/R/deleteFileRepository.R +++ b/R/deleteFileRepository.R @@ -55,7 +55,7 @@ deleteFileRepository.redcapApiConnection <- function( if (files_to_delete == 0){ logMessage("No files to delete in the requested folder(s)") - return(FILE_REPOSITORY_EMPTY_FRAME) + return(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) } # Get confirmation ------------------------------------------------ @@ -71,7 +71,7 @@ deleteFileRepository.redcapApiConnection <- function( if (confirm == "no"){ logMessage("Delete action cancelled by user.") - return(FILE_REPOSITORY_EMPTY_FRAME) + return(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) } # Delete the files ------------------------------------------------ diff --git a/R/exportFileRepository.R b/R/exportFileRepository.R index 976a9ccc..7d550d01 100644 --- a/R/exportFileRepository.R +++ b/R/exportFileRepository.R @@ -70,7 +70,7 @@ exportFileRepository.redcapApiConnection <- function(rcon, if (nrow(FileRepo) == 0){ logMessage("No files or folders to download") - return(FILE_IMPORT_EXPORT_EMPTY_FRAME) + return(FILE_IMPORT_EXPORT_EMPTY_FRAME(rcon$version())) } # Export the File Repository -------------------------------------- diff --git a/R/exportFileRepositoryListing.R b/R/exportFileRepositoryListing.R index ce5eb997..0935c5bb 100644 --- a/R/exportFileRepositoryListing.R +++ b/R/exportFileRepositoryListing.R @@ -1,31 +1,31 @@ #' @name exportFileRepositoryListing -#' @title Export a Listing of Folders and Files in the File Repository -#' +#' @title Export a Listing of Folders and Files in the File Repository +#' #' @description This method enables the user to export a list of folders -#' and files saved to the File Repository. The listing may optionally +#' and files saved to the File Repository. The listing may optionally #' include contents of subfolders. -#' +#' #' @inheritParams common-rcon-arg #' @inheritParams common-dot-args -#' @inheritParams common-api-args -#' @param folder_id `integerish(0/1)`. The -#' folder ID of a specific folder in the File Repository for which a list of -#' files and subfolders will be exported. +#' @inheritParams common-api-args +#' @param folder_id `integerish(0/1)`. The +#' folder ID of a specific folder in the File Repository for which a list of +#' files and subfolders will be exported. #' By default, the top-level directory of the File Repository will be used. #' @param recursive `logical(1)`. When `TRUE`, content of subfolders -#' will be retrieved until a full listing is produced. If `FALSE`, +#' will be retrieved until a full listing is produced. If `FALSE`, #' only the contents of the requested folder will be returned. -#' -#' @return +#' +#' @return #' Returns a data frame with the columns -#' +#' #' | | | #' |-----------------|------------------------------------------------------| #' | `folder_id` | The REDCap assigned ID value for the folder. Will be `NA` if the item is a file. | #' | `doc_id` | The REDCap assigned ID value for the file. Will be `NA` if the item is a folder. | #' | `name` | The name of the folder of file. | #' | `parent_folder` | The ID of the parent folder of the item. The top-level folder is represented as 0. | -#' +#' #' @seealso #' [exportFromFileRepository()], \cr #' [importToFileRepository()], \cr @@ -34,31 +34,31 @@ #' [importFileRepository()], \cr #' [deleteFileRepository()], \cr #' [createFileRepositoryFolder()] -#' +#' #' @examples #' \dontrun{ -#' unlockREDCap(connections = c(rcon = "project_alias"), -#' url = "your_redcap_url", -#' keyring = "API_KEYs", +#' unlockREDCap(connections = c(rcon = "project_alias"), +#' url = "your_redcap_url", +#' keyring = "API_KEYs", #' envir = globalenv()) -#' +#' #' # Export the top-level listing of the File Repository #' exportFileRepositoryListing(rcon) -#' +#' #' # Export the complete listing of the File Repository -#' exportFileRepositoryListing(rcon, +#' exportFileRepositoryListing(rcon, #' recursive = TRUE) -#' +#' #' # Export the listing of a subfolder in the File Repository -#' exportFileRepositoryListing(rcon, +#' exportFileRepositoryListing(rcon, #' folder_id = 12345) #' } -#' +#' #' @export -exportFileRepositoryListing <- function(rcon, - folder_id = numeric(0), - recursive = FALSE, +exportFileRepositoryListing <- function(rcon, + folder_id = numeric(0), + recursive = FALSE, ...){ UseMethod("exportFileRepositoryListing") } @@ -66,89 +66,89 @@ exportFileRepositoryListing <- function(rcon, #' @rdname exportFileRepositoryListing #' @export -exportFileRepositoryListing.redcapApiConnection <- function(rcon, - folder_id = numeric(0), - recursive = FALSE, +exportFileRepositoryListing.redcapApiConnection <- function(rcon, + folder_id = numeric(0), + recursive = FALSE, ...) { # Argument validation --------------------------------------------- - + coll <- checkmate::makeAssertCollection() - - checkmate::assert_class(x = rcon, - classes = "redcapApiConnection", + + checkmate::assert_class(x = rcon, + classes = "redcapApiConnection", add = coll) - - checkmate::assert_integerish(x = folder_id, - max.len = 1, + + checkmate::assert_integerish(x = folder_id, + max.len = 1, any.missing = FALSE, add = coll) - - checkmate::assert_logical(x = recursive, - len = 1, + + checkmate::assert_logical(x = recursive, + len = 1, add = coll) checkmate::reportAssertions(coll) - + # Make Body List -------------------------------------------------- - - body <- list(content = 'fileRepository', - action = 'list', - format = 'csv', - returnFormat = 'csv', + + body <- list(content = 'fileRepository', + action = 'list', + format = 'csv', + returnFormat = 'csv', folder_id = folder_id) # Call the API ---------------------------------------------------- response <- makeApiCall(rcon, body, success_status_codes = c(200L, 400L), ...) if(response$status_code == 400L) - return(FILE_REPOSITORY_EMPTY_FRAME) + return(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) # Convert result to a data frame ---------------------------------- - FileRepository <- .fileRepositoryFrame(response, + FileRepository <- .fileRepositoryFrame(response, folder_id) - + # Recursive Call -------------------------------------------------- - + if(recursive) { - FileRepository <- .fileRepositoryRecursive(FileRepository, + FileRepository <- .fileRepositoryRecursive(FileRepository, rcon = rcon) } - + FileRepository } # Unexported -------------------------------------------------------- -.fileRepositoryFrame <- function(response, +.fileRepositoryFrame <- function(response, folder_id){ # If folder_id has length 0, set the parent to top-level parent <- if (length(folder_id) == 0) 0 else folder_id - + if (length(response$content) > 0){ response <- as.data.frame(response) - response$parent_folder <- rep(parent, + response$parent_folder <- rep(parent, nrow(response)) } else { - response <- FILE_REPOSITORY_EMPTY_FRAME # defined in constants.R + response <- FILE_REPOSITORY_EMPTY_FRAME(rcon$version()) } response } .fileRepositoryRecursive <- function(FileRepository, rcon){ # Get folder IDs - fids <- FileRepository$folder_id + fids <- FileRepository$folder_id fids <- fids[!is.na(fids)] - + # Recursively call to the API for any non-missing folder_id if(length(fids) > 0) { - addl <- do.call(rbind, - lapply(fids, - FUN = exportFileRepositoryListing, - rcon = rcon, + addl <- do.call(rbind, + lapply(fids, + FUN = exportFileRepositoryListing, + rcon = rcon, recursive = TRUE)) FileRepository <- rbind(FileRepository, addl) } - + FileRepository } diff --git a/R/redcapDataStructure.R b/R/redcapDataStructure.R index 3be89824..76ea997b 100644 --- a/R/redcapDataStructure.R +++ b/R/redcapDataStructure.R @@ -479,3 +479,26 @@ redcapUserRoleAssignmentStructure <- function(version) data_access_group = if(is.null(version) || utils::compareVersion(version, "15.8.2") < 0) NULL else character(0), stringsAsFactors = FALSE) } + + +# This is used for File Repository methods. Some calls result in a +# result of an empty string or an error. At times we prefer to return +# the empty frame to maintain consistency in outputs with recursive calls +FILE_REPOSITORY_EMPTY_FRAME <- function(version) + data.frame(folder_id = numeric(0), + doc_id = numeric(0), + name = character(0), + role = if(is.null(version) || utils::compareVersion(version, "16.0.8") < 0) NULL else character(0), + dag = if(is.null(version) || utils::compareVersion(version, "16.0.8") < 0) NULL else character(0), + parent_folder = numeric(0), + stringsAsFactors = FALSE) + +# This is used for cases when an import/export/delete to the file repository +# results in no changes and an empty frame is needed for the return + +FILE_IMPORT_EXPORT_EMPTY_FRAME <- function(version) + data.frame(directory = character(0), + filename = character(0), + role = if(is.null(version) || utils::compareVersion(version, "16.0.8") < 0) NULL else character(0), + dag = if(is.null(version) || utils::compareVersion(version, "16.0.8") < 0) NULL else character(0), + stringsAsFactors = FALSE) diff --git a/tests/testthat/test-304-fileRepository-BulkFileMethods-Functionality.R b/tests/testthat/test-304-fileRepository-BulkFileMethods-Functionality.R index 9506a040..cdc5b3f8 100644 --- a/tests/testthat/test-304-fileRepository-BulkFileMethods-Functionality.R +++ b/tests/testthat/test-304-fileRepository-BulkFileMethods-Functionality.R @@ -64,9 +64,10 @@ test_that( confirm = "yes"), "No files to delete") + ncols <- ncol(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) expect_data_frame(Deleted, nrows = 0, - ncols = 4) + ncols = ncols) } ) @@ -118,8 +119,8 @@ test_that( folder_id = 0, recursive = TRUE, confirm = "yes") - + ncols <- ncol(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) expect_data_frame(Deleted, - ncols = 4) + ncols = ncols) } ) diff --git a/tests/testthat/test-305-exportFileRepositoryListing.R b/tests/testthat/test-305-exportFileRepositoryListing.R index dbdb71a5..320d80f1 100644 --- a/tests/testthat/test-305-exportFileRepositoryListing.R +++ b/tests/testthat/test-305-exportFileRepositoryListing.R @@ -83,10 +83,11 @@ test_that( test_that( "Returns a data frame", { + ncols <- ncol(FILE_REPOSITORY_EMPTY_FRAME(rcon$version())) expect_data_frame(exportFileRepositoryListing(rcon), - ncols = 4) + ncols = ncols) expect_data_frame(exportFileRepositoryListing(rcon, recursive = TRUE), - ncols = 4) + ncols = ncols) } )