Skip to content
Merged
Show file tree
Hide file tree
Changes from 6 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()) # defined in constants.R
Comment thread
couthcommander marked this conversation as resolved.
Outdated
}
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