Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
58 changes: 19 additions & 39 deletions R/constants.R
Original file line number Diff line number Diff line change
Expand Up @@ -5,39 +5,19 @@



# 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
# use sub(REGEX_CHECKBOX_FIELD_NAME, "\\1", x, perl = TRUE) to get the field name base
# 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)
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions R/deleteFileRepository.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 ------------------------------------------------
Expand All @@ -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 ------------------------------------------------
Expand Down
2 changes: 1 addition & 1 deletion R/exportFileRepository.R
Original file line number Diff line number Diff line change
Expand Up @@ -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 --------------------------------------
Expand Down
124 changes: 62 additions & 62 deletions R/exportFileRepositoryListing.R
Original file line number Diff line number Diff line change
@@ -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
Expand All @@ -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())
}
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
}
23 changes: 23 additions & 0 deletions R/redcapDataStructure.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Loading