Bumping test column number for exportFileRepositoryListing #505

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
 

R/constants.R

@@ -8,19 +8,21 @@
 # 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), 
+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(rcon$version(), "16.0.8") < 0) NULL else character(0),
+             dag = if(is.null(version) || utils::compareVersion(rcon$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 <- 
-  data.frame(directory = character(0), 
-             filename = character(0), 
+FILE_IMPORT_EXPORT_EMPTY_FRAME <-
+  data.frame(directory = character(0),
+             filename = character(0),
              stringsAsFactors = FALSE)
 
 
@@ -32,12 +34,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 +76,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

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 ------------------------------------------------

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,121 +34,121 @@
 #' [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")
 }
 
 #' @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()) # defined in constants.R
   }
   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
 }

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)
   }
 )

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)
   }
 )