From c6832bcda9d1ea330111efc679bf4b09de720b31 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 12 Jan 2024 12:42:39 -0600 Subject: [PATCH 001/155] Less surprise for raw_cast validation #310 --- R/fieldCastingFunctions.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index 7310b7cc..ada02f08 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -548,7 +548,11 @@ mChoiceCast <- function(data, correct_length = nrow(Raw)) ################################################################### - # Run Validation Functions #### + # Run Validation Functions + + # Minimize user surprise on raw_cast #310 + if(identical(cast, raw_cast) && identical(validation, .default_validate)) + validation <- na_values(function(x, ...) rep(TRUE, length(x))) validations <- .castRecords_runValidation(Raw = Raw, From ea76d50c2f357f270f0c4d2069c002e169f5d906 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 12 Jan 2024 20:24:38 -0600 Subject: [PATCH 002/155] Added example of cast_raw with validation skip #310 --- R/docsRecordsMethods.R | 5 +++++ man/recordsMethods.Rd | 5 +++++ 2 files changed, 10 insertions(+) diff --git a/R/docsRecordsMethods.R b/R/docsRecordsMethods.R index 480b0815..5ea413bd 100644 --- a/R/docsRecordsMethods.R +++ b/R/docsRecordsMethods.R @@ -145,6 +145,11 @@ #' # Export a report #' exportReports(rcon, #' report_id = 12345) +#' +#' # Export raw data +#' # Note: Unless custom validations are indicated, using raw_cast will skip validations. +#' exportRecordsTyped(rcon, +#' cast = raw_cast) #' #' } #' diff --git a/man/recordsMethods.Rd b/man/recordsMethods.Rd index 202e627b..62037d36 100644 --- a/man/recordsMethods.Rd +++ b/man/recordsMethods.Rd @@ -261,6 +261,11 @@ exportRecords(rcon, # Export a report exportReports(rcon, report_id = 12345) + +# Export raw data +# Note: Unless custom validations are indicated, using raw_cast will skip validations. +exportRecordsTyped(rcon, + cast = raw_cast) } From d505d539d9aae5ab79652981ed30738c057a62f4 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 12 Jan 2024 20:48:33 -0600 Subject: [PATCH 003/155] More documentation about automagic validation override for raw_cast #310 --- R/documentation-common-args.R | 4 +++- R/fieldValidationAndCasting.R | 3 ++- man/fieldCastingFunctions.Rd | 4 +++- man/fieldValidationAndCasting.Rd | 3 ++- man/recordsTypedMethods.Rd | 4 +++- 5 files changed, 13 insertions(+), 5 deletions(-) diff --git a/R/documentation-common-args.R b/R/documentation-common-args.R index 63b7f676..13d7677f 100644 --- a/R/documentation-common-args.R +++ b/R/documentation-common-args.R @@ -55,7 +55,9 @@ NULL #' @param cast A named `list` of user specified class casting functions. The #' same named keys are supported as the na argument. The function will be #' provided the variables (x, field_name, coding). The function must return a -#' vector of logical matching the input length. See [fieldValidationAndCasting()] +#' vector of logical matching the input length. If `raw_cast` is specified and +#' `validation` is left to default it will disable validation to pass all +#' values as raw. See [fieldValidationAndCasting()] #' @param assignment A named `list` of functions. These functions are provided, field_name, #' label, description and field_type and return a list of attributes to assign #' to the column. Defaults to creating a label attribute from the stripped diff --git a/R/fieldValidationAndCasting.R b/R/fieldValidationAndCasting.R index 7c249ef1..26565adf 100644 --- a/R/fieldValidationAndCasting.R +++ b/R/fieldValidationAndCasting.R @@ -132,7 +132,8 @@ #' #' ## Casting Lists #' `raw_cast` overrides all casting if passed as the `cast` -#' parameter. +#' parameter. If `validation` is left to default it will be disabled +#' to pass pure raw values with no validation. #' #' `default_cast_no_factor` is a list of casting functions that matches #' all of the default casts but with the exception that any fields that would diff --git a/man/fieldCastingFunctions.Rd b/man/fieldCastingFunctions.Rd index 9965a63c..31ad2a6e 100644 --- a/man/fieldCastingFunctions.Rd +++ b/man/fieldCastingFunctions.Rd @@ -58,7 +58,9 @@ multiple choice fields. Fields of class \code{mChoice} are quietly skipped.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. If \code{raw_cast} is specified and +\code{validation} is left to default it will disable validation to pass all +values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{suffix}{\code{character(1)}. An optional suffix to provide if the recoded variables should be returned as new columns. For example, diff --git a/man/fieldValidationAndCasting.Rd b/man/fieldValidationAndCasting.Rd index 111cb9d1..532579e1 100644 --- a/man/fieldValidationAndCasting.Rd +++ b/man/fieldValidationAndCasting.Rd @@ -263,7 +263,8 @@ the value is one of \code{c("1", "true", "yes")} and returns \code{FALSE} otherw \subsection{Casting Lists}{ \code{raw_cast} overrides all casting if passed as the \code{cast} -parameter. +parameter. If \code{validation} is left to default it will be disabled +to pass pure raw values with no validation. \code{default_cast_no_factor} is a list of casting functions that matches all of the default casts but with the exception that any fields that would diff --git a/man/recordsTypedMethods.Rd b/man/recordsTypedMethods.Rd index 8d35fb9a..5b05b3ac 100644 --- a/man/recordsTypedMethods.Rd +++ b/man/recordsTypedMethods.Rd @@ -135,7 +135,9 @@ are not identified as NA will be passed to validation functions.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. If \code{raw_cast} is specified and +\code{validation} is left to default it will disable validation to pass all +values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{assignment}{A named \code{list} of functions. These functions are provided, field_name, label, description and field_type and return a list of attributes to assign From 3361901e4a05de2e868853700562742565b0aa30 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Jan 2024 10:26:04 -0600 Subject: [PATCH 004/155] Rewrite on #310 to have skip_Validation --- NAMESPACE | 1 + R/docsRecordsMethods.R | 5 +++++ R/documentation-common-args.R | 4 +++- R/fieldCastingFunctions.R | 11 ++++++++--- R/fieldValidationAndCasting.R | 18 +++++++++++++++++- R/preserveProject.R | 3 ++- man/fieldCastingFunctions.Rd | 9 ++++++--- man/fieldValidationAndCasting.Rd | 11 ++++++++++- man/recordsMethods.Rd | 5 +++++ man/recordsTypedMethods.Rd | 4 +++- 10 files changed, 60 insertions(+), 11 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index e3fc912b..7661bd88 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -198,6 +198,7 @@ export(redcapProjectInfo) export(renameRecord) export(restoreProject) export(reviewInvalidRecords) +export(skip_validation) export(splitForms) export(stripHTMLTags) export(stripHTMLandUnicode) diff --git a/R/docsRecordsMethods.R b/R/docsRecordsMethods.R index 480b0815..5ea413bd 100644 --- a/R/docsRecordsMethods.R +++ b/R/docsRecordsMethods.R @@ -145,6 +145,11 @@ #' # Export a report #' exportReports(rcon, #' report_id = 12345) +#' +#' # Export raw data +#' # Note: Unless custom validations are indicated, using raw_cast will skip validations. +#' exportRecordsTyped(rcon, +#' cast = raw_cast) #' #' } #' diff --git a/R/documentation-common-args.R b/R/documentation-common-args.R index 63b7f676..13d7677f 100644 --- a/R/documentation-common-args.R +++ b/R/documentation-common-args.R @@ -55,7 +55,9 @@ NULL #' @param cast A named `list` of user specified class casting functions. The #' same named keys are supported as the na argument. The function will be #' provided the variables (x, field_name, coding). The function must return a -#' vector of logical matching the input length. See [fieldValidationAndCasting()] +#' vector of logical matching the input length. If `raw_cast` is specified and +#' `validation` is left to default it will disable validation to pass all +#' values as raw. See [fieldValidationAndCasting()] #' @param assignment A named `list` of functions. These functions are provided, field_name, #' label, description and field_type and return a list of attributes to assign #' to the column. Defaults to creating a label attribute from the stripped diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index 7310b7cc..61580a26 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -101,8 +101,9 @@ #' #' #' # Using guessCast -#' exportRecordsTyped(rcon, -#' cast = raw_cast) |> +#' exportRecordsTyped(rcon, +#' validation=skip_validation, +#' cast = raw_cast) |> #' guessCast(rcon, #' validation=valRx("^[0-9]{1,4}-(0?[1-9]|1[012])-(0?[1-9]|[12][0-9]|3[01])$"), #' cast=as.Date, @@ -548,7 +549,11 @@ mChoiceCast <- function(data, correct_length = nrow(Raw)) ################################################################### - # Run Validation Functions #### + # Run Validation Functions + + # Minimize user surprise on raw_cast #310 + if(identical(cast, raw_cast) && identical(validation, .default_validate)) + validation <- na_values(function(x, ...) rep(TRUE, length(x))) validations <- .castRecords_runValidation(Raw = Raw, diff --git a/R/fieldValidationAndCasting.R b/R/fieldValidationAndCasting.R index 7c249ef1..9dee13f5 100644 --- a/R/fieldValidationAndCasting.R +++ b/R/fieldValidationAndCasting.R @@ -66,6 +66,9 @@ #' of its value. Validation skipping has occasional utility when importing #' certain field types (such as `bioportal` or `sql`) where not all of the #' eventual choices are available in the project yet. +#' +#' `skip_validation` is a list of functions that just returns TRUE for +#' all data passed in. #' #' ## Casting Functions #' @@ -132,7 +135,8 @@ #' #' ## Casting Lists #' `raw_cast` overrides all casting if passed as the `cast` -#' parameter. +#' parameter. It is important the the validation specified matches +#' the chosen cast. For fully raw it should be `skip_validation`. #' #' `default_cast_no_factor` is a list of casting functions that matches #' all of the default casts but with the exception that any fields that would @@ -553,6 +557,7 @@ default_cast_no_factor <- list( default_cast_character <- default_cast_no_factor + ##################################################################### # Unexported - default lists for exportRecordsTyped #### @@ -686,3 +691,14 @@ FIELD_TYPES <- c( "truefalse", "checkbox", "form_complete", "select", "radio", "dropdown", "sql", "system", "bioportal") + + + + ##################################################################### + # +# Validation lists + +#' @rdname fieldValidationAndCasting +#' @export +skip_validation <- na_values(valSkip) + diff --git a/R/preserveProject.R b/R/preserveProject.R index 7f5a7064..39c1e8f8 100644 --- a/R/preserveProject.R +++ b/R/preserveProject.R @@ -223,7 +223,8 @@ preserveProject.redcapApiConnection <- function(rcon, dag_assignments = exportUserDagAssignments(rcon, error_handling = error_handling, config = config), - records = exportRecordsTyped(rcon, + records = exportRecordsTyped(rcon, + validation = skip_validation, cast = raw_cast, error_handling = error_handling, config = config), diff --git a/man/fieldCastingFunctions.Rd b/man/fieldCastingFunctions.Rd index 9965a63c..4fe80ea9 100644 --- a/man/fieldCastingFunctions.Rd +++ b/man/fieldCastingFunctions.Rd @@ -58,7 +58,9 @@ multiple choice fields. Fields of class \code{mChoice} are quietly skipped.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. If \code{raw_cast} is specified and +\code{validation} is left to default it will disable validation to pass all +values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{suffix}{\code{character(1)}. An optional suffix to provide if the recoded variables should be returned as new columns. For example, @@ -182,8 +184,9 @@ castForImport(Records, # Using guessCast -exportRecordsTyped(rcon, - cast = raw_cast) |> +exportRecordsTyped(rcon, + validation=skip_validation, + cast = raw_cast) |> guessCast(rcon, validation=valRx("^[0-9]{1,4}-(0?[1-9]|1[012])-(0?[1-9]|[12][0-9]|3[01])$"), cast=as.Date, diff --git a/man/fieldValidationAndCasting.Rd b/man/fieldValidationAndCasting.Rd index 111cb9d1..07da41ff 100644 --- a/man/fieldValidationAndCasting.Rd +++ b/man/fieldValidationAndCasting.Rd @@ -29,6 +29,7 @@ \alias{raw_cast} \alias{default_cast_no_factor} \alias{default_cast_character} +\alias{skip_validation} \title{Helper functions for \code{exportRecordsTyped} Validation and Casting} \format{ An object of class \code{list} of length 21. @@ -36,6 +37,8 @@ An object of class \code{list} of length 21. An object of class \code{list} of length 25. An object of class \code{list} of length 25. + +An object of class \code{list} of length 21. } \usage{ isNAorBlank(x, ...) @@ -89,6 +92,8 @@ raw_cast default_cast_no_factor default_cast_character + +skip_validation } \arguments{ \item{x}{\code{character}. A vector to check.} @@ -195,6 +200,9 @@ a field type. It returns a \code{TRUE} value for each record, regardless of its value. Validation skipping has occasional utility when importing certain field types (such as \code{bioportal} or \code{sql}) where not all of the eventual choices are available in the project yet. + +\code{skip_validation} is a list of functions that just returns TRUE for +all data passed in. } \subsection{Casting Functions}{ @@ -263,7 +271,8 @@ the value is one of \code{c("1", "true", "yes")} and returns \code{FALSE} otherw \subsection{Casting Lists}{ \code{raw_cast} overrides all casting if passed as the \code{cast} -parameter. +parameter. It is important the the validation specified matches +the chosen cast. For fully raw it should be \code{skip_validation}. \code{default_cast_no_factor} is a list of casting functions that matches all of the default casts but with the exception that any fields that would diff --git a/man/recordsMethods.Rd b/man/recordsMethods.Rd index 202e627b..62037d36 100644 --- a/man/recordsMethods.Rd +++ b/man/recordsMethods.Rd @@ -261,6 +261,11 @@ exportRecords(rcon, # Export a report exportReports(rcon, report_id = 12345) + +# Export raw data +# Note: Unless custom validations are indicated, using raw_cast will skip validations. +exportRecordsTyped(rcon, + cast = raw_cast) } diff --git a/man/recordsTypedMethods.Rd b/man/recordsTypedMethods.Rd index 8d35fb9a..5b05b3ac 100644 --- a/man/recordsTypedMethods.Rd +++ b/man/recordsTypedMethods.Rd @@ -135,7 +135,9 @@ are not identified as NA will be passed to validation functions.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. If \code{raw_cast} is specified and +\code{validation} is left to default it will disable validation to pass all +values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{assignment}{A named \code{list} of functions. These functions are provided, field_name, label, description and field_type and return a list of attributes to assign From e8ec506e8e2c9bf7f37aafb2f71ca1b0935508d7 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Jan 2024 11:10:33 -0600 Subject: [PATCH 005/155] Rework of #310 --- R/exportRecordsTyped.R | 1 + R/fieldCastingFunctions.R | 5 ++--- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 2f784a9d..2f5b7cbb 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -430,6 +430,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, checkmate::assert_list(x = validation, names = "named", + null.ok = TRUE, add = coll) checkmate::assert_list(x = cast, diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index 61580a26..78f36fe1 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -266,6 +266,7 @@ castForImport <- function(data, checkmate::assert_list(x = validation, names = "named", + null.ok= TRUE, add = coll) checkmate::assert_list(x = cast, @@ -551,9 +552,7 @@ mChoiceCast <- function(data, ################################################################### # Run Validation Functions - # Minimize user surprise on raw_cast #310 - if(identical(cast, raw_cast) && identical(validation, .default_validate)) - validation <- na_values(function(x, ...) rep(TRUE, length(x))) + if(is.null(validation)) validation <- skip_validation validations <- .castRecords_runValidation(Raw = Raw, From bf5802df037f347e05392963275ac64de7d624c0 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Jan 2024 11:13:22 -0600 Subject: [PATCH 006/155] Example updated #310 --- R/docsRecordsMethods.R | 2 +- man/recordsMethods.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/docsRecordsMethods.R b/R/docsRecordsMethods.R index 5ea413bd..9517a68f 100644 --- a/R/docsRecordsMethods.R +++ b/R/docsRecordsMethods.R @@ -147,8 +147,8 @@ #' report_id = 12345) #' #' # Export raw data -#' # Note: Unless custom validations are indicated, using raw_cast will skip validations. #' exportRecordsTyped(rcon, +#' validation = skip_validation, #' cast = raw_cast) #' #' } diff --git a/man/recordsMethods.Rd b/man/recordsMethods.Rd index 62037d36..cc5f75fd 100644 --- a/man/recordsMethods.Rd +++ b/man/recordsMethods.Rd @@ -263,8 +263,8 @@ exportReports(rcon, report_id = 12345) # Export raw data -# Note: Unless custom validations are indicated, using raw_cast will skip validations. exportRecordsTyped(rcon, + validation = skip_validation, cast = raw_cast) } From 554b5ccd74321172084aa3f57c273caa24b454ce Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Jan 2024 11:24:39 -0600 Subject: [PATCH 007/155] Git revert left in pieces #310 --- R/documentation-common-args.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/documentation-common-args.R b/R/documentation-common-args.R index 13d7677f..370cbe1b 100644 --- a/R/documentation-common-args.R +++ b/R/documentation-common-args.R @@ -55,9 +55,9 @@ NULL #' @param cast A named `list` of user specified class casting functions. The #' same named keys are supported as the na argument. The function will be #' provided the variables (x, field_name, coding). The function must return a -#' vector of logical matching the input length. If `raw_cast` is specified and -#' `validation` is left to default it will disable validation to pass all -#' values as raw. See [fieldValidationAndCasting()] +#' vector of logical matching the input length. The cast should match the validation, +#' if one is using `raw_cast`, then `validation=skip_validation` is likely +#' the desired intent. See [fieldValidationAndCasting()] #' @param assignment A named `list` of functions. These functions are provided, field_name, #' label, description and field_type and return a list of attributes to assign #' to the column. Defaults to creating a label attribute from the stripped From f1ad28a3caf73d8473f7ebb2cd91fa3304b340ce Mon Sep 17 00:00:00 2001 From: Benjamin Date: Wed, 17 Jan 2024 19:25:59 -0500 Subject: [PATCH 008/155] all I did was run devtools::document() --- man/fieldCastingFunctions.Rd | 6 +++--- man/recordsTypedMethods.Rd | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/man/fieldCastingFunctions.Rd b/man/fieldCastingFunctions.Rd index 4fe80ea9..71a69724 100644 --- a/man/fieldCastingFunctions.Rd +++ b/man/fieldCastingFunctions.Rd @@ -58,9 +58,9 @@ multiple choice fields. Fields of class \code{mChoice} are quietly skipped.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. If \code{raw_cast} is specified and -\code{validation} is left to default it will disable validation to pass all -values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. The cast should match the validation, +if one is using \code{raw_cast}, then \code{validation=skip_validation} is likely +the desired intent. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{suffix}{\code{character(1)}. An optional suffix to provide if the recoded variables should be returned as new columns. For example, diff --git a/man/recordsTypedMethods.Rd b/man/recordsTypedMethods.Rd index 5b05b3ac..fc09bfa0 100644 --- a/man/recordsTypedMethods.Rd +++ b/man/recordsTypedMethods.Rd @@ -135,9 +135,9 @@ are not identified as NA will be passed to validation functions.} \item{cast}{A named \code{list} of user specified class casting functions. The same named keys are supported as the na argument. The function will be provided the variables (x, field_name, coding). The function must return a -vector of logical matching the input length. If \code{raw_cast} is specified and -\code{validation} is left to default it will disable validation to pass all -values as raw. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} +vector of logical matching the input length. The cast should match the validation, +if one is using \code{raw_cast}, then \code{validation=skip_validation} is likely +the desired intent. See \code{\link[=fieldValidationAndCasting]{fieldValidationAndCasting()}}} \item{assignment}{A named \code{list} of functions. These functions are provided, field_name, label, description and field_type and return a list of attributes to assign From cef7c3f6d8398c840450276eb995d2256b03072d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 18 Jan 2024 09:02:30 -0600 Subject: [PATCH 009/155] Updating news for #310 --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index c75aa815..70de2428 100644 --- a/NEWS +++ b/NEWS @@ -16,6 +16,7 @@ A future release of version 3.0.0 will introduce several breaking changes! * Improved speed / memory usage for empty row exclusion. * Checkbox field labels now follow the pattern '[field_label] (choice=[choice_label])' * Fixed checkbox handling to be consistent with data export tool. +* Added `skip_validation` function to complement `raw_cast`. ## 2.8.2 From fac6860130667583238af42ffa39a92b3443ac92 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 19 Jan 2024 08:54:32 -0600 Subject: [PATCH 010/155] Updating README with troubleshooting --- README.md | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/README.md b/README.md index 7854c0ec..83adbced 100644 --- a/README.md +++ b/README.md @@ -48,6 +48,18 @@ These two calls will handle most analysis requests. To truly understand all thes 2.7.0 includes `exportRecordsTyped` which is a major move forward for the package. It replaces `exportRecords` with a far more stable and dependable call. It includes retries with exponential backoff through the connection object. It has inversion of control over casting, and has a useful validation report attached when things fail. It is worth the time to convert calls to `exportRecords` to `exportRecordsTyped` and begin using this new routine. It is planned that in the next year `exportRecords` will be removed from the package. +## Troubleshooting Exports + +REDCap and it's API have a large number of options and choices, with such complexity the possibility of bugs increases as well. This is a checklist of troubleshooting exports. + +1. Does `Rec <- exportRecordsTyped(rcon)` give you a warning about data that failed validations? If so, what kind of content are you seeing from `reviewInvalidRecords(Rec)`? +2. What is returned by `exportRecordsTyped(rcon, validation = skip_validation, cast = raw_cast)`? This is a completely raw export with no processing by the library. +3. Do you have any project level missing data codes? `rcon$projectInformation()$missing_data_codes` +4. Do you have a secondary id field defined? `rcon$projectInformation()$secondary_unique_field`. In earlier versions REDCap will report one even if it's been disabled later, if this column doesn't exist then the library is unable to properly handle exports as the definition of the unique key doesn't exist. If one is defined and the field doesn't exist, one will have to contact their REDCap administrator to get the project fixed. +5. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. +6. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) + on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. + ## Back Matter *NOTE*: Ownership transfer of this package to VUMC Biostatistics is complete. From f65710241f6161ec4bf7275b14a532c5a5eef7a8 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 19 Jan 2024 08:56:43 -0600 Subject: [PATCH 011/155] Tweak to README --- README.md | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 83adbced..8c81292c 100644 --- a/README.md +++ b/README.md @@ -56,8 +56,9 @@ REDCap and it's API have a large number of options and choices, with such comple 2. What is returned by `exportRecordsTyped(rcon, validation = skip_validation, cast = raw_cast)`? This is a completely raw export with no processing by the library. 3. Do you have any project level missing data codes? `rcon$projectInformation()$missing_data_codes` 4. Do you have a secondary id field defined? `rcon$projectInformation()$secondary_unique_field`. In earlier versions REDCap will report one even if it's been disabled later, if this column doesn't exist then the library is unable to properly handle exports as the definition of the unique key doesn't exist. If one is defined and the field doesn't exist, one will have to contact their REDCap administrator to get the project fixed. -5. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. -6. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) +5. Is it an empty row filtering issue? Try the option `filter_empty_rows=FALSE` and see if that fixes it. +6. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. +7. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. ## Back Matter From 3f5b13f1667f5deef451c8c1109cce7b68a1b80e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 14:49:05 -0600 Subject: [PATCH 012/155] Safe read.csv from API call. #290, #297, #314 --- DESCRIPTION | 2 +- NEWS | 4 ++++ R/createFileRepositoryFolder.R | 2 +- R/exportArms.R | 2 +- R/exportDags.R | 2 +- R/exportEvents.R | 2 +- R/exportFieldNames.R | 2 +- R/exportInstruments.R | 2 +- R/exportLogging.R | 2 +- R/exportMappings.R | 2 +- R/exportProjectInformation.R | 2 +- R/exportRecordsTyped.R | 4 ++-- R/exportRepeatingInstrumentsEvents.R | 2 +- R/exportReports.R | 2 +- R/exportReportsTyped.R | 2 +- R/exportUserDagAssignments.R | 2 +- R/exportUserRoleAssignments.R | 2 +- R/exportUserRoles.R | 2 +- R/exportUsers.R | 2 +- R/importRecords.R | 2 +- R/makeApiCall.R | 5 +++++ 21 files changed, 29 insertions(+), 20 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0ad82f62..0fda6fd0 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: redcapAPI Type: Package Title: Interface to 'REDCap' -Version: 2.8.3 +Version: 2.8.4 Authors@R: c( person("Shawn", "Garbett", email = "shawn.garbett@vumc.org", comment = c(ORCID="0000-0003-4079-5621"), diff --git a/NEWS b/NEWS index 70de2428..3f9204ec 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,10 @@ A future release of version 3.0.0 will introduce several breaking changes! * The `exportProjectInfo` and `exportBundle` functions are being discontinued. Their functionality is replaced by caching values on the connection object. * The `cleanseMetaData` function is being discontinued. +## 2.8.4 + +* Patch to reading HTTP data. When non UTF-8 characters are sent, they get mapped to '□'. + ## 2.8.3 * Patch to date range handling that was breaking on new REDCap projects since version 14.0.2 of the REDCap server. diff --git a/R/createFileRepositoryFolder.R b/R/createFileRepositoryFolder.R index 819020fc..bde22291 100644 --- a/R/createFileRepositoryFolder.R +++ b/R/createFileRepositoryFolder.R @@ -188,7 +188,7 @@ createFileRepositoryFolder.redcapApiConnection <- function(rcon, } # Prepare Output -------------------------------------------------- - NewFolder <- utils::read.csv(text = as.character(response), + NewFolder <- utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") NewFolder$name <- rep(name, nrow(NewFolder)) diff --git a/R/exportArms.R b/R/exportArms.R index c1062b59..b8f7e480 100644 --- a/R/exportArms.R +++ b/R/exportArms.R @@ -69,7 +69,7 @@ exportArms.redcapApiConnection <- function(rcon, error_handling = error_handling) } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportDags.R b/R/exportDags.R index 706063fc..b0ef1749 100644 --- a/R/exportDags.R +++ b/R/exportDags.R @@ -58,7 +58,7 @@ exportDags.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), na.strings = "", stringsAsFactors = FALSE) } diff --git a/R/exportEvents.R b/R/exportEvents.R index 912f1ebe..22409a31 100644 --- a/R/exportEvents.R +++ b/R/exportEvents.R @@ -86,7 +86,7 @@ exportEvents.redcapApiConnection <- function(rcon, if (trimws(as.character(response)) == ""){ REDCAP_EVENT_STRUCTURE } else { - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportFieldNames.R b/R/exportFieldNames.R index 7a3ad86a..f6183ac0 100644 --- a/R/exportFieldNames.R +++ b/R/exportFieldNames.R @@ -138,7 +138,7 @@ exportFieldNames.redcapApiConnection <- function(rcon, } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportInstruments.R b/R/exportInstruments.R index 0afa81af..32ca420d 100644 --- a/R/exportInstruments.R +++ b/R/exportInstruments.R @@ -90,7 +90,7 @@ exportInstruments.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportLogging.R b/R/exportLogging.R index 0ab8b6f9..3c0a15a1 100644 --- a/R/exportLogging.R +++ b/R/exportLogging.R @@ -160,7 +160,7 @@ exportLogging.redcapApiConnection <- function(rcon, error_handling = error_handling) } - Log <- utils::read.csv(text = as.character(response), + Log <- utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") diff --git a/R/exportMappings.R b/R/exportMappings.R index 11eff527..32369d40 100644 --- a/R/exportMappings.R +++ b/R/exportMappings.R @@ -77,7 +77,7 @@ exportMappings.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportProjectInformation.R b/R/exportProjectInformation.R index 801a668c..33f9477f 100644 --- a/R/exportProjectInformation.R +++ b/R/exportProjectInformation.R @@ -59,7 +59,7 @@ exportProjectInformation.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings="") } diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 89aa01f2..eb5e994f 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -660,7 +660,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, return(data.frame()) } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "", colClasses = "character", @@ -699,7 +699,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, return(data.frame()) } - records <- utils::read.csv(text = as.character(record_response), + records <- utils::read.csv(text = .safe_as_character_response(record_response), stringsAsFactors = FALSE, na.strings = "", sep = csv_delimiter) diff --git a/R/exportRepeatingInstrumentsEvents.R b/R/exportRepeatingInstrumentsEvents.R index 27bb4862..721503ee 100644 --- a/R/exportRepeatingInstrumentsEvents.R +++ b/R/exportRepeatingInstrumentsEvents.R @@ -69,7 +69,7 @@ exportRepeatingInstrumentsEvents.redcapApiConnection <- function(rcon, error_handling = error_handling) } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") } diff --git a/R/exportReports.R b/R/exportReports.R index 4570d8dc..f644c0c8 100644 --- a/R/exportReports.R +++ b/R/exportReports.R @@ -115,7 +115,7 @@ exportReports.redcapApiConnection <- function(rcon, if (response$status_code != 200) redcapError(response, error_handling) - Report <- utils::read.csv(text = as.character(response), + Report <- utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") diff --git a/R/exportReportsTyped.R b/R/exportReportsTyped.R index 6e694151..d814513b 100644 --- a/R/exportReportsTyped.R +++ b/R/exportReportsTyped.R @@ -109,7 +109,7 @@ exportReportsTyped.redcapApiConnection <- function(rcon, body = c(body, api_param), config) - Raw <- utils::read.csv(text = as.character(response), + Raw <- utils::read.csv(text = .safe_as_character_response(response), na.strings = "", sep = csv_delimiter, stringsAsFactors = FALSE) diff --git a/R/exportUserDagAssignments.R b/R/exportUserDagAssignments.R index 65e1d1f6..5bf4b5cf 100644 --- a/R/exportUserDagAssignments.R +++ b/R/exportUserDagAssignments.R @@ -65,7 +65,7 @@ exportUserDagAssignments.redcapApiConnection <- function(rcon, return(REDCAP_DAG_ASSIGNMENT_STRUCTURE) } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), na.strings = "", stringsAsFactors = FALSE) } diff --git a/R/exportUserRoleAssignments.R b/R/exportUserRoleAssignments.R index be67e93f..6b3c2bdb 100644 --- a/R/exportUserRoleAssignments.R +++ b/R/exportUserRoleAssignments.R @@ -64,7 +64,7 @@ exportUserRoleAssignments.redcapApiConnection <- function(rcon, return(REDCAP_USER_ROLE_ASSIGNMENT_STRUCTURE) } - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), na.strings = "", stringsAsFactors = FALSE) } diff --git a/R/exportUserRoles.R b/R/exportUserRoles.R index b3c979e8..94d31012 100644 --- a/R/exportUserRoles.R +++ b/R/exportUserRoles.R @@ -76,7 +76,7 @@ exportUserRoles.redcapApiConnection <- function(rcon, return(REDCAP_USER_ROLE_STRUCTURE) } - UserRole <- utils::read.csv(text = as.character(response), + UserRole <- utils::read.csv(text = .safe_as_character_response(response), na.strings = "", stringsAsFactors = FALSE) diff --git a/R/exportUsers.R b/R/exportUsers.R index 17e3771f..c580a94e 100644 --- a/R/exportUsers.R +++ b/R/exportUsers.R @@ -78,7 +78,7 @@ exportUsers.redcapApiConnection <- function(rcon, error_handling = error_handling) } - Users <- utils::read.csv(text = as.character(response), + Users <- utils::read.csv(text = .safe_as_character_response(response), stringsAsFactors = FALSE, na.strings = "") diff --git a/R/importRecords.R b/R/importRecords.R index 9bcc6393..884bfcbd 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -443,7 +443,7 @@ import_records_unbatched <- function(rcon, if (response$status_code == "200"){ if (returnContent %in% c("ids", "auto_ids")){ - utils::read.csv(text = as.character(response), + utils::read.csv(text = .safe_as_character_response(response), na.strings = "", stringsAsFactors = FALSE) } else { diff --git a/R/makeApiCall.R b/R/makeApiCall.R index f7d52a9a..d68e8612 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -258,3 +258,8 @@ makeApiCall <- function(rcon, message(msg_part1, msg_part2, msg_part3) } + +# Helper function to convert responses to character strings without crashing. +# ASSUMPTION: UTF-8 is the only allowed encoding. +.safe_as_character_response <- function(x, ...) + iconv(readBin(x$content, character()), 'UTF-8', 'UTF-8', '\U25a1') From d140f3074c53453e9dcd1e12995bf8987dbe75d5 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 15:01:20 -0600 Subject: [PATCH 013/155] Added test for iconv patch, #290, #291, #314 --- tests/testthat/test-050-makeApiCall.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 841a6ddc..0fe2d79a 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -173,4 +173,15 @@ test_that( config = list(1, 2, 3)), "'config': Must have names") } +) + +test_that( + ".safe_as_character_response handles invalid encoded characters", + { + x <- list(content=charToRaw("fa\xE7il,joe\n1, 2\n3, 4")) + y <- .safe_as_character_response(x) + expect_true(grepl("\u25a1",y)) + expect_equal(read.csv(text=y), + data.frame(fa.il=c(1,3), joe=c(2,4))) + } ) \ No newline at end of file From 199151da53484415281cbaa5c7fc70218e3594de Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 16:04:48 -0600 Subject: [PATCH 014/155] Changed to have all read.csv in single function, #290, #297, #314 --- R/createFileRepositoryFolder.R | 5 ++--- R/exportArms.R | 4 +--- R/exportDags.R | 4 +--- R/exportEvents.R | 4 +--- R/exportFieldNames.R | 4 +--- R/exportInstruments.R | 4 +--- R/exportLogging.R | 4 +--- R/exportMappings.R | 4 +--- R/exportProjectInformation.R | 4 +--- R/exportRecordsTyped.R | 13 ++++--------- R/exportRepeatingInstrumentsEvents.R | 4 +--- R/exportReports.R | 4 +--- R/exportReportsTyped.R | 5 +---- R/exportUserDagAssignments.R | 4 +--- R/exportUserRoleAssignments.R | 4 +--- R/exportUserRoles.R | 4 +--- R/exportUsers.R | 4 +--- R/importRecords.R | 4 +--- R/makeApiCall.R | 9 +++++++-- tests/testthat/test-050-makeApiCall.R | 14 ++++++++------ 20 files changed, 37 insertions(+), 69 deletions(-) diff --git a/R/createFileRepositoryFolder.R b/R/createFileRepositoryFolder.R index bde22291..5d3be76f 100644 --- a/R/createFileRepositoryFolder.R +++ b/R/createFileRepositoryFolder.R @@ -188,9 +188,8 @@ createFileRepositoryFolder.redcapApiConnection <- function(rcon, } # Prepare Output -------------------------------------------------- - NewFolder <- utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + NewFolder <- as.data.frame(response) + NewFolder$name <- rep(name, nrow(NewFolder)) NewFolder diff --git a/R/exportArms.R b/R/exportArms.R index b8f7e480..3c2915eb 100644 --- a/R/exportArms.R +++ b/R/exportArms.R @@ -69,7 +69,5 @@ exportArms.redcapApiConnection <- function(rcon, error_handling = error_handling) } - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } diff --git a/R/exportDags.R b/R/exportDags.R index b0ef1749..53afd0b7 100644 --- a/R/exportDags.R +++ b/R/exportDags.R @@ -58,7 +58,5 @@ exportDags.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - stringsAsFactors = FALSE) + as.data.frame(response) } diff --git a/R/exportEvents.R b/R/exportEvents.R index 22409a31..607ca00d 100644 --- a/R/exportEvents.R +++ b/R/exportEvents.R @@ -86,8 +86,6 @@ exportEvents.redcapApiConnection <- function(rcon, if (trimws(as.character(response)) == ""){ REDCAP_EVENT_STRUCTURE } else { - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } } diff --git a/R/exportFieldNames.R b/R/exportFieldNames.R index f6183ac0..16fc982a 100644 --- a/R/exportFieldNames.R +++ b/R/exportFieldNames.R @@ -138,9 +138,7 @@ exportFieldNames.redcapApiConnection <- function(rcon, } - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } # Unexported -------------------------------------------------------- diff --git a/R/exportInstruments.R b/R/exportInstruments.R index 32ca420d..172e7d9a 100644 --- a/R/exportInstruments.R +++ b/R/exportInstruments.R @@ -90,7 +90,5 @@ exportInstruments.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } diff --git a/R/exportLogging.R b/R/exportLogging.R index 3c0a15a1..17ecaaa2 100644 --- a/R/exportLogging.R +++ b/R/exportLogging.R @@ -160,9 +160,7 @@ exportLogging.redcapApiConnection <- function(rcon, error_handling = error_handling) } - Log <- utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + Log <- as.data.frame(response) # Format and return data ------------------------------------------ Log$timestamp <- as.POSIXct(Log$timestamp, diff --git a/R/exportMappings.R b/R/exportMappings.R index 32369d40..1186f85f 100644 --- a/R/exportMappings.R +++ b/R/exportMappings.R @@ -77,7 +77,5 @@ exportMappings.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } diff --git a/R/exportProjectInformation.R b/R/exportProjectInformation.R index 33f9477f..cd139acc 100644 --- a/R/exportProjectInformation.R +++ b/R/exportProjectInformation.R @@ -59,7 +59,5 @@ exportProjectInformation.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings="") + as.data.frame(response) } diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index eb5e994f..bbc1b90c 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -660,11 +660,9 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, return(data.frame()) } - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "", - colClasses = "character", - sep = csv_delimiter) + as.data.frame(response, + colClasses = "character", + sep = csv_delimiter) } # .exportRecordsTyped_Batched --------------------------------------- @@ -699,10 +697,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, return(data.frame()) } - records <- utils::read.csv(text = .safe_as_character_response(record_response), - stringsAsFactors = FALSE, - na.strings = "", - sep = csv_delimiter) + records <- as.data.frame(record_response, sep = csv_delimiter) records <- unique(records[[target_field]]) } diff --git a/R/exportRepeatingInstrumentsEvents.R b/R/exportRepeatingInstrumentsEvents.R index 721503ee..47b03b21 100644 --- a/R/exportRepeatingInstrumentsEvents.R +++ b/R/exportRepeatingInstrumentsEvents.R @@ -69,7 +69,5 @@ exportRepeatingInstrumentsEvents.redcapApiConnection <- function(rcon, error_handling = error_handling) } - utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + as.data.frame(response) } diff --git a/R/exportReports.R b/R/exportReports.R index f644c0c8..fdf5d0e7 100644 --- a/R/exportReports.R +++ b/R/exportReports.R @@ -115,9 +115,7 @@ exportReports.redcapApiConnection <- function(rcon, if (response$status_code != 200) redcapError(response, error_handling) - Report <- utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + Report <- as.data.frame(response) ################################################################## # Process the data diff --git a/R/exportReportsTyped.R b/R/exportReportsTyped.R index d814513b..7c18c350 100644 --- a/R/exportReportsTyped.R +++ b/R/exportReportsTyped.R @@ -109,10 +109,7 @@ exportReportsTyped.redcapApiConnection <- function(rcon, body = c(body, api_param), config) - Raw <- utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - sep = csv_delimiter, - stringsAsFactors = FALSE) + Raw <- as.data.frame(response, sep = csv_delimiter) if (length(drop_fields) > 0){ Raw <- Raw[!names(Raw) %in% drop_fields] diff --git a/R/exportUserDagAssignments.R b/R/exportUserDagAssignments.R index 5bf4b5cf..b60a4cb2 100644 --- a/R/exportUserDagAssignments.R +++ b/R/exportUserDagAssignments.R @@ -65,7 +65,5 @@ exportUserDagAssignments.redcapApiConnection <- function(rcon, return(REDCAP_DAG_ASSIGNMENT_STRUCTURE) } - utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - stringsAsFactors = FALSE) + as.data.frame(response) } diff --git a/R/exportUserRoleAssignments.R b/R/exportUserRoleAssignments.R index 6b3c2bdb..aca7b800 100644 --- a/R/exportUserRoleAssignments.R +++ b/R/exportUserRoleAssignments.R @@ -64,7 +64,5 @@ exportUserRoleAssignments.redcapApiConnection <- function(rcon, return(REDCAP_USER_ROLE_ASSIGNMENT_STRUCTURE) } - utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - stringsAsFactors = FALSE) + as.data.frame(response) } diff --git a/R/exportUserRoles.R b/R/exportUserRoles.R index 94d31012..b8ccd755 100644 --- a/R/exportUserRoles.R +++ b/R/exportUserRoles.R @@ -76,9 +76,7 @@ exportUserRoles.redcapApiConnection <- function(rcon, return(REDCAP_USER_ROLE_STRUCTURE) } - UserRole <- utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - stringsAsFactors = FALSE) + UserRole <- as.data.frame(response) # The API returns the forms_export string twice. We reduce it to once here temp <- UserRole$forms_export diff --git a/R/exportUsers.R b/R/exportUsers.R index c580a94e..13404bd1 100644 --- a/R/exportUsers.R +++ b/R/exportUsers.R @@ -78,9 +78,7 @@ exportUsers.redcapApiConnection <- function(rcon, error_handling = error_handling) } - Users <- utils::read.csv(text = .safe_as_character_response(response), - stringsAsFactors = FALSE, - na.strings = "") + Users <- as.data.frame(response) Users$forms_export <- sub(",registration[:]\\d{1}.+$", "", Users$forms_export) diff --git a/R/importRecords.R b/R/importRecords.R index 884bfcbd..1102a402 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -443,9 +443,7 @@ import_records_unbatched <- function(rcon, if (response$status_code == "200"){ if (returnContent %in% c("ids", "auto_ids")){ - utils::read.csv(text = .safe_as_character_response(response), - na.strings = "", - stringsAsFactors = FALSE) + as.data.frame(response) } else { as.character(response) } diff --git a/R/makeApiCall.R b/R/makeApiCall.R index d68e8612..eaecbaee 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -261,5 +261,10 @@ makeApiCall <- function(rcon, # Helper function to convert responses to character strings without crashing. # ASSUMPTION: UTF-8 is the only allowed encoding. -.safe_as_character_response <- function(x, ...) - iconv(readBin(x$content, character()), 'UTF-8', 'UTF-8', '\U25a1') +as.data.frame.response <- function(x, ...) + utils::read.csv( + text = iconv(readBin(x$content, character()), + 'UTF-8', 'UTF-8', '\U25a1'), + stringsAsFactors = FALSE, + na.strings = "", + ...) diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 0fe2d79a..5125bc4d 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -176,12 +176,14 @@ test_that( ) test_that( - ".safe_as_character_response handles invalid encoded characters", + "as.data.frame.response handles invalid encoded characters", { - x <- list(content=charToRaw("fa\xE7il,joe\n1, 2\n3, 4")) - y <- .safe_as_character_response(x) - expect_true(grepl("\u25a1",y)) - expect_equal(read.csv(text=y), - data.frame(fa.il=c(1,3), joe=c(2,4))) + x <- list(content=charToRaw("fa\xE7il,joe\n1,2\xE7\n3,4")) + class(x) <- c("response","list") + y <- redcapAPI:::as.data.frame.response(x) + expect_equal( + y, + data.frame(fa.il=as.integer(c(1,3)), joe=c("2\U25a1","4")) + ) } ) \ No newline at end of file From cd574d086de062f16c3605b9945ce1b3ed7444e2 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 16:13:30 -0600 Subject: [PATCH 015/155] Minor change to as.data.frame.response interface, #290 #297 #314 --- R/makeApiCall.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index eaecbaee..f82ba0a8 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -261,10 +261,10 @@ makeApiCall <- function(rcon, # Helper function to convert responses to character strings without crashing. # ASSUMPTION: UTF-8 is the only allowed encoding. -as.data.frame.response <- function(x, ...) +as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) utils::read.csv( text = iconv(readBin(x$content, character()), 'UTF-8', 'UTF-8', '\U25a1'), - stringsAsFactors = FALSE, - na.strings = "", + stringsAsFactors = stringsAsFactors, + na.strings = na.strings, ...) From 676d4f5b28650ef1511081cf218abd6510b9ecf3 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 16:34:27 -0600 Subject: [PATCH 016/155] Respect response encoding #290 #297 #314 --- R/makeApiCall.R | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index f82ba0a8..2deb4e1f 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -262,9 +262,13 @@ makeApiCall <- function(rcon, # Helper function to convert responses to character strings without crashing. # ASSUMPTION: UTF-8 is the only allowed encoding. as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) +{ + enc <- x$headers[["Content-Type"]] + if(is.null(enc)) enc <- 'UTF-8' utils::read.csv( text = iconv(readBin(x$content, character()), - 'UTF-8', 'UTF-8', '\U25a1'), + enc, 'UTF-8', '\U25a1'), stringsAsFactors = stringsAsFactors, na.strings = na.strings, ...) +} From 04dee4f67185e6b30a531b2cdb889d0f6bc46a3d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 23 Jan 2024 16:36:55 -0600 Subject: [PATCH 017/155] Remove comment about assumption #290 #297 #314 --- R/makeApiCall.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 2deb4e1f..110ded10 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -260,7 +260,6 @@ makeApiCall <- function(rcon, } # Helper function to convert responses to character strings without crashing. -# ASSUMPTION: UTF-8 is the only allowed encoding. as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) { enc <- x$headers[["Content-Type"]] From 36728648c0b739cda58df64b3f259d4a0c123743 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 08:39:00 -0600 Subject: [PATCH 018/155] Added warning #290 #297 #314 --- R/makeApiCall.R | 9 ++++++--- tests/testthat/test-050-makeApiCall.R | 3 ++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 110ded10..28a9c010 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -264,10 +264,13 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . { enc <- x$headers[["Content-Type"]] if(is.null(enc)) enc <- 'UTF-8' - utils::read.csv( - text = iconv(readBin(x$content, character()), - enc, 'UTF-8', '\U25a1'), + mapped <- iconv(readBin(x$content, character()), + enc, 'UTF-8', '\U25a1') + if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") + Frame <- utils::read.csv( + text = mapped, stringsAsFactors = stringsAsFactors, na.strings = na.strings, ...) + Frame } diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 5125bc4d..6f67dd8b 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -180,7 +180,8 @@ test_that( { x <- list(content=charToRaw("fa\xE7il,joe\n1,2\xE7\n3,4")) class(x) <- c("response","list") - y <- redcapAPI:::as.data.frame.response(x) + expect_warning({y <- redcapAPI:::as.data.frame.response(x)}, + "invalid characters") expect_equal( y, data.frame(fa.il=as.integer(c(1,3)), joe=c("2\U25a1","4")) From b59a6b446a8bb2c340437bcdb94ae03944a4ffbd Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 08:42:37 -0600 Subject: [PATCH 019/155] Removed unnecessary named variable #290 #291 #314 --- R/makeApiCall.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 28a9c010..635eef74 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -267,10 +267,9 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . mapped <- iconv(readBin(x$content, character()), enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") - Frame <- utils::read.csv( + utils::read.csv( text = mapped, stringsAsFactors = stringsAsFactors, na.strings = na.strings, ...) - Frame } From 770c894957ea6d2d6a81511c47081fca6ec9758c Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 13:27:03 -0600 Subject: [PATCH 020/155] Updating DOI --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 8c81292c..cd0fe97d 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -[![DOI](https://zenodo.org/badge/doi/10.5281/zenodo.11826.png)](https://dx.doi.org/10.5281/zenodo.11826) +[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.10564837.svg)](https://doi.org/10.5281/zenodo.10564837) ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) redcapAPI From 80738259326b44fe6bcde08f950e9de062f7ed23 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 14:10:18 -0600 Subject: [PATCH 021/155] Adding zenodo reference --- .Rbuildignore | 1 + .zenodo.json | 356 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 357 insertions(+) create mode 100644 .zenodo.json diff --git a/.Rbuildignore b/.Rbuildignore index a7e5aaa8..4cf34760 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -13,3 +13,4 @@ ^tests/testthat/local-token.Rdata$ ^doc$ ^Meta$ +^\.zenodo.json$ diff --git a/.zenodo.json b/.zenodo.json new file mode 100644 index 00000000..09814edc --- /dev/null +++ b/.zenodo.json @@ -0,0 +1,356 @@ +{ + "access": { + "embargo": { + "active": false, + "reason": null + }, + "files": "public", + "record": "public", + "status": "open" + }, + "created": "2024-01-24T19:19:08.279065+00:00", + "custom_fields": {}, + "deletion_status": { + "is_deleted": false, + "status": "P" + }, + "files": { + "count": 1, + "enabled": true, + "entries": { + "vubiostat/redcapAPI-v2.8.3.zip": { + "checksum": "md5:9b96ec712d6eaf9b15bd38c3fdeea130", + "ext": "zip", + "id": "a59af6dd-af4a-4dcd-83a5-9d49013ced69", + "key": "vubiostat/redcapAPI-v2.8.3.zip", + "metadata": null, + "mimetype": "application/zip", + "size": 2188907 + } + }, + "order": [], + "total_bytes": 2188907 + }, + "id": "10564837", + "is_draft": false, + "is_published": true, + "links": { + "access": "https://zenodo.org/api/records/10564837/access", + "access_links": "https://zenodo.org/api/records/10564837/access/links", + "access_request": "https://zenodo.org/api/records/10564837/access/request", + "access_users": "https://zenodo.org/api/records/10564837/access/users", + "archive": "https://zenodo.org/api/records/10564837/files-archive", + "archive_media": "https://zenodo.org/api/records/10564837/media-files-archive", + "communities": "https://zenodo.org/api/records/10564837/communities", + "communities-suggestions": "https://zenodo.org/api/records/10564837/communities-suggestions", + "doi": "https://doi.org/10.5281/zenodo.10564837", + "draft": "https://zenodo.org/api/records/10564837/draft", + "files": "https://zenodo.org/api/records/10564837/files", + "latest": "https://zenodo.org/api/records/10564837/versions/latest", + "latest_html": "https://zenodo.org/records/10564837/latest", + "media_files": "https://zenodo.org/api/records/10564837/media-files", + "parent": "https://zenodo.org/api/records/10564836", + "parent_doi": "https://zenodo.org/doi/10.5281/zenodo.10564836", + "parent_html": "https://zenodo.org/records/10564836", + "requests": "https://zenodo.org/api/records/10564837/requests", + "reserve_doi": "https://zenodo.org/api/records/10564837/draft/pids/doi", + "self": "https://zenodo.org/api/records/10564837", + "self_doi": "https://zenodo.org/doi/10.5281/zenodo.10564837", + "self_html": "https://zenodo.org/records/10564837", + "self_iiif_manifest": "https://zenodo.org/api/iiif/record:10564837/manifest", + "self_iiif_sequence": "https://zenodo.org/api/iiif/record:10564837/sequence/default", + "versions": "https://zenodo.org/api/records/10564837/versions" + }, + "media_files": { + "count": 0, + "enabled": false, + "entries": {}, + "order": [], + "total_bytes": 0 + }, + "metadata": { + "creators": [ + { + "affiliations": [ + { + "name": "Battelle Memorial Institute" + } + ], + "person_or_org": { + "family_name": "Nutter", + "given_name": "Benjamin", + "name": "Nutter, Benjamin", + "type": "personal" + } + }, + { + "affiliations": [ + { + "name": "Vanderbilt University Medical Center" + } + ], + "person_or_org": { + "family_name": "Garbett", + "given_name": "Shawn", + "name": "Garbett, Shawn", + "type": "personal" + } + }, + { + "affiliations": [ + { + "id": "05dq2gs74", + "name": "Vanderbilt University Medical Center" + } + ], + "person_or_org": { + "family_name": "Obregon", + "given_name": "Savannah", + "name": "Obregon, Savannah", + "type": "personal" + } + }, + { + "affiliations": [ + { + "name": "Institut Pasteur" + } + ], + "person_or_org": { + "family_name": "Obadia", + "given_name": "Thomas", + "name": "Obadia, Thomas", + "type": "personal" + } + }, + { + "affiliations": [ + { + "name": "University of Washington (UW)" + } + ], + "person_or_org": { + "family_name": "High", + "given_name": "Brian", + "name": "High, Brian", + "type": "personal" + } + }, + { + "affiliations": [ + { + "name": "University of Oklahoma Health Sciences Center & Howard Live Oak, LLC" + } + ], + "person_or_org": { + "family_name": "Beasley", + "given_name": "Will", + "name": "Beasley, Will", + "type": "personal" + } + }, + { + "affiliations": [ + { + "id": "05dq2gs74", + "name": "Vanderbilt University Medical Center" + } + ], + "person_or_org": { + "family_name": "Gray", + "given_name": "Will", + "name": "Gray, Will", + "type": "personal" + } + }, + { + "affiliations": [ + { + "id": "05dq2gs74", + "name": "Vanderbilt University Medical Center" + } + ], + "person_or_org": { + "family_name": "Hsi-Nien", + "given_name": "Tan Jubilee", + "name": "Hsi-Nien, Tan Jubilee", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Kennedy", + "given_name": "Nick", + "name": "Kennedy, Nick", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Sophia", + "name": "Sophia", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Lehr", + "given_name": "Marcus", + "name": "Lehr, Marcus", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Horner", + "given_name": "Jeffrey", + "name": "Horner, Jeffrey", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Chase", + "given_name": "Philip", + "name": "Chase, Philip", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "Lane", + "given_name": "Steve", + "name": "Lane, Steve", + "type": "personal" + } + }, + { + "person_or_org": { + "family_name": "johnson-bradley", + "name": "johnson-bradley", + "type": "personal" + } + }, + { + "affiliations": [ + { + "name": "Social Research Centre" + } + ], + "person_or_org": { + "family_name": "Tobias", + "given_name": "Paddy", + "name": "Tobias, Paddy", + "type": "personal" + } + } + ], + "description": "
    \n
  • Patch to date range handling that was breaking on new REDCap projects since version 14.0.2 of the REDCap server.
    • \n
  • Improved speed / memory usage for empty row exclusion.
    • \n
  • Checkbox field labels now follow the pattern '[field_label] (choice=[choice_label])'
    • \n
  • Fixed checkbox handling to be consistent with data export tool.
    • \n
  • Added skip_validation list to complement raw_cast.
    • \n
  • Extends casting and validation to text fields validated with the BioPortal Ontology service.
    • \n
  • Extends casting and validation to sql fields.
    • \n
  • Adds valSkip, allowing for validation to be skipped for a field type.
    • \n
  • Adds castLogical casting function.
    • \n
  • Adds four vignettes for getting started with using unlockREDCap and exportRecordsTyped.
    • \n
  • Added helper function changedRecords.
    • \n
  • Added assembleCodebook, which mimics the codebook in the REDCap UI in the form of a data frame.
    • \n
  • New functions for project management: createRedcapProject, exportProjectXml
    • \n
  • Additional timeout trap for request retry strategy.
    • \n
  • Reports of data failing validation checks now include a link to the form with the failing data.
    • \n
  • Major cleanup to remove messages on successful function execution. Many return values are changed to be consistent and be TRUE/FALSE if possible.
    • \n
  • Bug fix: The repeat_instance argument of exportFiles is now included in the API call.
    • \n
  • New Vignette: vignette("redcapAPI-offline-connection")
    • \n
  • Adds exportFilesMultiple to facilitate exporting multiple files in a familiar interface.
    • \n
  • Bug fix: Batching records no longer has the potential to produce duplicated records when a record ID has data in multiple events. (See Issue 262)
    • \n
  • Extends preserveProject and adds readPreservedProject to assist with preparing data for offline users.
    • \n
", + "publication_date": "2024-01-24", + "publisher": "Zenodo", + "related_identifiers": [ + { + "identifier": "https://github.com/vubiostat/redcapAPI/tree/v2.8.3", + "relation_type": { + "id": "issupplementto", + "title": { + "de": "Erg\u00e4nzt", + "en": "Is supplement to" + } + }, + "resource_type": { + "id": "software", + "title": { + "de": "Software", + "en": "Software" + } + }, + "scheme": "url" + } + ], + "resource_type": { + "id": "software", + "title": { + "de": "Software", + "en": "Software" + } + }, + "rights": [ + { + "description": { + "en": "The Creative Commons Attribution license allows re-distribution and re-use of a licensed work on the condition that the creator is appropriately credited." + }, + "icon": "cc-by-icon", + "id": "cc-by-4.0", + "props": { + "scheme": "spdx", + "url": "https://creativecommons.org/licenses/by/4.0/legalcode" + }, + "title": { + "en": "Creative Commons Attribution 4.0 International" + } + } + ], + "title": "vubiostat/redcapAPI: v2.8.3", + "version": "v2.8.3" + }, + "parent": { + "access": { + "grants": [], + "links": [], + "owned_by": { + "user": 1058504 + }, + "settings": { + "accept_conditions_text": null, + "allow_guest_requests": false, + "allow_user_requests": false, + "secret_link_expiration": 0 + } + }, + "communities": {}, + "id": "10564836", + "pids": { + "doi": { + "client": "datacite", + "identifier": "10.5281/zenodo.10564836", + "provider": "datacite" + } + } + }, + "pids": { + "doi": { + "client": "datacite", + "identifier": "10.5281/zenodo.10564837", + "provider": "datacite" + }, + "oai": { + "identifier": "oai:zenodo.org:10564837", + "provider": "oai" + } + }, + "revision_id": 10, + "stats": { + "all_versions": { + "data_volume": 0.0, + "downloads": 0, + "unique_downloads": 0, + "unique_views": 1, + "views": 5 + }, + "this_version": { + "data_volume": 0.0, + "downloads": 0, + "unique_downloads": 0, + "unique_views": 1, + "views": 5 + } + }, + "status": "published", + "updated": "2024-01-24T20:04:12.102127+00:00", + "versions": { + "index": 1, + "is_latest": true, + "is_latest_draft": true + } +} From 8d709c4ad1f81f2cf98ce90811d18baee0dc0abd Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 16:36:17 -0600 Subject: [PATCH 022/155] Added proper encoding detection #290 #297 #314 --- R/makeApiCall.R | 5 +++-- tests/testthat/test-050-makeApiCall.R | 9 +++++++++ 2 files changed, 12 insertions(+), 2 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 635eef74..5ebbcffc 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -262,8 +262,9 @@ makeApiCall <- function(rcon, # Helper function to convert responses to character strings without crashing. as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) { - enc <- x$headers[["Content-Type"]] - if(is.null(enc)) enc <- 'UTF-8' + enc <- if(grepl("charset", x$headers[["Content-Type"]])) + toupper(sub(".*charset=", "", x$headers[["Content-Type"]])) else + 'ISO-8859-1' # [Default if unspecified](https://www.w3.org/International/articles/http-charset/index) mapped <- iconv(readBin(x$content, character()), enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 6f67dd8b..f7c1562b 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -179,6 +179,7 @@ test_that( "as.data.frame.response handles invalid encoded characters", { x <- list(content=charToRaw("fa\xE7il,joe\n1,2\xE7\n3,4")) + x[['headers']] <- list('Content-Type'='text/csv; charset=utf-8') class(x) <- c("response","list") expect_warning({y <- redcapAPI:::as.data.frame.response(x)}, "invalid characters") @@ -186,5 +187,13 @@ test_that( y, data.frame(fa.il=as.integer(c(1,3)), joe=c("2\U25a1","4")) ) + + x[['headers']] <- list('Content-Type'='text/csv') # defaults to latin + expect_silent({y <- redcapAPI:::as.data.frame.response(x)}) + expect_equal( + y, + data.frame(façil=as.integer(c(1,3)), joe=c("2ç","4")) + ) + } ) \ No newline at end of file From 66118b23582458c529a39ea635e69413fb219efc Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 24 Jan 2024 17:09:16 -0600 Subject: [PATCH 023/155] Improved gsub robustness #290 #291 #314 --- R/makeApiCall.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 5ebbcffc..fcd21da5 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -263,7 +263,7 @@ makeApiCall <- function(rcon, as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) { enc <- if(grepl("charset", x$headers[["Content-Type"]])) - toupper(sub(".*charset=", "", x$headers[["Content-Type"]])) else + toupper(sub('.*charset=([^;]+).*', '\\1', x$headers[["Content-Type"]])) else 'ISO-8859-1' # [Default if unspecified](https://www.w3.org/International/articles/http-charset/index) mapped <- iconv(readBin(x$content, character()), enc, 'UTF-8', '\U25a1') From 0e10d09f62c6a12e5ce752b2a0b5ffdb27cc3ff8 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 10:36:22 -0600 Subject: [PATCH 024/155] Updated README to open source software standards --- README.md | 108 ++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 81 insertions(+), 27 deletions(-) diff --git a/README.md b/README.md index cd0fe97d..020f96dd 100644 --- a/README.md +++ b/README.md @@ -2,10 +2,26 @@ [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.10564837.svg)](https://doi.org/10.5281/zenodo.10564837) ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) +[![License: GPL v2](https://img.shields.io/badge/License-GPL_v2-blue.svg)](https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html) redcapAPI ====== +`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. It's design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory in R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. + +Core concerns that handled by the library: + +* API_KEY (which is equivalent of username/password to ones data!) secure handling practices are designed to be as seamless as possible via `unlockREDCap`. There are override methods available for production environments. +* Retry strategy with exponential back off. When a REDCap server or a network is overload requests can fail. Each call to the API will retry multiple times, and it doubles the wait time between each all. This dramatically increases the odds of success for a script with multiple API calls to REDCap. +* Automatically handles and caches meta data information needed to understand and translate a projects data. +* A robust type casting strategy that every step of the process can be overridden by the user via inversion of control. The strategy proceeds as follows: + * NA detection per REDCap definition of NA. + * Validation of data versus the target type/class. `reviewInvalidRecords` provides a summary report of all data that fails validation, with hot links to the record in question. This is an important step. Data that does not match the target format cannot be cast, e.g. "xyz" cannot be treated as a numeric and will become NA in the final dataset. + * Final type casting to target type. +* Sparse block matrix splitting into forms/instruments with filtering of empty rows. +* Additional helper functions, e.g. longitudinal wider/long conversions, guessing if a character field is actually a date, and SAS exports. +* Importing data reuses a lot of the casting functions in reverse to ensure data integrity. + ## Quick Start Guide There are 2 basic functions that are key to understanding the major changes with this version: @@ -29,28 +45,37 @@ exportBulkRecords(list(db = rcon), envir = globalenv()) ``` -The `` is a reference for whatever you wish to call this REDCap project. The `rcon` is the variable you wish to assign it too. The keyring is a name for this key ring. If one uses `'API_KEYs'` for all your projects, you'll have one big keyring for all your API_KEYs locally encrypted. The url is the standard url for the api. The `passwordFUN` specified is an override if one is using RStudio. It's not required, but on a Mac this is the only option that works well. The `envir` call is where to write the connection object; if not specified the call will return a list. +The `` is a reference for whatever you wish to call this REDCap project. The `rcon` is the variable you wish to assign it too. The keyring is a name for this key ring. If one uses `'API_KEYs'` for all your projects, you'll have one big keyring for all your API_KEYs locally encrypted. The url is the standard url for the api at your institution. The `envir` call is where to write the connection object; if not specified the call will return a list. + +The next call to `exportBulkRecords`, says to export by form and leave out records not filled out and columns not part of a form. The first argument is specifying a `db` reference to the connection opened and naming it the same thing. The second call is saying for this connection export back the all the forms/instruments present in that `db`, if this is left blank it defaults to all forms/instruments. The `envir` has it writing it back to the global environment as variables. Any parameter not recognized is passed to the `exportRecordsTyped` call--for every REDCap database connection. For most analysis projects the function `exportBulkRecords` provides the functionality required to get the data in memory, converted, type cast and sparse block matrix split into forms/instruments with blank rows filtered out. -The next call to `exportBulkRecords`, says to export by form and leave out records not filled out and columns not part of a form. The first argument is specifying a `db` reference to the connection opened and naming it the same thing. The second call is saying for this connection export back the all the forms present in that `db`. The `envir` has it writing it back to the global environment as variables. Any parameter not recognized is passed to the `exportRecordsTyped` call. +These two calls will handle most analysis requests. To truly understand all these changes see: `vignette("redcapAPI-best-practices")`. -These two calls will handle most analysis requests. To truly understand all these changes see: `vignette("redcapAPI-best-practices")`. +### 2.7.0+ -## All Vignettes +2.7.0 includes `exportRecordsTyped` which is a major move forward for the package. It replaces `exportRecords` with a far more stable and dependable call. It includes retries with exponential backoff through the connection object. It has inversion of control over casting, and has a useful validation report attached when things fail. It is worth the time to convert calls to `exportRecords` to `exportRecordsTyped` and begin using this new routine. It is planned that in the next year `exportRecords` will be removed from the package. -* redcapAPI-casting-data Casting Data -* redcapAPI-data-validation Data Validation -* redcapAPI-getting-started-connecting Connecting to REDCap -* redcapAPI-missing-data-detection Missing Data Detection -* redcapAPI-best-practices Best Practices -* redcapAPI-offline-connection Offline Connections +## Community Guidelines -## 2.7.0+ +This package exists to serve the research community and would not exist without community support. We are interested in volunteers who would like to translate the documentation into other languages. -2.7.0 includes `exportRecordsTyped` which is a major move forward for the package. It replaces `exportRecords` with a far more stable and dependable call. It includes retries with exponential backoff through the connection object. It has inversion of control over casting, and has a useful validation report attached when things fail. It is worth the time to convert calls to `exportRecords` to `exportRecordsTyped` and begin using this new routine. It is planned that in the next year `exportRecords` will be removed from the package. +### Contribute + +If you wish to contribute new features to this software, we are open to [pull requests](https://github.com/vubiostat/redcapAPI/pulls). Before doing a lot of work, it would be best to open [issue](https://github.com/vubiostat/redcapAPI/issues) for discussion about your +idea. + +#### Coding Style Guideline Note -## Troubleshooting Exports +- Exported function names: dromedaryCase +- Internal function names: .dromedaryCase +- Constant data exported: UPPERCASE +- Function parameters: snake_case +- Function variables: snake_case +- - (exception) data.frame variable: CamelCase -REDCap and it's API have a large number of options and choices, with such complexity the possibility of bugs increases as well. This is a checklist of troubleshooting exports. +### Report Issues or Problems + +REDCap and it's API have a large number of options and choices, with such complexity the possibility of bugs increases as well. This is a checklist for troubleshooting exports. 1. Does `Rec <- exportRecordsTyped(rcon)` give you a warning about data that failed validations? If so, what kind of content are you seeing from `reviewInvalidRecords(Rec)`? 2. What is returned by `exportRecordsTyped(rcon, validation = skip_validation, cast = raw_cast)`? This is a completely raw export with no processing by the library. @@ -61,26 +86,55 @@ REDCap and it's API have a large number of options and choices, with such comple 7. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. +### Seek Support + +If you need help or assistance in understanding how to approach a project or problem using the library, please open an [issue](https://github.com/vubiostat/redcapAPI/issues). We use these questions to refine the documentation. Thus asking questions contributes to refinement of documentation. + +## Documentation + +Your institutions installation of REDCap contains a lot of documentation for the general usage of REDCap. For general questions outside the scope of interfacing the API to R please refer to your institutions REDCap instance documentation. + +The help pages for functions is fairly extensive. Try `?exportRecordsTyped` or `?fieldValidationAndCasting` for good starting points into the help pages. + +### All Vignettes + +There are several vignettes with helpful information and examples to explore. These provide higher level views than can be provided in help pages. + +* redcapAPI-casting-data +* redcapAPI-data-validation +* redcapAPI-getting-started-connecting +* redcapAPI-missing-data-detection +* redcapAPI-best-practices +* redcapAPI-offline-connection + ## Back Matter *NOTE*: Ownership transfer of this package to VUMC Biostatistics is complete. -The research community owes a big thanks to [Benjamin Nutter](https://github.com/nutterb/redcapAPI) -for his years of service keeping this package current. +The research community owes a big thanks to [Benjamin Nutter](https://github.com/nutterb/redcapAPI) for his years of service keeping this package current. -The package `redcapAPI` is an R interface to REDCap (https://www.projectredcap.org/), originally created by [Jeffrey Horner](https://github.com/jeffreyhorner). +This package was originally created by [Jeffrey Horner](https://github.com/jeffreyhorner). -Please read the documentation on your institutions REDCap installation. +The current package was developed under REDCap Version 14+. Institutions can be a little behind on updating REDCap and so some features of the API may not always work. -Issues may be reported at [Issues](https://github.com/vubiostat/redcapAPI/issues) +### License -This package was developed under REDCap Version 13.8.2. Institutions can be a little behind on updating REDCap and so some features of the API may not always work. +redcapAPI A rich API client for interfacing REDCap to R +Copyright (C) 2012 Jeffrey Horner, Vanderbilt University Medical Center +Copyright (C) 2013-2022 Benjamin Nutter +Copyright (C) 2023-2024 Benjamin Nutter, Shawn Garbett, Vanderbilt University Medical Center -### Coding Style Guideline Note +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. + +This program is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with this program; if not, write to the Free Software +Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. -- Exported function names: dromedaryCase -- Internal function names: .dromedaryCase -- Constant data exported: UPPERCASE -- Function parameters: snake_case -- Function variables: snake_case -- - (exception) data.frame variable: CamelCase From 6e0a77ca16fb3da8c2630baab9936232d4f693b4 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 10:45:20 -0600 Subject: [PATCH 025/155] Minor editing of README --- README.md | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 020f96dd..fc396472 100644 --- a/README.md +++ b/README.md @@ -7,9 +7,9 @@ redcapAPI ====== -`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. It's design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory in R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. +`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory in R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. -Core concerns that handled by the library: +Core concerns handled by the library: * API_KEY (which is equivalent of username/password to ones data!) secure handling practices are designed to be as seamless as possible via `unlockREDCap`. There are override methods available for production environments. * Retry strategy with exponential back off. When a REDCap server or a network is overload requests can fail. Each call to the API will retry multiple times, and it doubles the wait time between each all. This dramatically increases the odds of success for a script with multiple API calls to REDCap. @@ -120,8 +120,11 @@ The current package was developed under REDCap Version 14+. Institutions can be ### License redcapAPI A rich API client for interfacing REDCap to R + Copyright (C) 2012 Jeffrey Horner, Vanderbilt University Medical Center + Copyright (C) 2013-2022 Benjamin Nutter + Copyright (C) 2023-2024 Benjamin Nutter, Shawn Garbett, Vanderbilt University Medical Center This program is free software; you can redistribute it and/or From 8dcbecd52a261f15169d16364f2c5416f0c00bb4 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 10:49:17 -0600 Subject: [PATCH 026/155] README links updated --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index fc396472..3da7ebaf 100644 --- a/README.md +++ b/README.md @@ -109,9 +109,9 @@ There are several vignettes with helpful information and examples to explore. Th ## Back Matter -*NOTE*: Ownership transfer of this package to VUMC Biostatistics is complete. +*NOTE*: Ownership transfer of this package to [VUMC Biostatistics](https://www.vumc.org/biostatistics/vanderbilt-department-biostatistics) is complete. -The research community owes a big thanks to [Benjamin Nutter](https://github.com/nutterb/redcapAPI) for his years of service keeping this package current. +The research community owes a big thanks to [Benjamin Nutter](https://github.com/nutterb/) for his years of service keeping this package current. This package was originally created by [Jeffrey Horner](https://github.com/jeffreyhorner). From 4e69084ae56950e13af73dafcd8d9be68d0c3cd7 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 11:56:44 -0600 Subject: [PATCH 027/155] Previous patch missed some cases, #290 #297 #314 --- R/exportFileRepositoryListing.R | 8 ++------ R/exportMetaData.R | 13 ++++--------- R/exportRecords.R | 27 +++++---------------------- R/exportSurveyParticipants.R | 6 +----- 4 files changed, 12 insertions(+), 42 deletions(-) diff --git a/R/exportFileRepositoryListing.R b/R/exportFileRepositoryListing.R index 233f21dc..996a50a3 100644 --- a/R/exportFileRepositoryListing.R +++ b/R/exportFileRepositoryListing.R @@ -148,12 +148,8 @@ exportFileRepositoryListing.redcapApiConnection <- function(rcon, # If folder_id has length 0, set the parent to top-level parent <- if (length(folder_id) == 0) 0 else folder_id - - response <- as.character(response) - if (nchar(response) > 0){ - response <- utils::read.csv(text = response, - stringsAsFactors = FALSE, - na.strings = "") + if (length(response$content) > 0){ + response <- as.data.frame(response) response$parent_folder <- rep(parent, nrow(response)) } else { diff --git a/R/exportMetaData.R b/R/exportMetaData.R index 0652b84f..ae50a7bf 100644 --- a/R/exportMetaData.R +++ b/R/exportMetaData.R @@ -87,13 +87,8 @@ exportMetaData.redcapApiConnection <- function(rcon, } # Post processing ------------------------------------------------- - response <- as.character(response) - if (drop_utf8) - { - response <- iconv(response, "utf8", "ASCII", sub = "") - } - - utils::read.csv(text = response, - stringsAsFactors = FALSE, - na.strings = "") + + # FIXME: drop_utf8 is automatic in the conversion to data frame, i.e. they become "." in R + # Is this flag still needed? + as.data.frame(response) } diff --git a/R/exportRecords.R b/R/exportRecords.R index 52cd03ef..027bb03e 100644 --- a/R/exportRecords.R +++ b/R/exportRecords.R @@ -331,13 +331,7 @@ unbatched <- function(rcon, body, id, colClasses, error_handling, config) if (response$status_code != 200) redcapError(response, error_handling = error_handling) - response <- as.character(response) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # x <- iconv(x, "utf8", "ASCII", sub = "") - utils::read.csv(text = response, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses) + as.data.frame(response, colClasses=colClasses) } @@ -368,14 +362,8 @@ batched <- function(rcon, body, batch.size, id, colClasses, error_handling, conf if (IDs$status_code != 200) redcapError(IDs, error_handling) - IDs <- as.character(IDs) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # IDs <- iconv(IDs, "utf8", "ASCII", sub = "") - IDs <- utils::read.csv(text = IDs, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses[id]) - + IDs <- as.data.frame(IDs, colClasses = colClasses[id]) + #* 2. Restrict to unique IDs unique_id <- unique(IDs[[id]]) @@ -408,13 +396,8 @@ batched <- function(rcon, body, batch.size, id, colClasses, error_handling, conf if (this_response$status_code != 200) redcapError(this_response, error_handling = "error") - this_response <- as.character(this_response) - # probably not necessary for data. Useful for meta data though. (See Issue #99) - # x <- iconv(x, "utf8", "ASCII", sub = "") - batch_list[[i]] <- utils::read.csv(text = this_response, - stringsAsFactors = FALSE, - na.strings = "", - colClasses = colClasses) + batch_list[[i]] <- as.data.frame(this_response, colClasses = colClasses) + Sys.sleep(1) } diff --git a/R/exportSurveyParticipants.R b/R/exportSurveyParticipants.R index 6a26091e..18d1285e 100644 --- a/R/exportSurveyParticipants.R +++ b/R/exportSurveyParticipants.R @@ -89,9 +89,5 @@ exportSurveyParticipants.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - SurveyParticipant <- utils::read.csv(textConnection(as.character(response)), - stringsAsFactors=FALSE, - na.strings="") - - return(SurveyParticipant) + as.data.frame(response) } From 589fa21e6068c650bf5a59c78b163c3bb26441da Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 14:12:56 -0600 Subject: [PATCH 028/155] Removed cleanseMetaData and drop_utf8 flag #290 #297 #314 --- R/cleanseMetaData.R | 75 ----------------------------------------- R/docsMetaDataMethods.R | 5 +-- R/exportMetaData.R | 11 +----- man/cleanseMetaData.Rd | 31 ----------------- man/metaDataMethods.Rd | 4 --- 5 files changed, 2 insertions(+), 124 deletions(-) delete mode 100644 R/cleanseMetaData.R delete mode 100644 man/cleanseMetaData.Rd diff --git a/R/cleanseMetaData.R b/R/cleanseMetaData.R deleted file mode 100644 index dc139f3b..00000000 --- a/R/cleanseMetaData.R +++ /dev/null @@ -1,75 +0,0 @@ -#' @name cleanseMetaData -#' @title Clean Meta Data of UTF Characters -#' -#' @description There have been isolated cases observed where certain -#' characters in the data dictionary prevent it from being downloaded -#' correctly. In one case, the data dictionary could not be downloaded -#' at all through the API. It is suspected that these problematic -#' characters are a result of copying and pasting text out of word -#' processing programs. The problematic characters are not necessarily -#' visible and their exact location can be difficult to identify. As -#' a last resort, `cleanseMetaData` can read a meta data file -#' downloaded through the user interface, purge it of any UTF-8 characters, -#' and write an alternate data dictionary that contains only ASCII -#' characters. -#' -#' @param meta_data_file `character(1)` the path to a meta data file -#' that has been downloaded using the REDCap user interface. -#' @param meta_data_clean `character(1)` the path of the file to which -#' the cleaned meta data will be written. -#' @param overwrite `logical(1)` Permit the new file to overwrite an -#' existing file. -#' - -cleanseMetaData <- function(meta_data_file, meta_data_clean, - overwrite = FALSE) -{ - message("cleanseMetaData will be removed in version 3.0.0") - coll <- checkmate::makeAssertCollection() - - checkmate::assert_character(x = meta_data_file, - len = 1, - add = coll) - - checkmate::assert_character(x = meta_data_clean, - len = 1, - add = coll) - - checkmate::reportAssertions(coll) - - if (!file.exists(meta_data_file)){ - coll$push(sprintf("File not found: %s", meta_data_file)) - } - - if (file.exists(meta_data_clean) && !overwrite){ - coll$push(sprintf("File exists and overwrite is set to FALSE: %s", - meta_data_clean)) - } - - if (meta_data_clean == meta_data_file){ - coll$push(sprintf("%s %s", - "Sorry. I will not allow you to overwrite your file. ", - "Please use a different path for 'meta_data_clean.")) - } - - checkmate::reportAssertions(coll) - - if (file.exists(meta_data_clean) && overwrite){ - warning("Attempting to overwrite ", meta_data_clean) - } - - dd <- readLines(meta_data_file) - dd <- paste0(dd, collapse = "\n") - dd <- iconv(dd, - from = "utf8", - to = "ASCII", - sub = "") - - dd <- utils::read.csv(text = dd, - stringsAsFactors = FALSE) - - utils::write.csv(dd, - meta_data_clean, - row.names = FALSE, - na = "") -} diff --git a/R/docsMetaDataMethods.R b/R/docsMetaDataMethods.R index eefc341a..b0bed41a 100644 --- a/R/docsMetaDataMethods.R +++ b/R/docsMetaDataMethods.R @@ -22,8 +22,6 @@ #' when validating the `field_type` column. This #' @param validation_types `character` giving the acceptable values #' for the `text_validation_or_show_slider_number` column. -#' @param drop_utf8 `logical(1)`. When `TRUE`, non-ASCII characters -#' will be replaced with empty characters. #' #' @details #' When importing meta data, the following conditions apply: @@ -122,8 +120,7 @@ metaDataMethodsArgs <- function(rcon, fields, forms, data, - refresh, - drop_utf8, + refresh, ..., field_types, validation_types, diff --git a/R/exportMetaData.R b/R/exportMetaData.R index ae50a7bf..22b5f2e6 100644 --- a/R/exportMetaData.R +++ b/R/exportMetaData.R @@ -14,7 +14,6 @@ exportMetaData.redcapApiConnection <- function(rcon, fields = character(0), forms = character(0), ..., - drop_utf8 = FALSE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list()){ @@ -30,11 +29,7 @@ exportMetaData.redcapApiConnection <- function(rcon, checkmate::assert_character(x = forms, add = coll) - - checkmate::assert_logical(x = drop_utf8, - len = 1, - add = coll) - + error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -86,9 +81,5 @@ exportMetaData.redcapApiConnection <- function(rcon, error_handling = error_handling) } - # Post processing ------------------------------------------------- - - # FIXME: drop_utf8 is automatic in the conversion to data frame, i.e. they become "." in R - # Is this flag still needed? as.data.frame(response) } diff --git a/man/cleanseMetaData.Rd b/man/cleanseMetaData.Rd deleted file mode 100644 index 2faedea8..00000000 --- a/man/cleanseMetaData.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cleanseMetaData.R -\name{cleanseMetaData} -\alias{cleanseMetaData} -\title{Clean Meta Data of UTF Characters} -\usage{ -cleanseMetaData(meta_data_file, meta_data_clean, overwrite = FALSE) -} -\arguments{ -\item{meta_data_file}{\code{character(1)} the path to a meta data file -that has been downloaded using the REDCap user interface.} - -\item{meta_data_clean}{\code{character(1)} the path of the file to which -the cleaned meta data will be written.} - -\item{overwrite}{\code{logical(1)} Permit the new file to overwrite an -existing file.} -} -\description{ -There have been isolated cases observed where certain -characters in the data dictionary prevent it from being downloaded -correctly. In one case, the data dictionary could not be downloaded -at all through the API. It is suspected that these problematic -characters are a result of copying and pasting text out of word -processing programs. The problematic characters are not necessarily -visible and their exact location can be difficult to identify. As -a last resort, \code{cleanseMetaData} can read a meta data file -downloaded through the user interface, purge it of any UTF-8 characters, -and write an alternate data dictionary that contains only ASCII -characters. -} diff --git a/man/metaDataMethods.Rd b/man/metaDataMethods.Rd index 5739f5be..d5a73a16 100644 --- a/man/metaDataMethods.Rd +++ b/man/metaDataMethods.Rd @@ -19,7 +19,6 @@ importMetaData(rcon, data, ...) fields = character(0), forms = character(0), ..., - drop_utf8 = FALSE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list() @@ -54,9 +53,6 @@ dictionary, and not the display names shown on the web interface.} \item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached metadata and instruments will be refreshed after the import.} -\item{drop_utf8}{\code{logical(1)}. When \code{TRUE}, non-ASCII characters -will be replaced with empty characters.} - \item{...}{Arguments to pass to other methods} \item{field_types}{\code{character} giving the acceptable field types From 11da0f83be419720da14086dcafa5f42bfa6aacd Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 15:30:01 -0600 Subject: [PATCH 029/155] Updated CITATION to new DOI --- inst/CITATION | 19 ++++++++++++++++--- 1 file changed, 16 insertions(+), 3 deletions(-) diff --git a/inst/CITATION b/inst/CITATION index 042011c7..5832d8a7 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -3,8 +3,21 @@ note <- sprintf("R package version %s", meta$Version) bibentry(bibtype = "Manual", title = "{redcapAPI}: Accessing data from REDCap projects using the API", - author = c(person("Benjamin", "Nutter"), person("Stephen", "Lane")), + author = c( + person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", + role = c("ctb", "aut")), + person("Shawn", "Garbett", email = "shawn.garbett@vumc.org", + comment = c(ORCID="0000-0003-4079-5621"), + role = c("cre","ctb")), + person("Stephen", "Lane", role = "ctb"), + person("Will", "Beasley", role = "ctb"), + person("Jeffrey", "Horner", role = "aut"), + person("Will", "Gray", role = "ctb"), + person("Jeremy", "Stephens", role = "ctb"), + person("Marcus", "Lehr", role = "ctb", email = "marcus.j.lehr@gmail.com"), + person("Cole", "Beck", role = "ctb"), + person("Savannah", "Obregon", role = "ctb")), year = year, - doi = "10.5281/zenodo.11826", + doi = "10.5281/zenodo.10564837", note = note, - url = "https://github.com/nutterb/redcapAPI/wiki") + url = "https://github.com/vubiostat/redcapAPI") From a970fe88935067b69a9af6c1cba313f10d6725b4 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 25 Jan 2024 15:40:49 -0600 Subject: [PATCH 030/155] Updated author list to match commit history as best as possible --- DESCRIPTION | 17 ++++++++++++----- inst/CITATION | 14 +++++++++++--- man/redcapAPI.Rd | 11 +++++++++-- 3 files changed, 32 insertions(+), 10 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0fda6fd0..9a67f5a2 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -3,19 +3,26 @@ Type: Package Title: Interface to 'REDCap' Version: 2.8.4 Authors@R: c( + person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", + role = c("ctb", "aut")), person("Shawn", "Garbett", email = "shawn.garbett@vumc.org", comment = c(ORCID="0000-0003-4079-5621"), role = c("cre","ctb")), - person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", - role = c("ctb", "aut")), + person("Savannah", "Obregon", role = "ctb"), + person("Thomas", "Obadia", role="ctb"), + person("Marcus", "Lehr", role = "ctb", email = "marcus.j.lehr@gmail.com"), + person("Brian", "High", role="ctb"), person("Stephen", "Lane", role = "ctb"), person("Will", "Beasley", role = "ctb"), - person("Jeffrey", "Horner", role = "aut"), person("Will", "Gray", role = "ctb"), + person("Nick", "Kennedy", role = "ctb"), + person("Tan", "Hsi-Nien", role = "ctb"), + person("Jeffrey", "Horner", role = "aut"), person("Jeremy", "Stephens", role = "ctb"), - person("Marcus", "Lehr", role = "ctb", email = "marcus.j.lehr@gmail.com"), person("Cole", "Beck", role = "ctb"), - person("Savannah", "Obregon", role = "ctb")) + person("Bradley", "Johnson", role="ctb"), + person("Philip", "Chase", role="ctb"), + person("Paddy", "Tobias", role = "ctb")) Maintainer: Shawn Garbett Description: Access data stored in 'REDCap' databases using the Application Programming Interface (API). 'REDCap' (Research Electronic Data CAPture; diff --git a/inst/CITATION b/inst/CITATION index 5832d8a7..35d060a7 100644 --- a/inst/CITATION +++ b/inst/CITATION @@ -9,14 +9,22 @@ bibentry(bibtype = "Manual", person("Shawn", "Garbett", email = "shawn.garbett@vumc.org", comment = c(ORCID="0000-0003-4079-5621"), role = c("cre","ctb")), + person("Savannah", "Obregon", role = "ctb"), + person("Thomas", "Obadia", role="ctb"), + person("Marcus", "Lehr", role = "ctb", email = "marcus.j.lehr@gmail.com"), + person("Brian", "High", role="ctb"), person("Stephen", "Lane", role = "ctb"), person("Will", "Beasley", role = "ctb"), - person("Jeffrey", "Horner", role = "aut"), person("Will", "Gray", role = "ctb"), + person("Nick", "Kennedy", role = "ctb"), + person("Tan", "Hsi-Nien", role = "ctb"), + person("Jeffrey", "Horner", role = "aut"), person("Jeremy", "Stephens", role = "ctb"), - person("Marcus", "Lehr", role = "ctb", email = "marcus.j.lehr@gmail.com"), person("Cole", "Beck", role = "ctb"), - person("Savannah", "Obregon", role = "ctb")), + person("Bradley", "Johnson", role="ctb"), + person("Philip", "Chase", role="ctb"), + person("Paddy", "Tobias", role = "ctb") + ), year = year, doi = "10.5281/zenodo.10564837", note = note, diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 96359b8b..8dd7f7c1 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -40,13 +40,20 @@ Authors: Other contributors: \itemize{ + \item Savannah Obregon [contributor] + \item Thomas Obadia [contributor] + \item Marcus Lehr \email{marcus.j.lehr@gmail.com} [contributor] + \item Brian High [contributor] \item Stephen Lane [contributor] \item Will Beasley [contributor] \item Will Gray [contributor] + \item Nick Kennedy [contributor] + \item Tan Hsi-Nien [contributor] \item Jeremy Stephens [contributor] - \item Marcus Lehr \email{marcus.j.lehr@gmail.com} [contributor] \item Cole Beck [contributor] - \item Savannah Obregon [contributor] + \item Bradley Johnson [contributor] + \item Philip Chase [contributor] + \item Paddy Tobias [contributor] } } From 8959b294ac75caa37cae532d520c831d4a58756d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 09:16:14 -0600 Subject: [PATCH 031/155] Fixed test 201 setup for repeatability --- tests/testthat/test-201-exportTypedRecords-withDAGs.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-201-exportTypedRecords-withDAGs.R b/tests/testthat/test-201-exportTypedRecords-withDAGs.R index 20a1bd32..b28f46e6 100644 --- a/tests/testthat/test-201-exportTypedRecords-withDAGs.R +++ b/tests/testthat/test-201-exportTypedRecords-withDAGs.R @@ -16,10 +16,11 @@ ImportData <- castForImport(ImportData, ##################################################################### # Create DAGs to use in testing #### -importDags(rcon, - data = data.frame(data_access_group_name = c("Test DAG 1", - "Test DAG 2"), - unique_group_name = rep(NA_character_, 2))) +if(!"test_dag_1" %in% rcon$dags()$unique_group_name) + importDags(rcon, + data = data.frame(data_access_group_name = c("Test DAG 1", + "Test DAG 2"), + unique_group_name = rep(NA_character_, 2))) ImportData$redcap_data_access_group <- rep(rcon$dags()$unique_group_name, length.out = nrow(ImportData)) From abd45b8d41559466c7475a60a4ff579e7187288b Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 10:22:32 -0600 Subject: [PATCH 032/155] Yet more cases overlooked #290 #297 #314 --- R/exportEvents.R | 7 ++----- R/exportRecordsTyped.R | 20 +++++++++++--------- 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/R/exportEvents.R b/R/exportEvents.R index 607ca00d..005bf1c3 100644 --- a/R/exportEvents.R +++ b/R/exportEvents.R @@ -83,9 +83,6 @@ exportEvents.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) - if (trimws(as.character(response)) == ""){ - REDCAP_EVENT_STRUCTURE - } else { - as.data.frame(response) - } + response <- as.data.frame(response) + if(nrow(response) == 0) REDCAP_EVENT_STRUCTURE else as.data.frame(response) } diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index bbc1b90c..54a78937 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -655,14 +655,13 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, error_handling = error_handling) } - if (trimws(as.character(response)) == ""){ - message("No data found in the project.") - return(data.frame()) - } + response <- as.data.frame(response, + colClasses = "character", + sep = csv_delimiter) + + if (nrow(response) == 0) message("No data found in the project.") - as.data.frame(response, - colClasses = "character", - sep = csv_delimiter) + response } # .exportRecordsTyped_Batched --------------------------------------- @@ -692,12 +691,15 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, error_handling = error_handling) } - if (trimws(as.character(record_response)) == ""){ + records <- as.data.frame(record_response, sep = csv_delimiter) + + if (nrow(record_response) == 0) + { message("No data found in the project.") return(data.frame()) } - records <- as.data.frame(record_response, sep = csv_delimiter) + records <- unique(records[[target_field]]) } From df324631f46b64318f19b917d8d3092bc1cb09b2 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 11:19:45 -0600 Subject: [PATCH 033/155] More tweaks to get working again #290 #297 #314 --- R/exportEvents.R | 2 +- R/makeApiCall.R | 18 +++++++++++++----- R/purgeRestoreProject.R | 2 +- 3 files changed, 15 insertions(+), 7 deletions(-) diff --git a/R/exportEvents.R b/R/exportEvents.R index 005bf1c3..0dab358c 100644 --- a/R/exportEvents.R +++ b/R/exportEvents.R @@ -84,5 +84,5 @@ exportEvents.redcapApiConnection <- function(rcon, if (response$status_code != 200) return(redcapError(response, error_handling)) response <- as.data.frame(response) - if(nrow(response) == 0) REDCAP_EVENT_STRUCTURE else as.data.frame(response) + if(nrow(response) == 0) REDCAP_EVENT_STRUCTURE else response } diff --git a/R/makeApiCall.R b/R/makeApiCall.R index fcd21da5..e0a8fd9a 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -268,9 +268,17 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . mapped <- iconv(readBin(x$content, character()), enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") - utils::read.csv( - text = mapped, - stringsAsFactors = stringsAsFactors, - na.strings = na.strings, - ...) + + if(grepl('^\\s*$',mapped)) + { + data.frame() + } + else + { + utils::read.csv( + text = mapped, + stringsAsFactors = stringsAsFactors, + na.strings = na.strings, + ...) + } } diff --git a/R/purgeRestoreProject.R b/R/purgeRestoreProject.R index 3287071e..88654489 100644 --- a/R/purgeRestoreProject.R +++ b/R/purgeRestoreProject.R @@ -200,7 +200,7 @@ purgeProject.redcapApiConnection <- function(object, error_handling = error_handling, config = config) - if (nrow(RecordId)){ + if (nrow(RecordId)>0){ if ("redcap_event_name" %in% names(RecordId)){ RecordId$arm_num <- sub("^(.+)(arm_)(\\d+)$", "\\3", RecordId$redcap_event_name) From 9397330e3b618ceaa1250f0340e93288d4e54e11 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 11:37:12 -0600 Subject: [PATCH 034/155] Some trickery on detecting null response #290 #297 #314 --- R/exportRecordsTyped.R | 2 +- R/makeApiCall.R | 2 +- tests/testthat/test-201-exportTypedRecords-withDAGs.R | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 54a78937..354a6aef 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -693,7 +693,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, records <- as.data.frame(record_response, sep = csv_delimiter) - if (nrow(record_response) == 0) + if (nrow(records) == 0) { message("No data found in the project.") return(data.frame()) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index e0a8fd9a..90e5b12a 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -269,7 +269,7 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") - if(grepl('^\\s*$',mapped)) + if(grepl("^\\s*$", substr(x, 1, 80))) { data.frame() } diff --git a/tests/testthat/test-201-exportTypedRecords-withDAGs.R b/tests/testthat/test-201-exportTypedRecords-withDAGs.R index b28f46e6..b90400c0 100644 --- a/tests/testthat/test-201-exportTypedRecords-withDAGs.R +++ b/tests/testthat/test-201-exportTypedRecords-withDAGs.R @@ -42,7 +42,7 @@ test_that( DagRaw <- exportRecordsTyped(rcon, dag = TRUE, cast = list(system = castRaw)) - expect_equal(unique(DagRaw$redcap_data_access_group), + expect_equal(sort(unique(DagRaw$redcap_data_access_group)), c("test_dag_1", "test_dag_2")) } ) From 0858c7892f85887321e0461670008e256411b0f9 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 13:05:23 -0600 Subject: [PATCH 035/155] More tweaks to as.data.frame.response #290 #297 #314 --- R/makeApiCall.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 90e5b12a..2e263b96 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -269,7 +269,8 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") - if(grepl("^\\s*$", substr(x, 1, 80))) + if(grepl("^\\s*$", substr(mapped, 1, 10)) && + nchar(trimws(mapped,'left')) == 0) { data.frame() } From 5a384bd5c35e9a22398a8985a805d618b29d2aa8 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 13:11:07 -0600 Subject: [PATCH 036/155] Added comment on non-inuitive code purpose #290 #297 #314 --- R/makeApiCall.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 2e263b96..df751132 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -269,6 +269,8 @@ as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", . enc, 'UTF-8', '\U25a1') if(grepl('\U25a1', mapped)) warning("Project contains invalid characters. Mapped to '\U25a1'.") + # First check is very fast check to see if the first 10 bytes are empty space + # Second check is followup to see if it's entirely empty space (verify) if(grepl("^\\s*$", substr(mapped, 1, 10)) && nchar(trimws(mapped,'left')) == 0) { From 29f06bfccefd078b656e13e59edf760c76c6f2c5 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 29 Jan 2024 17:18:53 -0600 Subject: [PATCH 037/155] More cases from search #290 #297 #314 --- R/exportUserDagAssignments.R | 7 +++---- R/exportUserRoleAssignments.R | 6 ++---- R/exportUserRoles.R | 7 +++---- 3 files changed, 8 insertions(+), 12 deletions(-) diff --git a/R/exportUserDagAssignments.R b/R/exportUserDagAssignments.R index b60a4cb2..6fef64d0 100644 --- a/R/exportUserDagAssignments.R +++ b/R/exportUserDagAssignments.R @@ -61,9 +61,8 @@ exportUserDagAssignments.redcapApiConnection <- function(rcon, error_handling = error_handling) } - if (as.character(response) == ""){ - return(REDCAP_DAG_ASSIGNMENT_STRUCTURE) - } + response <- as.data.frame(response) - as.data.frame(response) + if(nrow(response) == 0) REDCAP_DAG_ASSIGNMENT_STRUCTURE else response + } diff --git a/R/exportUserRoleAssignments.R b/R/exportUserRoleAssignments.R index aca7b800..0d9afd69 100644 --- a/R/exportUserRoleAssignments.R +++ b/R/exportUserRoleAssignments.R @@ -60,9 +60,7 @@ exportUserRoleAssignments.redcapApiConnection <- function(rcon, error_handling = error_handling) } - if (as.character(response) == ""){ - return(REDCAP_USER_ROLE_ASSIGNMENT_STRUCTURE) - } + response <- as.data.frame(response) - as.data.frame(response) + if(nrow(response) == 0) REDCAP_USER_ROLE_ASSIGNMENT_STRUCTURE else response } diff --git a/R/exportUserRoles.R b/R/exportUserRoles.R index b8ccd755..362f7d82 100644 --- a/R/exportUserRoles.R +++ b/R/exportUserRoles.R @@ -72,12 +72,11 @@ exportUserRoles.redcapApiConnection <- function(rcon, error_handling = error_handling) } - if (as.character(response) == ""){ - return(REDCAP_USER_ROLE_STRUCTURE) - } - UserRole <- as.data.frame(response) + if (nrow(UserRole) == 0) return(REDCAP_USER_ROLE_STRUCTURE) + + # The API returns the forms_export string twice. We reduce it to once here temp <- UserRole$forms_export temp <- strsplit(temp, ",") From 0bc0ca494ffb0a07475148aa8198a6d2af0d1208 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 08:59:26 -0600 Subject: [PATCH 038/155] Updating README --- R/exportUserRoles.R | 1 - README.md | 27 +++++++++++++++------------ 2 files changed, 15 insertions(+), 13 deletions(-) diff --git a/R/exportUserRoles.R b/R/exportUserRoles.R index 362f7d82..73051a8f 100644 --- a/R/exportUserRoles.R +++ b/R/exportUserRoles.R @@ -75,7 +75,6 @@ exportUserRoles.redcapApiConnection <- function(rcon, UserRole <- as.data.frame(response) if (nrow(UserRole) == 0) return(REDCAP_USER_ROLE_STRUCTURE) - # The API returns the forms_export string twice. We reduce it to once here temp <- UserRole$forms_export diff --git a/README.md b/README.md index 3da7ebaf..751d3cb9 100644 --- a/README.md +++ b/README.md @@ -7,24 +7,24 @@ redcapAPI ====== -`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory in R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. +`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory using base R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. Core concerns handled by the library: * API_KEY (which is equivalent of username/password to ones data!) secure handling practices are designed to be as seamless as possible via `unlockREDCap`. There are override methods available for production environments. -* Retry strategy with exponential back off. When a REDCap server or a network is overload requests can fail. Each call to the API will retry multiple times, and it doubles the wait time between each all. This dramatically increases the odds of success for a script with multiple API calls to REDCap. -* Automatically handles and caches meta data information needed to understand and translate a projects data. +* Retry strategy with exponential back off. When a REDCap server or a network is overloaded requests can fail. Each call to the API will retry multiple times, and it doubles the wait time between each call. This dramatically increases the odds of success for a script with multiple API calls to REDCap. +* Automatically handles and caches meta data information needed to understand and translate a project's data. * A robust type casting strategy that every step of the process can be overridden by the user via inversion of control. The strategy proceeds as follows: - * NA detection per REDCap definition of NA. - * Validation of data versus the target type/class. `reviewInvalidRecords` provides a summary report of all data that fails validation, with hot links to the record in question. This is an important step. Data that does not match the target format cannot be cast, e.g. "xyz" cannot be treated as a numeric and will become NA in the final dataset. + * NA detection per REDCap (_or user!_) definition of NA. + * Validation of data versus the target type/class. `reviewInvalidRecords` provides a summary report of all data that fails validation, with hot links to the record in question. This is an important step. Data that does not match the target format cannot be cast, e.g. "xyz" cannot be treated as a numeric and will become NA in the final data set. * Final type casting to target type. * Sparse block matrix splitting into forms/instruments with filtering of empty rows. * Additional helper functions, e.g. longitudinal wider/long conversions, guessing if a character field is actually a date, and SAS exports. -* Importing data reuses a lot of the casting functions in reverse to ensure data integrity. +* Importing data reuses a lot of the casting functions in reverse to ensure data integrity both directions. ## Quick Start Guide -There are 2 basic functions that are key to understanding the major changes with this version: +There are 2 basic functions that are key to understanding the core approach: * `unlockREDCap` * `exportBulkRecords` @@ -51,9 +51,9 @@ The next call to `exportBulkRecords`, says to export by form and leave out recor These two calls will handle most analysis requests. To truly understand all these changes see: `vignette("redcapAPI-best-practices")`. -### 2.7.0+ +### Version 2.7.0+ -2.7.0 includes `exportRecordsTyped` which is a major move forward for the package. It replaces `exportRecords` with a far more stable and dependable call. It includes retries with exponential backoff through the connection object. It has inversion of control over casting, and has a useful validation report attached when things fail. It is worth the time to convert calls to `exportRecords` to `exportRecordsTyped` and begin using this new routine. It is planned that in the next year `exportRecords` will be removed from the package. +2.7.0 introduced `exportRecordsTyped` which is a major move forward for the package. It replaces `exportRecords` with a far more stable and dependable call. It includes retries with exponential back off through the connection object. It has inversion of control over casting, and has a useful validation report attached when things fail. It is worth the time to convert calls to `exportRecords` to `exportRecordsTyped` and begin using this new routine. It is planned that in the next year `exportRecords` will be removed from the package. ## Community Guidelines @@ -61,8 +61,7 @@ This package exists to serve the research community and would not exist without ### Contribute -If you wish to contribute new features to this software, we are open to [pull requests](https://github.com/vubiostat/redcapAPI/pulls). Before doing a lot of work, it would be best to open [issue](https://github.com/vubiostat/redcapAPI/issues) for discussion about your -idea. +If you wish to contribute new features to this software, we are open to [pull requests](https://github.com/vubiostat/redcapAPI/pulls). Before doing a lot of work, it would be best to open [issue](https://github.com/vubiostat/redcapAPI/issues) for discussion about your idea. #### Coding Style Guideline Note @@ -84,7 +83,11 @@ REDCap and it's API have a large number of options and choices, with such comple 5. Is it an empty row filtering issue? Try the option `filter_empty_rows=FALSE` and see if that fixes it. 6. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. 7. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) - on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. + on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. + +## What does "Project contains invalid characters. Mapped to '□'." mean? + +This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not the root cause of this, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is doing it's best to respect the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. ### Seek Support From 6c16d57b11a0a4f0a7a1829f5abb994115c75c5e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 09:20:13 -0600 Subject: [PATCH 039/155] Changed header level in README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 751d3cb9..6829b390 100644 --- a/README.md +++ b/README.md @@ -85,7 +85,7 @@ REDCap and it's API have a large number of options and choices, with such comple 7. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. -## What does "Project contains invalid characters. Mapped to '□'." mean? +#### What does "Project contains invalid characters. Mapped to '□'." mean? This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not the root cause of this, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is doing it's best to respect the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. From 940ca16a7f41e0a972a2161c7f798a30bf28fc94 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 09:55:31 -0600 Subject: [PATCH 040/155] Changes required by win-builder devel #318 --- R/documentation-common-args.R | 6 +++--- R/makeApiCall.R | 9 ++++++++- man/fieldCastingFunctions.Rd | 4 ++-- man/recordsTypedMethods.Rd | 6 +++--- 4 files changed, 16 insertions(+), 9 deletions(-) diff --git a/R/documentation-common-args.R b/R/documentation-common-args.R index 370cbe1b..94ad4a2a 100644 --- a/R/documentation-common-args.R +++ b/R/documentation-common-args.R @@ -40,9 +40,9 @@ NULL #' @param na A named `list` of user specified functions to determine if the #' data is NA. This is useful when data is loaded that has coding for NA, e.g. #' -5 is NA. Keys must correspond to a truncated REDCap field type, i.e. -#' {date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, +#' date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, #' number, calc, int, integer, select, radio, dropdown, yesno, truefalse, -#' checkbox, form_complete, sql, system}. The function will be provided the +#' checkbox, form_complete, sql, system. The function will be provided the #' variables (x, field_name, coding). The function must return a vector of #' logicals matching the input. It defaults to [isNAorBlank()] for all #' entries. @@ -61,7 +61,7 @@ NULL #' @param assignment A named `list` of functions. These functions are provided, field_name, #' label, description and field_type and return a list of attributes to assign #' to the column. Defaults to creating a label attribute from the stripped -#' HTML and UNICODE raw label and scanning for units={"UNITS"} in description +#' HTML and UNICODE raw label and scanning for units=\{"UNITS"\} in description NULL diff --git a/R/makeApiCall.R b/R/makeApiCall.R index df751132..d63e2fd9 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -260,8 +260,15 @@ makeApiCall <- function(rcon, } # Helper function to convert responses to character strings without crashing. -as.data.frame.response <- function(x, stringsAsFactors=FALSE, na.strings = "", ...) +as.data.frame.response <- function(x, row.names=NULL, optional=FALSE, ...) { + # Setting defaults, necessary because cannot change S3 interface + extra <- list(...) + stringsAsFactors <- extra$stringsAsFactors + if(is.null(stringsAsFactors)) stringsAsFactors <- FALSE + na.strings <- extra$na.strings + if(is.null(na.strings)) na.strings <- "" + enc <- if(grepl("charset", x$headers[["Content-Type"]])) toupper(sub('.*charset=([^;]+).*', '\\1', x$headers[["Content-Type"]])) else 'ISO-8859-1' # [Default if unspecified](https://www.w3.org/International/articles/http-charset/index) diff --git a/man/fieldCastingFunctions.Rd b/man/fieldCastingFunctions.Rd index b5a8e3ab..648ce475 100644 --- a/man/fieldCastingFunctions.Rd +++ b/man/fieldCastingFunctions.Rd @@ -82,9 +82,9 @@ the result will have one column with the coded values \item{na}{A named \code{list} of user specified functions to determine if the data is NA. This is useful when data is loaded that has coding for NA, e.g. -5 is NA. Keys must correspond to a truncated REDCap field type, i.e. -{date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, +date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, number, calc, int, integer, select, radio, dropdown, yesno, truefalse, -checkbox, form_complete, sql, system}. The function will be provided the +checkbox, form_complete, sql, system. The function will be provided the variables (x, field_name, coding). The function must return a vector of logicals matching the input. It defaults to \code{\link[=isNAorBlank]{isNAorBlank()}} for all entries.} diff --git a/man/recordsTypedMethods.Rd b/man/recordsTypedMethods.Rd index c6c92a37..918f0d17 100644 --- a/man/recordsTypedMethods.Rd +++ b/man/recordsTypedMethods.Rd @@ -121,9 +121,9 @@ Otherwise, records created or modified before this date will be returned.} \item{na}{A named \code{list} of user specified functions to determine if the data is NA. This is useful when data is loaded that has coding for NA, e.g. -5 is NA. Keys must correspond to a truncated REDCap field type, i.e. -{date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, +date_, datetime_, datetime_seconds_, time_mm_ss, time_hh_mm_ss, time, float, number, calc, int, integer, select, radio, dropdown, yesno, truefalse, -checkbox, form_complete, sql, system}. The function will be provided the +checkbox, form_complete, sql, system. The function will be provided the variables (x, field_name, coding). The function must return a vector of logicals matching the input. It defaults to \code{\link[=isNAorBlank]{isNAorBlank()}} for all entries.} @@ -145,7 +145,7 @@ the desired intent. See \code{\link[=fieldValidationAndCasting]{fieldValidationA \item{assignment}{A named \code{list} of functions. These functions are provided, field_name, label, description and field_type and return a list of attributes to assign to the column. Defaults to creating a label attribute from the stripped -HTML and UNICODE raw label and scanning for units={"UNITS"} in description} +HTML and UNICODE raw label and scanning for units=\{"UNITS"\} in description} \item{filter_empty_rows}{\code{logical(1)}. Filter out empty rows post retrieval. Defaults to \code{TRUE}.} From 9f709fd17363b76ead63127b74958f0870bd5f57 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 14:49:58 -0600 Subject: [PATCH 041/155] Minor edits to README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 6829b390..4f193d28 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ redcapAPI ====== -`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. It's goal is to get data into memory using base R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. +`redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. One principal goal is to get data into memory using base R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. Core concerns handled by the library: @@ -87,7 +87,7 @@ REDCap and it's API have a large number of options and choices, with such comple #### What does "Project contains invalid characters. Mapped to '□'." mean? -This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not the root cause of this, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is doing it's best to respect the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. +This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not know the root cause of the encoding issue, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is respecting the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. This error message is to make one aware of this issue in their project. The library does the best it can. ### Seek Support From 7e7e42850d3607fda9d23bf2a4fde46efda7d327 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 14:53:09 -0600 Subject: [PATCH 042/155] One more minor README edit --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 4f193d28..06643e57 100644 --- a/README.md +++ b/README.md @@ -87,7 +87,7 @@ REDCap and it's API have a large number of options and choices, with such comple #### What does "Project contains invalid characters. Mapped to '□'." mean? -This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not know the root cause of the encoding issue, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is respecting the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. This error message is to make one aware of this issue in their project. The library does the best it can. +This means that the data/meta-data stored in the REDCap database contains improperly encoded characters. It is a problem with the REDCap project itself. The authors of this library do not know the root cause of the encoding issue, but suspect it was an earlier version of REDCap that did not handle encoding properly. This library is respecting the reported encoding type when loading into memory. All cases seen to date have the data encoded in ISO-8859-1 (the default when the HTTP header is missing charset) and the REDCap server treats all data as UTF-8. This improper coding can result in data loss via the GUI if records are updated. It is best to discuss with your institutions REDCap administrator how to repair this problem and such repairs are outside the scope of this library. This error message is to make one aware of this issue in their project. The library does the best it can when it encounters encoding issues. ### Seek Support From 0ea14cfca415cc09d2ce97d42fb5adbcaeaff86a Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 31 Jan 2024 14:55:07 -0600 Subject: [PATCH 043/155] Updated Zenodo reference --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 06643e57..d910cfec 100644 --- a/README.md +++ b/README.md @@ -1,6 +1,6 @@ -[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.10564837.svg)](https://doi.org/10.5281/zenodo.10564837) +[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.10602052.svg)](https://doi.org/10.5281/zenodo.10602052) ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) [![License: GPL v2](https://img.shields.io/badge/License-GPL_v2-blue.svg)](https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html) From 8d82bac3542c5ec186abb311fbc5583e1c493061 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 7 Feb 2024 09:28:38 -0600 Subject: [PATCH 044/155] #326 optimize export via filterEmptyRow changes --- R/filterEmptyRow.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/filterEmptyRow.R b/R/filterEmptyRow.R index 4326b717..cfe808a5 100644 --- a/R/filterEmptyRow.R +++ b/R/filterEmptyRow.R @@ -37,7 +37,8 @@ filterEmptyRow <- function(data, NewData <- data else { - is_all_missing <- apply(is.na(data[other_fields]), 1, all) + is_all_missing <- rowSums(!is.na(data[other_fields])) == 0 + if(all(!is_all_missing)) return(data) NewData <- data[!is_all_missing, , drop = FALSE] From 4fe1e0db6338eccd55c1e33bd2d1b43b6802abcf Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 7 Feb 2024 09:50:16 -0600 Subject: [PATCH 045/155] filterEmptyRow filter data.frame helper function #326 --- R/filterEmptyRow.R | 53 ++++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 23 deletions(-) diff --git a/R/filterEmptyRow.R b/R/filterEmptyRow.R index cfe808a5..19e05eec 100644 --- a/R/filterEmptyRow.R +++ b/R/filterEmptyRow.R @@ -1,3 +1,22 @@ + ##################################################################### + ## +## Helper function to filter a data.frame and preserve all attributes +## +.df_filter_i <- function (x, i) +{ + rows <- attr(x, "row.names")[i] + attrs <- lapply(x, attributes) + x <- unclass(x) + for (j in seq_along(x)) + { + x[[j]] <- x[[j]][i] + attributes(x[[j]]) <- attrs[[j]] + } + class(x) <- 'data.frame' + attr(x, "row.names") <- rows + x +} + #' @name filterEmptyRow #' @title Remove Rows Containing Only Missing Values #' @@ -12,7 +31,6 @@ #' @seealso #' [exportRecordsTyped()], \cr #' [exportReportsTyped()] - filterEmptyRow <- function(data, rcon){ coll <- checkmate::makeAssertCollection() @@ -26,28 +44,17 @@ filterEmptyRow <- function(data, checkmate::reportAssertions(coll) - invalid <- attr(data, "invalid") - - id_fields <- c(getProjectIdFields(rcon), REDCAP_SYSTEM_FIELDS, - "redcap_data_access_group") + other_fields <- setdiff(names(data), + c(getProjectIdFields(rcon), + REDCAP_SYSTEM_FIELDS, + "redcap_data_access_group")) - other_fields <- setdiff(names(data), id_fields) - - if(length(other_fields) == 0) - NewData <- data - - else { - is_all_missing <- rowSums(!is.na(data[other_fields])) == 0 - if(all(!is_all_missing)) return(data) - - NewData <- data[!is_all_missing, , drop = FALSE] - - for (field in names(NewData)) { - attributes(NewData[[field]]) <- attributes(data[[field]]) - } - - attr(NewData, "invalid") <- invalid + if(length(other_fields) == 0) data else + { + has_any_value <- rowSums(!is.na(data[other_fields])) != 0 + if(all(has_any_value)) return(data) + .df_filter_i(data, has_any_value) } - - NewData } + + From 758a0e3ddd1c33b6cd2125265d6305bdd8d8ab5e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 7 Feb 2024 09:57:11 -0600 Subject: [PATCH 046/155] Minor formatting changes filterEmptyRow #326 --- R/filterEmptyRow.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/filterEmptyRow.R b/R/filterEmptyRow.R index 19e05eec..26f6f111 100644 --- a/R/filterEmptyRow.R +++ b/R/filterEmptyRow.R @@ -49,11 +49,15 @@ filterEmptyRow <- function(data, REDCAP_SYSTEM_FIELDS, "redcap_data_access_group")) - if(length(other_fields) == 0) data else + if(length(other_fields) == 0) + data + else { has_any_value <- rowSums(!is.na(data[other_fields])) != 0 - if(all(has_any_value)) return(data) - .df_filter_i(data, has_any_value) + if(all(has_any_value)) + data + else + .df_filter_i(data, has_any_value) } } From 51afddc3e86ca8096cb146239a279a3ecc31fcc6 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 7 Feb 2024 12:29:27 -0600 Subject: [PATCH 047/155] Bumped version number #326 --- DESCRIPTION | 2 +- NEWS | 4 ++++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 9a67f5a2..7ca953ae 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: redcapAPI Type: Package Title: Interface to 'REDCap' -Version: 2.8.4 +Version: 2.8.5 Authors@R: c( person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", role = c("ctb", "aut")), diff --git a/NEWS b/NEWS index 3f9204ec..91cde661 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,10 @@ A future release of version 3.0.0 will introduce several breaking changes! * The `exportProjectInfo` and `exportBundle` functions are being discontinued. Their functionality is replaced by caching values on the connection object. * The `cleanseMetaData` function is being discontinued. +## 2.8.5 + +* Minor export optimizations for records. + ## 2.8.4 * Patch to reading HTTP data. When non UTF-8 characters are sent, they get mapped to '□'. From 61b9f1ae5c716f0aab3117c1d3dbdea972d35c72 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Mon, 4 Mar 2024 12:39:23 -0500 Subject: [PATCH 048/155] use ENV variable if it exists, add unlockENVOverride function --- R/unlockREDCap.R | 42 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index 6352e91f..ec940020 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -98,6 +98,43 @@ }) names(dest) <- if(is.null(names(connections))) connections else names(connections) + return(dest) +} + ############################################################################# + ## unlock via ENV override if it exists +## +.unlockENVOverride <- function(connections, url, ...) +{ + for (conn in length(connections)) { + conn_uppercase <- toupper(conn) + + if (is.null(Sys.getenv(conn_uppercase))) { + stop(paste("Some matching ENV variables found but missing:",paste0(conn, collpase=", "))) + } + } + + dest <- lapply(connections, function(conn) + { + key <- keys[[conn]] + conn_uppercase <- toupper(conn) + + if(is.null(key) || length(key)==0) + stop(paste0("ENV variable '", conn_uppercase, "' does not have API_KEY for '", conn,"' specified.")) + if(!is.character(key)) + { + stop(paste0("ENV variable '", conn_uppercase, "' invalid entry for '", conn,"'.")) + } + if(length(key) > 1) + stop(paste0("ENV variable '", conn_uppercase, "' has too may key entries for '", conn,"' specified.")) + + args <- list(...) + args$key <- key + args$url <- url + # if(!is.null(config$args)) args <- utils::modifyList(args, config$args) + do.call(.connectAndCheck, args) + }) + names(dest) <- if(is.null(names(connections))) connections else names(connections) + return(dest) } @@ -268,6 +305,11 @@ unlockREDCap <- function(connections, if(length(dest) > 0) return(if(is.null(envir)) dest else list2env(dest, envir=envir)) + # Use ENV if it exists and YAML does not exist + dest <- .unlockENVOverride(connections, url, ...) + if(length(dest) > 0) + return(if(is.null(envir)) dest else list2env(dest, envir=envir)) + .unlockKeyring(keyring, passwordFUN) # Open Connections From 0268b447d3817c0931e53be24c931246a2ad08f2 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Mon, 4 Mar 2024 13:23:14 -0500 Subject: [PATCH 049/155] get uppercase connection env --- R/unlockREDCap.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index ec940020..0103e6db 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -106,7 +106,7 @@ .unlockENVOverride <- function(connections, url, ...) { for (conn in length(connections)) { - conn_uppercase <- toupper(conn) + conn_uppercase <- toupper(toString(conn)) if (is.null(Sys.getenv(conn_uppercase))) { stop(paste("Some matching ENV variables found but missing:",paste0(conn, collpase=", "))) @@ -115,8 +115,8 @@ dest <- lapply(connections, function(conn) { - key <- keys[[conn]] - conn_uppercase <- toupper(conn) + conn_uppercase <- toupper(toString(conn)) + key <- Sys.getenv(conn_uppercase) if(is.null(key) || length(key)==0) stop(paste0("ENV variable '", conn_uppercase, "' does not have API_KEY for '", conn,"' specified.")) @@ -130,7 +130,6 @@ args <- list(...) args$key <- key args$url <- url - # if(!is.null(config$args)) args <- utils::modifyList(args, config$args) do.call(.connectAndCheck, args) }) names(dest) <- if(is.null(names(connections))) connections else names(connections) From 49a443cab3959aad08b91ca7a33412e8a3f6a98b Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Mon, 4 Mar 2024 14:09:44 -0500 Subject: [PATCH 050/155] remove toString, checkmate asserts character already --- R/unlockREDCap.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index 0103e6db..404854a0 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -106,7 +106,7 @@ .unlockENVOverride <- function(connections, url, ...) { for (conn in length(connections)) { - conn_uppercase <- toupper(toString(conn)) + conn_uppercase <- toupper(conn) if (is.null(Sys.getenv(conn_uppercase))) { stop(paste("Some matching ENV variables found but missing:",paste0(conn, collpase=", "))) @@ -115,7 +115,7 @@ dest <- lapply(connections, function(conn) { - conn_uppercase <- toupper(toString(conn)) + conn_uppercase <- toupper(conn) key <- Sys.getenv(conn_uppercase) if(is.null(key) || length(key)==0) From d7cc17f01114230fa1414eb75de7edec4ef494a8 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 5 Mar 2024 16:20:01 -0500 Subject: [PATCH 051/155] update unlockREDCap with ENV variable documentation --- R/unlockREDCap.R | 5 ++++- man/unlockREDCap.Rd | 3 +++ 2 files changed, 7 insertions(+), 1 deletion(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index 404854a0..e5620293 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -230,6 +230,9 @@ #' other-config-stuff3: blah blah #' } #' +#' For production servers the use of ENV variables is also supported. If a YAML +#' and ENV variable both exist, the YAML will take precedence. +#' #' IMPORTANT: Make sure that R is set to NEVER save workspace to .RData #' as this *is* writing the API_KEY to a local file in clear text because #' connection objects contain the unlocked key in memory. Tips @@ -239,7 +242,7 @@ #' connections with associated API_KEYs to load into environment. Each #' name should correspond to a REDCap project for traceability, but #' it can be named anything one desires. -#' The name in the returned list is this name. +#' The name in the returned list is this name. #' @param envir environment. The target environment for the connections. Defaults to NULL #' which returns the keys as a list. Use [globalenv()] to assign in the #' global environment. Will accept a number such a '1' for global as well. diff --git a/man/unlockREDCap.Rd b/man/unlockREDCap.Rd index fc88db93..c7343ca3 100644 --- a/man/unlockREDCap.Rd +++ b/man/unlockREDCap.Rd @@ -69,6 +69,9 @@ other-config-stuff2: blah blah other-config-stuff3: blah blah } +For production servers the use of ENV variables is also supported. If a YAML +and ENV variable both exist, the YAML will take precedence. + IMPORTANT: Make sure that R is set to NEVER save workspace to .RData as this \emph{is} writing the API_KEY to a local file in clear text because connection objects contain the unlocked key in memory. Tips From 3b101ef86565b022c0617aa540971a6d097871ef Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 5 Mar 2024 16:48:09 -0500 Subject: [PATCH 052/155] include stub tests for unlockENVOverride --- tests/testthat/test-024-unlockREDCap.R | 50 +++++++++++++++++++++++++- 1 file changed, 49 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 484b05b0..6b194f5d 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -83,7 +83,6 @@ test_that( } ) - test_that( ".unlockYamlOverride returns an entry for every connection", { @@ -110,6 +109,55 @@ test_that( } ) +test_that( + ".unlockENVOverride return empty when override ENV doesn't exist", + { + stub(.unlockENVOverride, "ENV.exists", FALSE) + + x <- .unlockENVOverride("TestRedcapAPI", url) + expect_class(x, "list") + expect_true(is.null(x$TestRedcapAPI)) + } +) + +test_that( + ".unlockENVOverride stops if a non string entry is found", + { + stub(.unlockENVOverride, "ENV.exists", TRUE) + stub(.unlockENVOverride, "read_env", list(redcapAPI=list(keys=list(TestRedcapAPI=TRUE)))) + stub(.unlockENVOverride, ".connectAndCheck", TRUE) + + expect_error(.unlockENVOverride("TestRedcapAPI", url), + "invalid entry") + } +) + +test_that( + ".unlockENVOverride returns an entry for every connection", + { + stub(.unlockENVOverride, "env.exists", TRUE) + stub(.unlockENVOverride, "read_env", + list(redcapAPI=list(keys=list(TestRedcapAPI='xyz', Sandbox='xyz')))) + stub(.unlockENVOverride, ".connectAndCheck", TRUE) + x <- .unlockENVOverride(c("TestRedcapAPI", "Sandbox"), url) + expect_true(x$TestRedcapAPI) + expect_true(x$Sandbox) + } +) + +test_that( + ".unlockENVOverride returns an entry for every connection renamed as requested", + { + stub(.unlockENVOverride, "env.exists", TRUE) + stub(.unlockENVOverride, "read_env", + list(redcapAPI=list(keys=list(TestRedcapAPI='xyz', Sandbox='xyz')))) + stub(.unlockENVOverride, ".connectAndCheck", TRUE) + x <- .unlockENVOverride(c(rcon="TestRedcapAPI", sand="Sandbox"), url) + expect_true(x$rcon) + expect_true(x$sand) + } +) + test_that( ".unlockKeyring pulls password from env and writes back", { From a4a96c16858fe9b235bd742face9948e59dc1f43 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 6 Mar 2024 08:30:00 -0600 Subject: [PATCH 053/155] Added NEWS update and minor doc tweak. #323 --- .gitignore | 4 ++++ NEWS | 1 + R/unlockREDCap.R | 3 ++- man/unlockREDCap.Rd | 3 ++- 4 files changed, 9 insertions(+), 2 deletions(-) diff --git a/.gitignore b/.gitignore index 0fd19af9..3eb1af2f 100644 --- a/.gitignore +++ b/.gitignore @@ -14,3 +14,7 @@ sample_data *.Rproj /doc/ /Meta/ +vignettes/*.aux +vignettes/*.log +vignettes/*.tex +vignettes/*.pdf diff --git a/NEWS b/NEWS index 91cde661..cef1d34d 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.8.5 * Minor export optimizations for records. +* unlockREDCap will now search for ENV variables. ## 2.8.4 diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index e5620293..9cc6b229 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -230,7 +230,8 @@ #' other-config-stuff3: blah blah #' } #' -#' For production servers the use of ENV variables is also supported. If a YAML +#' For production servers the use of ENV variables is also supported. The connection +#' string is converted to upper case for the search of ENV. If a YAML #' and ENV variable both exist, the YAML will take precedence. #' #' IMPORTANT: Make sure that R is set to NEVER save workspace to .RData diff --git a/man/unlockREDCap.Rd b/man/unlockREDCap.Rd index c7343ca3..2ee3c607 100644 --- a/man/unlockREDCap.Rd +++ b/man/unlockREDCap.Rd @@ -69,7 +69,8 @@ other-config-stuff2: blah blah other-config-stuff3: blah blah } -For production servers the use of ENV variables is also supported. If a YAML +For production servers the use of ENV variables is also supported. The connection +string is converted to upper case for the search of ENV. If a YAML and ENV variable both exist, the YAML will take precedence. IMPORTANT: Make sure that R is set to NEVER save workspace to .RData From e16578f866662c49ecf38d47427b1d02cf5397f0 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Wed, 6 Mar 2024 10:43:53 -0500 Subject: [PATCH 054/155] replace is.null check for ENV variable --- R/unlockREDCap.R | 29 ++++++++--------------------- 1 file changed, 8 insertions(+), 21 deletions(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index e5620293..9324c0ba 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -105,34 +105,21 @@ ## .unlockENVOverride <- function(connections, url, ...) { - for (conn in length(connections)) { - conn_uppercase <- toupper(conn) - - if (is.null(Sys.getenv(conn_uppercase))) { - stop(paste("Some matching ENV variables found but missing:",paste0(conn, collpase=", "))) - } - } + api_key_ENV <- sapply(connections, function(x) Sys.getenv(toupper(x))) - dest <- lapply(connections, function(conn) + if(all(api_key_ENV == "")) return(list()) + + if(any(api_key_ENV == "")) + stop(paste("Some matching ENV variables found but missing:",paste0(toupper(connections[api_key_ENV=='']), collapse=", "))) + + dest <- lapply(api_key_ENV, function(conn) { - conn_uppercase <- toupper(conn) - key <- Sys.getenv(conn_uppercase) - - if(is.null(key) || length(key)==0) - stop(paste0("ENV variable '", conn_uppercase, "' does not have API_KEY for '", conn,"' specified.")) - if(!is.character(key)) - { - stop(paste0("ENV variable '", conn_uppercase, "' invalid entry for '", conn,"'.")) - } - if(length(key) > 1) - stop(paste0("ENV variable '", conn_uppercase, "' has too may key entries for '", conn,"' specified.")) - args <- list(...) args$key <- key args$url <- url do.call(.connectAndCheck, args) }) - names(dest) <- if(is.null(names(connections))) connections else names(connections) + names(dest) <- if(is.null(names(api_key_ENV))) api_key_ENV else names(api_key_ENV) return(dest) } From 54cc2464d7de3126ca2a8014a038e98d963e2f97 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Wed, 6 Mar 2024 12:44:17 -0500 Subject: [PATCH 055/155] set correct key in unlockENVOverride, update test suite --- R/unlockREDCap.R | 2 +- tests/testthat/test-024-unlockREDCap.R | 5 ++--- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index 070f9822..f2c60c89 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -115,7 +115,7 @@ dest <- lapply(api_key_ENV, function(conn) { args <- list(...) - args$key <- key + args$key <- conn args$url <- url do.call(.connectAndCheck, args) }) diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 6b194f5d..061726a0 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -116,7 +116,7 @@ test_that( x <- .unlockENVOverride("TestRedcapAPI", url) expect_class(x, "list") - expect_true(is.null(x$TestRedcapAPI)) + expect_true(length(x$TestRedcapAPI) == 0) } ) @@ -127,8 +127,7 @@ test_that( stub(.unlockENVOverride, "read_env", list(redcapAPI=list(keys=list(TestRedcapAPI=TRUE)))) stub(.unlockENVOverride, ".connectAndCheck", TRUE) - expect_error(.unlockENVOverride("TestRedcapAPI", url), - "invalid entry") + expect_true(length(.unlockENVOverride("TestRedcapAPI", url)) == 0) } ) From bcae0d37c5eead229be4007ab99f1a0ddefe11ed Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 6 Mar 2024 15:34:08 -0600 Subject: [PATCH 056/155] Changed stubs #323 --- tests/testthat/test-024-unlockREDCap.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 061726a0..5f407c71 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -134,9 +134,7 @@ test_that( test_that( ".unlockENVOverride returns an entry for every connection", { - stub(.unlockENVOverride, "env.exists", TRUE) - stub(.unlockENVOverride, "read_env", - list(redcapAPI=list(keys=list(TestRedcapAPI='xyz', Sandbox='xyz')))) + stub(.unlockENVOverride, "Sys.getenv", "xyz") stub(.unlockENVOverride, ".connectAndCheck", TRUE) x <- .unlockENVOverride(c("TestRedcapAPI", "Sandbox"), url) expect_true(x$TestRedcapAPI) @@ -147,9 +145,7 @@ test_that( test_that( ".unlockENVOverride returns an entry for every connection renamed as requested", { - stub(.unlockENVOverride, "env.exists", TRUE) - stub(.unlockENVOverride, "read_env", - list(redcapAPI=list(keys=list(TestRedcapAPI='xyz', Sandbox='xyz')))) + stub(.unlockENVOverride, "Sys.getenv", "xyz") stub(.unlockENVOverride, ".connectAndCheck", TRUE) x <- .unlockENVOverride(c(rcon="TestRedcapAPI", sand="Sandbox"), url) expect_true(x$rcon) From b3167909f88564dfec6b04dbeb7444d1ee06c6b8 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 6 Mar 2024 15:46:56 -0600 Subject: [PATCH 057/155] Bit of test cleanup #323 --- tests/testthat/test-024-unlockREDCap.R | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index 5f407c71..dca580d1 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -112,8 +112,7 @@ test_that( test_that( ".unlockENVOverride return empty when override ENV doesn't exist", { - stub(.unlockENVOverride, "ENV.exists", FALSE) - + stub(.unlockENVOverride, "Sys.getenv", "") x <- .unlockENVOverride("TestRedcapAPI", url) expect_class(x, "list") expect_true(length(x$TestRedcapAPI) == 0) @@ -121,13 +120,10 @@ test_that( ) test_that( - ".unlockENVOverride stops if a non string entry is found", + ".unlockENVOverride will stop when only one of two ENV's are found", { - stub(.unlockENVOverride, "ENV.exists", TRUE) - stub(.unlockENVOverride, "read_env", list(redcapAPI=list(keys=list(TestRedcapAPI=TRUE)))) - stub(.unlockENVOverride, ".connectAndCheck", TRUE) - - expect_true(length(.unlockENVOverride("TestRedcapAPI", url)) == 0) + stub(.unlockENVOverride, "sapply", c("", "YO")) + expect_error(.unlockENVOverride(c("x", "y"), url)) } ) From 6cb2a7d599ed2d6b879c4ad133d6289731539aa7 Mon Sep 17 00:00:00 2001 From: Benjamin Date: Thu, 7 Mar 2024 11:12:44 -0500 Subject: [PATCH 058/155] corrected regex for field and form names --- R/constants.R | 12 +++++-- tests/testthat/test-061-regularExpressions.R | 33 ++++++++++++++++++++ 2 files changed, 43 insertions(+), 2 deletions(-) create mode 100644 tests/testthat/test-061-regularExpressions.R diff --git a/R/constants.R b/R/constants.R index 62cb093f..a4ddca9a 100644 --- a/R/constants.R +++ b/R/constants.R @@ -46,23 +46,31 @@ REGEX_CHECKBOX_FIELD_NAME <- "^(.*?)___(.*)$" # REGEX_FIELD_NAME - matches the acceptable naming conventions for field names # Explanation +# This regex has three parts +# 1. ^[a-z]$ : allows a field name of a single alpha character +# 2. ^[a-z][a-z,0-9]$ : allows a field name of two characters, an alpha followed by an alpha/numeric +# 3. ^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$: 3 or more characters, broken down as follows # ^ : start of string # [a-z] : a single character that is a lower case letter # (?!.*__.*) : disallow any two consecutive characters to be underscores # [a-z,0-9,_]+ : any number or characters that are a lower case letter, digit, or underscore # [a-z,0-9] : a single character that is a lower case letter or digit # $ : end of string -REGEX_FIELD_NAME <- "^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$" +REGEX_FIELD_NAME <- "(^[a-z]$|^[a-z][a-z,0-9]$|^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$)" # REGEX_FORM_NAME - matches acceptable naming conventions for form names # Explanation +# This regex has three parts +# 1. ^[a-z]$ : allows a field name of a single alpha character +# 2. ^[a-z][a-z,0-9]$ : allows a field name of two characters, an alpha followed by an alpha/numeric +# 3. ^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$: 3 or more characters, broken down as follows # ^ : start of string # [a-z] : A single character that is a lower case letter # (?!.*__.*) : disallow any two consecutive characters to be underscores # [a-z,0-9,_]+ : Any number of characters that are lower case letters, digits, or an underscore # [a-z,0-9] : a single character that is a lower case letter or digit # $ : end of string -REGEX_FORM_NAME <- "^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$" +REGEX_FORM_NAME <- "(^[a-z]$|^[a-z][a-z,0-9]$|^[a-z](?!.*__.*)[a-z,0-9,_]+[a-z,0-9]$)" # REGEX_MULT_CHOICE_STRICT - matches acceptable formats for multiple choice options # It's a good idea to trim whitespace before using this diff --git a/tests/testthat/test-061-regularExpressions.R b/tests/testthat/test-061-regularExpressions.R new file mode 100644 index 00000000..eb835d35 --- /dev/null +++ b/tests/testthat/test-061-regularExpressions.R @@ -0,0 +1,33 @@ +##################################################################### +# REGEX_FIELD_NAME #### + +test_that( + "REGEX_FIELD_NAME correctly identifies acceptable field names", + { + field_name <- c("a", "ab", "a1", "a_1", + "a_", "_a", "a__1", "1", "1a", + "multiple_under_scores") + + expect_equal(grepl(REGEX_FIELD_NAME, field_name, perl = TRUE), + c(TRUE, TRUE, TRUE, TRUE, + FALSE, FALSE, FALSE, FALSE, FALSE, + TRUE)) + } +) + +##################################################################### +# REGEX_FORM_NAME #### + +test_that( + "REGEX_FORM_NAME correctly identifies acceptable field names", + { + form_name <- c("a", "ab", "a1", "a_1", + "a_", "_a", "a__1", "1", "1a", + "multiple_under_scores") + + expect_equal(grepl(REGEX_FORM_NAME, form_name, perl = TRUE), + c(TRUE, TRUE, TRUE, TRUE, + FALSE, FALSE, FALSE, FALSE, FALSE, + TRUE)) + } +) \ No newline at end of file From b7690a6ce2c721027c3f0e5aa5a114d46a4cd500 Mon Sep 17 00:00:00 2001 From: Benjamin Date: Thu, 7 Mar 2024 13:52:25 -0500 Subject: [PATCH 059/155] importFileToRecord with recrord creation ability --- NAMESPACE | 1 + R/docsFileMethods.R | 3 +- R/importFileToRecord.R | 157 ++++++++++++ man/fileMethods.Rd | 3 +- man/importFileToRecord.Rd | 88 +++++++ tests/testthat/test-308-importFileToRecord.R | 240 +++++++++++++++++++ 6 files changed, 490 insertions(+), 2 deletions(-) create mode 100644 R/importFileToRecord.R create mode 100644 man/importFileToRecord.Rd create mode 100644 tests/testthat/test-308-importFileToRecord.R diff --git a/NAMESPACE b/NAMESPACE index 7661bd88..3ae881dd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -165,6 +165,7 @@ export(importArms) export(importDags) export(importEvents) export(importFileRepository) +export(importFileToRecord) export(importFiles) export(importMappings) export(importMetaData) diff --git a/R/docsFileMethods.R b/R/docsFileMethods.R index 45781050..8aa4d091 100644 --- a/R/docsFileMethods.R +++ b/R/docsFileMethods.R @@ -34,7 +34,8 @@ #' may be appended as a prefix. #' #' @seealso -#' [exportFilesMultiple()] +#' [exportFilesMultiple()], \cr +#' [importFileToRecord()] (can create a record to receive the file if it does yet exist) #' #' @return #' `exportFiles` invisibly returns the file path to which the exported diff --git a/R/importFileToRecord.R b/R/importFileToRecord.R new file mode 100644 index 00000000..c8b3f2d3 --- /dev/null +++ b/R/importFileToRecord.R @@ -0,0 +1,157 @@ +#' @name importFileToRecord +#' @title Import a File With Option to Create A Record to Receive the File +#' +#' @description There are times when the user may desire to create a record +#' and import a file as part of a single action. For example, a study +#' consent form may have been collected and needs to be stored with the +#' data of the new study participant. `importFileToRecord` extends +#' `importFiles` to allow the concurrent creation of the record in which +#' the file will be stored. +#' +#' @inheritParams fileMethods +#' @param record `character(1)` or `integerish(1)` or `NULL`. The record ID in +#' which the desired file is stored. When `NULL`, an attempt will be made to +#' create a new record for the file. See 'Details' +#' +#' @details +#' The behavior of `importFileToRecord` depends on +#' +#' 1. whether record auto numbering has been enabled in the project, +#' 2. if the record is specified by the user +#' 3. if the record specified by the user exists. +#' +#' The following table details the actions taken based on these conditions. +#' (`force_auto_number` is an argument to [importRecords()]). +#' +#' | Autonumbering enabled | `record` | Record Exists | Action | +#' |-----------------------|----------|---------------|--------| +#' | Yes | `NULL` | No | Create a new record (using `force_auto_number = TRUE`) and import the file to the new record | +#' | Yes | Specified | Yes | Import the file to the existing record | +#' | Yes | Specified | No | Create a new record (using `force_auto_number = TRUE`)and import the file to the new record | +#' | No | `NULL` | No | Error: record must be provided when auto numbering is not enabled | +#' | No | Specified | Yes | Import the file to the existing record | +#' | No | Specified | No | Create the record (using `force_auto_number = FALSE`) and import the file to the new record. | +#' +#' @seealso +#' [importFiles()],\cr +#' [importRecords()] +#' +#' @examples +#' \dontrun{ +#' unlockREDCap(connections = c(rcon = "project_alias"), +#' url = "your_redcap_url", +#' keyring = "API_KEYs", +#' envir = globalenv()) +#' +#' importFileToRecord(rcon, +#' file = "file_to_upload.txt" +#' record = NULL, +#' field = "file_upload_test") +#' } +#' +#' @export + +importFileToRecord <- function(rcon, + file, + record = NULL, + field, + event, + overwrite = TRUE, + repeat_instance = NULL, + ...){ + if (is.numeric(record)) record <- as.character(record) + + ################################################################## + # Argument Validation + + coll <- checkmate::makeAssertCollection() + + checkmate::assert_class(x = rcon, + classes = "redcapApiConnection", + add = coll) + + checkmate::assert_character(x = file, + len = 1, + any.missing = FALSE, + add = coll) + + checkmate::assert_character(x = record, + len = 1, + any.missing = FALSE, + null.ok = TRUE, + add = coll) + + checkmate::assert_character(x = field, + len = 1, + any.missing = FALSE, + add = coll) + + checkmate::assert_character(x = event, + len = 1, + any.missing = FALSE, + null.ok = TRUE, + add = coll) + + checkmate::assert_logical(x = overwrite, + len = 1, + any.missing = FALSE, + add = coll) + + checkmate::assert_integerish(x = repeat_instance, + len = 1, + any.missing = FALSE, + null.ok = TRUE, + add = coll) + + checkmate::reportAssertions(coll) + + ################################################################### + # is autonumbering enabled, and does the record exist #### + is_autonumber_enabled <- as.logical(rcon$projectInformation()$record_autonumbering_enabled) + + if (!is_autonumber_enabled && is.null(record)){ + coll$push("`record` must be provided when autonumbering is not enabled.") + } + + checkmate::reportAssertions(coll) + + record_exists <- + if (!is.null(record)){ + suppressMessages({ + RecordData <- exportRecordsTyped(rcon, + record = record, + fields = rcon$metadata()$field_name[1]) + }) + nrow(RecordData) > 0 + } else { + FALSE + } + + ################################################################### + # Create the new record, if necessary #### + # In the case enumeration, the only condition under which the + # record doesn't exist and we don't create the record is when + # an error is returned. Since that is cleared in the validation, + # it is safe to create the record if the record does not exist. + + if (!record_exists){ + NewData <- data.frame(record_id = if (is.null(record)) "1" else record) + names(NewData) <- rcon$metadata()$field_name[1] + + record <- importRecords(rcon, + data = NewData, + force_auto_number = is_autonumber_enabled, + returnContent = "ids")[[1]] + } + + ################################################################### + # Import the file #### + importFiles(rcon = rcon, + file = file, + record = record, + field = field, + event = event, + overwrite = overwrite, + repeat_instance = repeat_instance, + ...) +} diff --git a/man/fileMethods.Rd b/man/fileMethods.Rd index 6ad9741c..118ba885 100644 --- a/man/fileMethods.Rd +++ b/man/fileMethods.Rd @@ -176,5 +176,6 @@ deleteFiles(rcon, } \seealso{ -\code{\link[=exportFilesMultiple]{exportFilesMultiple()}} +\code{\link[=exportFilesMultiple]{exportFilesMultiple()}}, \cr +\code{\link[=importFileToRecord]{importFileToRecord()}} (can create a record to receive the file if it does yet exist) } diff --git a/man/importFileToRecord.Rd b/man/importFileToRecord.Rd new file mode 100644 index 00000000..6511680a --- /dev/null +++ b/man/importFileToRecord.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/importFileToRecord.R +\name{importFileToRecord} +\alias{importFileToRecord} +\title{Import a File With Option to Create A Record to Receive the File} +\usage{ +importFileToRecord( + rcon, + file, + record = NULL, + field, + event, + overwrite = TRUE, + repeat_instance = NULL, + ... +) +} +\arguments{ +\item{rcon}{A \code{redcapConnection} object.} + +\item{file}{\code{character(1)}. The file path to the file to be imported.} + +\item{record}{\code{character(1)} or \code{integerish(1)} or \code{NULL}. The record ID in +which the desired file is stored. When \code{NULL}, an attempt will be made to +create a new record for the file. See 'Details'} + +\item{field}{\code{character(1)}. The field name in which the file is stored.} + +\item{event}{\code{character(1)} or \code{NULL}. The event name for the file. +This applies only to longitudinal projects. If the event is not +supplied for a longitudinal project, the API will return an error message} + +\item{overwrite}{\code{logical(1)}. When \code{FALSE}, the function checks +if a file already exists for that record. If a file exists, the function +terminates to prevent overwriting. When \code{TRUE}, no additional +check is performed.} + +\item{repeat_instance}{\code{integerish(1)} or \code{NULL}. The repeat instance number of +the repeating event or the repeating instrument. When available in your +instance of REDCap, and passed as \code{NULL}, the API will assume a value of 1.} + +\item{...}{Arguments to pass to other methods} +} +\description{ +There are times when the user may desire to create a record +and import a file as part of a single action. For example, a study +consent form may have been collected and needs to be stored with the +data of the new study participant. \code{importFileToRecord} extends +\code{importFiles} to allow the concurrent creation of the record in which +the file will be stored. +} +\details{ +The behavior of \code{importFileToRecord} depends on +\enumerate{ +\item whether record auto numbering has been enabled in the project, +\item if the record is specified by the user +\item if the record specified by the user exists. +} + +The following table details the actions taken based on these conditions. +(\code{force_auto_number} is an argument to \code{\link[=importRecords]{importRecords()}}).\tabular{llll}{ + Autonumbering enabled \tab \code{record} \tab Record Exists \tab Action \cr + Yes \tab \code{NULL} \tab No \tab Create a new record (using \code{force_auto_number = TRUE}) and import the file to the new record \cr + Yes \tab Specified \tab Yes \tab Import the file to the existing record \cr + Yes \tab Specified \tab No \tab Create a new record (using \code{force_auto_number = TRUE})and import the file to the new record \cr + No \tab \code{NULL} \tab No \tab Error: record must be provided when auto numbering is not enabled \cr + No \tab Specified \tab Yes \tab Import the file to the existing record \cr + No \tab Specified \tab No \tab Create the record (using \code{force_auto_number = FALSE}) and import the file to the new record. \cr +} +} +\examples{ +\dontrun{ +unlockREDCap(connections = c(rcon = "project_alias"), + url = "your_redcap_url", + keyring = "API_KEYs", + envir = globalenv()) + +importFileToRecord(rcon, + file = "file_to_upload.txt" + record = NULL, + field = "file_upload_test") +} + +} +\seealso{ +\code{\link[=importFiles]{importFiles()}},\cr +\code{\link[=importRecords]{importRecords()}} +} diff --git a/tests/testthat/test-308-importFileToRecord.R b/tests/testthat/test-308-importFileToRecord.R new file mode 100644 index 00000000..eeff8a5e --- /dev/null +++ b/tests/testthat/test-308-importFileToRecord.R @@ -0,0 +1,240 @@ +##################################################################### +# Argument Validation #### + +test_that( + "importFileToRecord Argument Checking", + { + # rcon is redcapApiConnection + expect_error(importFileToRecord(rcon = mtcars, + file = "file1", + field = "field_name", + record = "30", + event = "event_1_arm_1", + repeat_instance = NULL), + "Must inherit from class 'redcapApiConnection'") + + # file is a character(1) + expect_error(importFileToRecord(rcon, + file = 123, + record = "30", + field = "field_name", + event = "event_1_arm_1"), + "'file': Must be of type 'character'") + + expect_error(importFileToRecord(rcon, + file = c("file1", "file2"), + record = "30", + field = "field_name", + event = "event_1_arm_1"), + "'file': Must have length 1") + + # record is not character (may also be numeric) + expect_error(importFileToRecord(rcon, + record = TRUE, + field = "fieldname", + file = "filename", + event = "event_1_arm_1"), + "'record': Must be of type 'character'") + + # record is a character(1) + expect_error(importFileToRecord(rcon, + record = c("30", "31"), + field = "field_name", + file = "filename", + event = "event_1_arm_1"), + "'record': Must have length 1") + + # field is character(1) + expect_error(importFileToRecord(rcon, + record = 1, + field = 1, + file = "filename", + event = "event_1_arm_1"), + "'field': Must be of type 'character'") + + expect_error(importFileToRecord(rcon, + record = 1, + field = c("field1", "field2"), + file = "filename", + event = "event_1_arm_1"), + "'field': Must have length 1") + + # event is character(1) + expect_error(importFileToRecord(rcon, + record = 1, + field = "field", + file = "filename", + event = 1), + "'event': Must be of type 'character'") + + expect_error(importFileToRecord(rcon, + record = 1, + field = "field", + file = "filename", + event = c("event1", "event2")), + "'event': Must have length 1") + + + # overwrite is logical(1) + expect_error(importFileToRecord(rcon, + record = 1, + field = "field", + file = "filename", + event = "event_1_arm_1", + overwrite = c(TRUE, FALSE)), + "'overwrite': Must have length 1") + + expect_error(importFileToRecord(rcon, + record = 1, + field = "field", + dir = "dir", + file = "filename", + event = "event_1_arm_1", + overwrite = "TRUE"), + "'overwrite': Must be of type 'logical'") + + # repeat_instance is integerish(1) + expect_error(importFileToRecord(rcon, + record = 1, + field = "file_import_field", + file = "filename", + event = "event_1_arm_1", + repeat_instance = pi), + "'repeat_instance': Must be of type 'integerish'") + + expect_error(importFileToRecord(rcon, + record = 1, + field = "file_import_field", + file = "filename", + event = "event_1_arm_1", + repeat_instance = c(1, 2)), + "'repeat_instance': Must have length 1") + } +) + +##################################################################### +# Functionality #### + +orig_autonumber <- rcon$projectInformation()$record_autonumbering_enabled +orig_record <- unique(exportRecordsTyped(rcon, fields = "record_id")$record_id) +local_file <- test_path("testdata", "FileForImportExportTesting.txt") + +test_that( + "autonumber = TRUE, record = NULL, record_exists = FALSE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 1)) + + OrigRec <- exportRecordsTyped(rcon, fields = "record_id") + + importFileToRecord(rcon, + file = local_file, + record = NULL, + field = "file_upload_test", + event = "event_1_arm_1") + + NewRec <- exportRecordsTyped(rcon, fields = "record_id") + expect_equal(nrow(NewRec) - 1, nrow(OrigRec)) + } +) + +test_that( + "autonumber = TRUE, record != NULL, record_exists = TRUE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 1)) + + OrigRec <- exportRecordsTyped(rcon, fields = "record_id") + + importFileToRecord(rcon, + file = local_file, + record = "20", + field = "file_upload_test", + event = "event_1_arm_1") + + NewRec <- exportRecordsTyped(rcon, fields = "record_id") + expect_equal(nrow(NewRec), nrow(OrigRec)) + } +) + +test_that( + "autonumber = TRUE, record != NULL, record_exists = FALSE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 1)) + + OrigRec <- exportRecordsTyped(rcon, fields = "record_id") + + importFileToRecord(rcon, + file = local_file, + record = "100", + field = "file_upload_test", + event = "event_1_arm_1") + + NewRec <- exportRecordsTyped(rcon, fields = "record_id") + expect_equal(nrow(NewRec) - 1, nrow(OrigRec)) + } +) + +test_that( + "autonumber = FALSE, record = NULL, record_exists = FALSE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 0)) + + expect_error(importFileToRecord(rcon, + file = local_file, + record = NULL, + field = "file_upload_test", + event = "event_1_arm_1"), + "must be provided when autonumbering is not enabled") + } +) + +test_that( + "autonumber = FALSE, record != NULL, record_exists = TRUE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 0)) + + OrigRec <- exportRecordsTyped(rcon, fields = "record_id") + + importFileToRecord(rcon, + file = local_file, + record = "20", + field = "file_upload_test", + event = "event_1_arm_1") + + NewRec <- exportRecordsTyped(rcon, fields = "record_id") + expect_equal(nrow(NewRec), nrow(OrigRec)) + } +) + +test_that( + "autonumber = FALSE, record != NULL, record_exists = TRUE", + { + importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = 0)) + + OrigRec <- exportRecordsTyped(rcon, fields = "record_id") + + importFileToRecord(rcon, + file = local_file, + record = "100", + field = "file_upload_test", + event = "event_1_arm_1") + + NewRec <- exportRecordsTyped(rcon, fields = "record_id") + expect_equal(nrow(NewRec) - 1, nrow(OrigRec)) + } +) + +Rec <- exportRecordsTyped(rcon, fields = "record_id") +rec_to_remove <- Rec$record_id[!Rec$record_id %in% orig_record] + +deleteRecords(rcon, records = rec_to_remove) + +importProjectInformation(rcon, + data.frame(record_autonumbering_enabled = orig_autonumber)) + +rm(list = c("orig_record", "rec_to_remove", "orig_autonumber")) \ No newline at end of file From a54cec161ee4c4fe8cf2ccc04a5cbf2001e4aee1 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 8 Mar 2024 10:00:04 -0600 Subject: [PATCH 060/155] Added context to test #336 --- tests/testthat/test-061-regularExpressions.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-061-regularExpressions.R b/tests/testthat/test-061-regularExpressions.R index eb835d35..c4dfbb1d 100644 --- a/tests/testthat/test-061-regularExpressions.R +++ b/tests/testthat/test-061-regularExpressions.R @@ -1,3 +1,5 @@ +context("Regular Expressions") + ##################################################################### # REGEX_FIELD_NAME #### From 75dc5cbe1a89b9ebe3df8c591f8a1d92a5fa93c9 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Sat, 9 Mar 2024 12:38:17 -0600 Subject: [PATCH 061/155] Minor argument name change to pass CHECK #333 --- NEWS | 1 + R/importFileToRecord.R | 4 ++-- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/NEWS b/NEWS index cef1d34d..e712e0dc 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,7 @@ A future release of version 3.0.0 will introduce several breaking changes! * Minor export optimizations for records. * unlockREDCap will now search for ENV variables. +* New importFileToRecord which will import a file and create the record if it doesn't exist. ## 2.8.4 diff --git a/R/importFileToRecord.R b/R/importFileToRecord.R index c8b3f2d3..36e646ce 100644 --- a/R/importFileToRecord.R +++ b/R/importFileToRecord.R @@ -119,8 +119,8 @@ importFileToRecord <- function(rcon, if (!is.null(record)){ suppressMessages({ RecordData <- exportRecordsTyped(rcon, - record = record, - fields = rcon$metadata()$field_name[1]) + records = record, + fields = rcon$metadata()$field_name[1]) }) nrow(RecordData) > 0 } else { From 63c155abfc1a4021c5db657a8d7cc966e19b879f Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 11 Mar 2024 12:41:09 -0500 Subject: [PATCH 062/155] Missing Summary Refactor, broken #339 --- DESCRIPTION | 4 +- NEWS | 4 ++ R/missingSummary.R | 61 ++----------------- man/redcapAPI.Rd | 2 +- tests/testthat/test-356-missingSummary.R | 76 +++++------------------- 5 files changed, 28 insertions(+), 119 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7ca953ae..b40d608b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: redcapAPI Type: Package Title: Interface to 'REDCap' -Version: 2.8.5 +Version: 2.9.0 Authors@R: c( person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", role = c("ctb", "aut")), @@ -52,4 +52,4 @@ URL: https://github.com/vubiostat/redcapAPI BugReports: https://github.com/vubiostat/redcapAPI/issues Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NEWS b/NEWS index e712e0dc..7c04f0b7 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,10 @@ A future release of version 3.0.0 will introduce several breaking changes! * The `exportProjectInfo` and `exportBundle` functions are being discontinued. Their functionality is replaced by caching values on the connection object. * The `cleanseMetaData` function is being discontinued. +## 2.9.0 + +* Refactor of missingSummary to use exportRecordsTyped. This is a breaking change in prep of 3.0.0 + ## 2.8.5 * Minor export optimizations for records. diff --git a/R/missingSummary.R b/R/missingSummary.R index f59fc8ee..492b0080 100644 --- a/R/missingSummary.R +++ b/R/missingSummary.R @@ -17,15 +17,6 @@ #' desirable is if a patient did not experience an adverse event; #' the adverse event form would contain no data and the empty fields #' should not be considered missing data. -#' @param fixed_fields `character` A vector of field names that will be used as -#' the identifying fields in the output summary. This always includes the record -#' identifier (ie, the first field in the data dictionary). By default it -#' also includes any fields identified in `REDCAP_SYSTEM_FIELDS`, which -#' are fields that REDCap adds to exports to identify arms, events, etc.. -#' @param exportRecordsArgs named `list`. Arguments to pass to `exportRecords`. -#' This allows for testing specific forms, events, and/or records. Internally, any -#' setting passed for `factors, labels, dates, survey`, or `dag` -#' arguments will be ignored. #' #' @details The intention of this function is to generate a list of subject #' events that are missing and could potentially be values that should have @@ -68,8 +59,8 @@ missingSummary <- function(rcon, excludeMissingForms = TRUE, - ..., - fixed_fields = REDCAP_SYSTEM_FIELDS){ + ...) +{ UseMethod("missingSummary") } @@ -78,12 +69,8 @@ missingSummary <- function(rcon, missingSummary.redcapApiConnection <- function(rcon, excludeMissingForms = TRUE, - ..., - fixed_fields = REDCAP_SYSTEM_FIELDS, - exportRecordsArgs = list(), - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list()){ + ...) +{ coll <- checkmate::makeAssertCollection() checkmate::assert_class(x = rcon, @@ -94,47 +81,9 @@ missingSummary.redcapApiConnection <- function(rcon, len = 1, add = coll) - checkmate::assert_character(x = fixed_fields, - add = coll) - - checkmate::assert_list(x = exportRecordsArgs, - names = "named", - add = coll) - - error_handling <- checkmate::matchArg(x = error_handling, - choices = c("null", "error"), - .var.name = "error_handling", - add = coll) - - checkmate::assert_list(x = config, - names = "named", - add = coll) - - checkmate::assert_list(x = api_param, - names = "named", - add = coll) - checkmate::reportAssertions(coll) - # Import the records ---------------------------------------------- - # records will be used to store the results of tests for missingness - # records_orig will be used to conduct the tests - exportRecordsArgs <- exportRecordsArgs[!names(exportRecordsArgs) %in% c("factors", - "labels", - "dates", - "survey", - "dag", - "rcon")] - exportRecordsArgs <- c(exportRecordsArgs, - list(rcon = rcon, - factors = FALSE, - labels = TRUE, - dates = FALSE, - survey = FALSE, - dag = TRUE)) - - RecordsOrig <- do.call("exportRecords", - exportRecordsArgs) + RecordsOrig <- exportRecordsTyped(rcon, cast=list(system=castRaw),...) # Import the Meta Data -------------------------------------------- MetaData <- rcon$metadata() diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 8dd7f7c1..66a83ccc 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/redcapAPI-package.R \docType{package} \name{redcapAPI} -\alias{redcapAPI} \alias{redcapAPI-package} +\alias{redcapAPI} \title{Access data, meta data, and files from REDCap using the API} \description{ REDCap is a database development tool built on MySQL. Visit diff --git a/tests/testthat/test-356-missingSummary.R b/tests/testthat/test-356-missingSummary.R index d419737a..82836927 100644 --- a/tests/testthat/test-356-missingSummary.R +++ b/tests/testthat/test-356-missingSummary.R @@ -3,21 +3,12 @@ context("Missing Summary") DesiredOutput <- structure( list( - record_id = structure(c("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", - "11", "12", "13", "14", "15", "16", "17", "18", "19", "20"), - label = "Record ID", - class = c("labelled", "character")), - redcap_event_name = c("event_1_arm_1", "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", - "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", - "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", - "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", - "event_1_arm_1", "event_1_arm_1", "event_1_arm_1", "event_1_arm_1"), - redcap_data_access_group = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), - redcap_repeat_instrument = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), - redcap_repeat_instance = c(NA, NA, NA, NA, NA, NA, NA, NA, NA, NA, - NA, NA, NA, NA, NA, NA, NA, NA, NA, NA), + record_id = structure(as.character(1:20), + label = "Record ID"), + redcap_event_name = rep("event_1_arm_1", 20), + redcap_data_access_group = rep(NA_real_, 20), + redcap_repeat_instrument = rep(NA_real_, 20), + redcap_repeat_instance = rep(NA_character_, 20), n_missing = c(6, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 5), missing = c("row_purpose, prereq_radio, prereq_number, prereq_date, prereq_yesno, no_prereq_number", "", @@ -57,9 +48,9 @@ test_that( local_reproducible_output(width = 200) expect_identical( missingSummary(rcon, - exportRecordsArgs = list(fields = "record_id", - records = as.character(1:20), - forms = "branching_logic")), + fields = "record_id", + records = as.character(1:20), + forms = "branching_logic"), DesiredOutput ) } @@ -102,52 +93,12 @@ test_that( } ) -test_that( - "Return an error if exportRecordsArgs is not a list.", - # * return an error if exportRecordsArgs is not a named list. - # * return an error if exportRecordsArgs has elements that are not arguments to exportRecords. - { - local_reproducible_output(width = 200) - expect_error( - missingSummary(rcon, - exportRecordsArgs = "branching_logic"), - "'exportRecordsArgs': Must be of type 'list'" - ) - } -) test_that( - "Return an error if exportRecordsArgs is not a named list.", - { - local_reproducible_output(width = 200) - expect_error( - missingSummary(rcon, - exportRecordsArgs = list("branching_logic")), - "'exportRecordsArgs': Must have names" - ) - } -) - -test_that( - "Return an error if `fixed_fields` is not a character vector", - { - local_reproducible_output(width = 200) - expect_error( - missingSummary(rcon, - fixed_fields = 1:3), - "Variable 'fixed_fields': Must be of type 'character'" - ) - } -) - -test_that( - "Validate error_handling, config, api_param", + "Validate config, api_param", { local_reproducible_output(width = 200) - expect_error(missingSummary(rcon, - error_handling = "not an option"), - "'error[_]handling': Must be element of set [{]'null','error'[}]") - + expect_error(missingSummary(rcon, config = list(1)), "'config': Must have names") @@ -161,5 +112,10 @@ test_that( expect_error(missingSummary(rcon, api_param = "not a list"), "'api_param': Must be of type 'list'") + + expect_silent(missingSummary(rcon, + exportRecordsArgs = list(fields = "record_id", + records = as.character(1:20), + forms = "branching_logic"))) } ) From 379f1533cbe6832f44b2d05120b84640377769ee Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 11 Mar 2024 14:00:33 -0500 Subject: [PATCH 063/155] Minor doc bumps for #339 --- R/missingSummary.R | 3 +-- man/missingSummary.Rd | 48 +++---------------------------------------- 2 files changed, 4 insertions(+), 47 deletions(-) diff --git a/R/missingSummary.R b/R/missingSummary.R index 492b0080..656d43ca 100644 --- a/R/missingSummary.R +++ b/R/missingSummary.R @@ -111,8 +111,7 @@ missingSummary.redcapApiConnection <- function(rcon, missingSummary_offline <- function(records, meta_data, - excludeMissingForms = TRUE, - fixed_fields = REDCAP_SYSTEM_FIELDS){ + excludeMissingForms = TRUE){ coll <- checkmate::makeAssertCollection() checkmate::assert_file_exists(x = records, diff --git a/man/missingSummary.Rd b/man/missingSummary.Rd index c4b52ab7..9134babd 100644 --- a/man/missingSummary.Rd +++ b/man/missingSummary.Rd @@ -6,30 +6,11 @@ \alias{missingSummary.redcapApiConnection} \title{Report of Missing Values} \usage{ -missingSummary( - rcon, - excludeMissingForms = TRUE, - ..., - fixed_fields = REDCAP_SYSTEM_FIELDS -) +missingSummary(rcon, excludeMissingForms = TRUE, ...) -\method{missingSummary}{redcapApiConnection}( - rcon, - excludeMissingForms = TRUE, - ..., - fixed_fields = REDCAP_SYSTEM_FIELDS, - exportRecordsArgs = list(), - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list() -) +\method{missingSummary}{redcapApiConnection}(rcon, excludeMissingForms = TRUE, ...) -missingSummary_offline( - records, - meta_data, - excludeMissingForms = TRUE, - fixed_fields = REDCAP_SYSTEM_FIELDS -) +missingSummary_offline(records, meta_data, excludeMissingForms = TRUE) } \arguments{ \item{rcon}{A \code{redcapConnection} object.} @@ -43,29 +24,6 @@ should not be considered missing data.} \item{...}{Arguments to pass to other methods} -\item{fixed_fields}{\code{character} A vector of field names that will be used as -the identifying fields in the output summary. This always includes the record -identifier (ie, the first field in the data dictionary). By default it -also includes any fields identified in \code{REDCAP_SYSTEM_FIELDS}, which -are fields that REDCap adds to exports to identify arms, events, etc..} - -\item{exportRecordsArgs}{named \code{list}. Arguments to pass to \code{exportRecords}. -This allows for testing specific forms, events, and/or records. Internally, any -setting passed for \verb{factors, labels, dates, survey}, or \code{dag} -arguments will be ignored.} - -\item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. -An option for how to handle errors returned by the API. -see \code{\link[=redcapError]{redcapError()}}.} - -\item{config}{A named \code{list}. Additional configuration parameters to pass to -\code{\link[httr:POST]{httr::POST()}}. These are appended to any parameters in -\code{rcon$config}.} - -\item{api_param}{A named \code{list}. Additional API parameters to pass into the -body of the API call. This provides users to execute calls with options -that may not otherwise be supported by \code{redcapAPI}.} - \item{records}{\code{character(1)} A filename pointing to the raw records download from REDCap.} From 5bc146ffb3d69638ac608114013c791d4e354027 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 11 Mar 2024 14:25:24 -0500 Subject: [PATCH 064/155] Fixed logic in refactor of MissingSummary #339 --- R/missingSummary.R | 10 +++++----- tests/testthat/test-356-missingSummary.R | 4 ++-- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/R/missingSummary.R b/R/missingSummary.R index 656d43ca..bd58429d 100644 --- a/R/missingSummary.R +++ b/R/missingSummary.R @@ -83,7 +83,7 @@ missingSummary.redcapApiConnection <- function(rcon, checkmate::reportAssertions(coll) - RecordsOrig <- exportRecordsTyped(rcon, cast=list(system=castRaw),...) + RecordsOrig <- exportRecordsTyped(rcon, cast=raw_cast,...) # Import the Meta Data -------------------------------------------- MetaData <- rcon$metadata() @@ -178,9 +178,7 @@ missingSummary_offline <- function(records, if (!this_field %in% c(REDCAP_SYSTEM_FIELDS, meta_data$field_name[1]) & !is.null(this_logic)){ - - - + # get the name of the form on which the field is saved tmp_form <- meta_data$form_name[meta_data$field_name == sub("___[[:print:]]", "", names(records)[i])] @@ -206,6 +204,7 @@ missingSummary_offline <- function(records, no = is.na(records_orig[[i]])) } else + { # Here we have branching logic. # If the `[form]_complete` field is missing, we return FALSE # If the `[form]_complete` is non-missing: @@ -215,7 +214,8 @@ missingSummary_offline <- function(records, yes = FALSE, no = ifelse(test = with(records_orig, eval(this_logic)), yes = is.na(records_orig[[i]]), - no = FALSE)) + no = FALSE)) + } } } records diff --git a/tests/testthat/test-356-missingSummary.R b/tests/testthat/test-356-missingSummary.R index 82836927..5b5c2a70 100644 --- a/tests/testthat/test-356-missingSummary.R +++ b/tests/testthat/test-356-missingSummary.R @@ -6,8 +6,8 @@ DesiredOutput <- record_id = structure(as.character(1:20), label = "Record ID"), redcap_event_name = rep("event_1_arm_1", 20), - redcap_data_access_group = rep(NA_real_, 20), - redcap_repeat_instrument = rep(NA_real_, 20), + redcap_data_access_group = rep(NA_character_, 20), + redcap_repeat_instrument = rep(NA_character_, 20), redcap_repeat_instance = rep(NA_character_, 20), n_missing = c(6, 0, 0, 0, 1, 0, 1, 0, 1, 0, 1, 0, 1, 1, 0, 1, 0, 1, 0, 5), missing = c("row_purpose, prereq_radio, prereq_number, prereq_date, prereq_yesno, no_prereq_number", From 7d07c6def1a5ba5e0f5a75bdb84fe6e120352f48 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 11 Mar 2024 16:26:16 -0500 Subject: [PATCH 065/155] Defined usage of ... #339 --- R/missingSummary.R | 2 +- man/missingSummary.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/missingSummary.R b/R/missingSummary.R index bd58429d..98ac2878 100644 --- a/R/missingSummary.R +++ b/R/missingSummary.R @@ -5,7 +5,6 @@ #' @description Returns a data frame of subject events with missing values. #' #' @inheritParams common-rcon-arg -#' @inheritParams common-dot-args #' @inheritParams common-api-args #' @param records `character(1)` A filename pointing to the raw records #' download from REDCap. @@ -17,6 +16,7 @@ #' desirable is if a patient did not experience an adverse event; #' the adverse event form would contain no data and the empty fields #' should not be considered missing data. +#' @param ... additional arguments passed to inner call of exportRecordsTyped. #' #' @details The intention of this function is to generate a list of subject #' events that are missing and could potentially be values that should have diff --git a/man/missingSummary.Rd b/man/missingSummary.Rd index 9134babd..18469428 100644 --- a/man/missingSummary.Rd +++ b/man/missingSummary.Rd @@ -22,7 +22,7 @@ desirable is if a patient did not experience an adverse event; the adverse event form would contain no data and the empty fields should not be considered missing data.} -\item{...}{Arguments to pass to other methods} +\item{...}{additional arguments passed to inner call of exportRecordsTyped.} \item{records}{\code{character(1)} A filename pointing to the raw records download from REDCap.} From d28939240591ed8ed715a1961372ed57a6a3600d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 11 Mar 2024 16:26:55 -0500 Subject: [PATCH 066/155] Minor typeo --- NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 7c04f0b7..4cca14c5 100644 --- a/NEWS +++ b/NEWS @@ -12,7 +12,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.0 -* Refactor of missingSummary to use exportRecordsTyped. This is a breaking change in prep of 3.0.0 +* Refactor of missingSummary to use exportRecordsTyped. This is a breaking change in prep of 3.0.0. ## 2.8.5 From a2fc57464edbffa94d1adc3df92fb16a6c502ba9 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 13 Mar 2024 08:09:06 -0500 Subject: [PATCH 067/155] Minor fix to dir default #342 --- R/exportFiles.R | 8 ++++---- man/fileMethods.Rd | 12 ++++++++++-- 2 files changed, 14 insertions(+), 6 deletions(-) diff --git a/R/exportFiles.R b/R/exportFiles.R index 2bc5e64f..92aff6d1 100644 --- a/R/exportFiles.R +++ b/R/exportFiles.R @@ -5,8 +5,8 @@ exportFiles <- function(rcon, record, field, - event = NULL, - dir, + event = NULL, + dir = getwd(), file_prefix = TRUE, ...){ UseMethod("exportFiles") @@ -20,8 +20,8 @@ exportFiles.redcapApiConnection <- function(rcon, record, field, event = NULL, - dir, - file_prefix = TRUE, + dir = getwd(), + file_prefix = TRUE, repeat_instance = NULL, ..., error_handling = getOption("redcap_error_handling"), diff --git a/man/fileMethods.Rd b/man/fileMethods.Rd index 118ba885..c33e3968 100644 --- a/man/fileMethods.Rd +++ b/man/fileMethods.Rd @@ -11,7 +11,15 @@ \alias{deleteFiles.redcapApiConnection} \title{Export, Import, or Delete Files to a Field in a REDCap Project} \usage{ -exportFiles(rcon, record, field, event = NULL, dir, file_prefix = TRUE, ...) +exportFiles( + rcon, + record, + field, + event = NULL, + dir = getwd(), + file_prefix = TRUE, + ... +) importFiles( rcon, @@ -31,7 +39,7 @@ deleteFiles(rcon, record, field, event, ...) record, field, event = NULL, - dir, + dir = getwd(), file_prefix = TRUE, repeat_instance = NULL, ..., From 0130018c477d38c08daea81ccfa8a346f16315f0 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 13 Mar 2024 15:37:43 -0500 Subject: [PATCH 068/155] Proposal for #341 --- NEWS | 1 + R/exportRecordsTyped.R | 9 +++++++++ tests/testthat/test-024-unlockREDCap.R | 4 ---- 3 files changed, 10 insertions(+), 4 deletions(-) diff --git a/NEWS b/NEWS index e712e0dc..c2f600f2 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.8.5 +* Filtering empty records will use mapping if available * Minor export optimizations for records. * unlockREDCap will now search for ENV variables. * New importFileToRecord which will import a file and create the record if it doesn't exist. diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 354a6aef..24eb8907 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -219,6 +219,15 @@ exportRecordsTyped.redcapApiConnection <- unrequested_fields <- REDCAP_SYSTEM_FIELDS[!REDCAP_SYSTEM_FIELDS %in% system_fields_user_requested] Raw <- Raw[!names(Raw) %in% unrequested_fields] } + + if(!is.null(forms) && + nrow(rcon$mapping()) >0 && + "redcap_event_name" %in% names(Raw)) + { + map <- rcon$mapping() + form_events <- map$unique_event_name[map$form %in% forms] + Raw <- Raw[Raw$redcap_event_name %in% form_events,] + } # See fieldCastingFunctions.R for definition of .castRecords CastData <- .castRecords(Raw = Raw, diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index dca580d1..ddb015ca 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -265,9 +265,6 @@ test_that( test_that( ".unlockKeyring creates keyring respects user cancel", { -# skip_if(TRUE, -# "At the time of writing, testthat mock framework not working in all environments") - Sys.unsetenv("REDCAPAPI_PW") stub(.unlockKeyring, "keyring_list", data.frame(keyring=c("Elsewhere", "API_KEYs", "JoesGarage"), @@ -357,7 +354,6 @@ test_that( expect_true(x$rcon) expect_true(calls == 1) # Called to ask once expect_called(m, 1) # Called key_set_with_value once - #print(mock_args(m)[[1]]) expect_equal(mock_args(m)[[1]], list(service="redcapAPI", username="George", password="xyz", keyring="API_KEYs")) expect_called(n, 1) # Called .connectAndCheck } From 2eca3b6347ecd8578f1320a98133d41f7f9bd674 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 14 Mar 2024 09:26:17 -0500 Subject: [PATCH 069/155] Test for filter events #341 --- .../test-202-exportTypedRecords-withEvents.R | 25 +++++++++++++++++++ 1 file changed, 25 insertions(+) diff --git a/tests/testthat/test-202-exportTypedRecords-withEvents.R b/tests/testthat/test-202-exportTypedRecords-withEvents.R index da66c13f..dd4c4091 100644 --- a/tests/testthat/test-202-exportTypedRecords-withEvents.R +++ b/tests/testthat/test-202-exportTypedRecords-withEvents.R @@ -43,6 +43,31 @@ test_that( } ) + +test_that("forms with mapping are filtered", +{ + testcon <- rcon + testcon[['has_mapping']] <- function() TRUE + testcon[['mapping']] <- function() + { + data.frame( + unique_event_name = "event_2_arm_2", + form = "numbers" + ) + } + + expect_equal(nrow(exportRecordsTyped(testcon, forms="numbers", records=1:5)), 1) + + testcon[['mapping']] <- function() + { + data.frame( + unique_event_name = "event_1_arm_1", + form = "numbers" + ) + } + expect_equal(nrow(exportRecordsTyped(testcon, forms="numbers", records=1:5)), 5) +}) + ##################################################################### # Cleanup the data From ead8ba2ca3ceca8068dca0e9a7395de8d7150281 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 15 Mar 2024 09:11:10 -0500 Subject: [PATCH 070/155] Set empty strings in meta data to MA #345 --- R/importMetaData.R | 4 ++++ tests/testthat/test-002-projectSetup.R | 14 +++++++++++++- 2 files changed, 17 insertions(+), 1 deletion(-) diff --git a/R/importMetaData.R b/R/importMetaData.R index 0e3e4a44..dd6f95f5 100644 --- a/R/importMetaData.R +++ b/R/importMetaData.R @@ -79,6 +79,10 @@ importMetaData.redcapApiConnection <- function(rcon, coll$push(sprintf("The following have duplicate field names: {%s}", duplicate_field_name)) } + + + # Convert "" to NA + data[data==''] <- NA isValidFieldName(field_name = data$field_name, coll = coll) diff --git a/tests/testthat/test-002-projectSetup.R b/tests/testthat/test-002-projectSetup.R index dc502fc8..d06608c8 100644 --- a/tests/testthat/test-002-projectSetup.R +++ b/tests/testthat/test-002-projectSetup.R @@ -8,5 +8,17 @@ test_that("Metadata can be imported",{ expect_no_error( load(test_path("testdata", "test_redcapAPI_MetaData.Rdata")) ) - expect_no_error(importMetaData(rcon, test_redcapAPI_MetaData[1, ])) + + expect_no_error(importMetaData(rcon, test_redcapAPI_MetaData)) +}) + +test_that("Metadata with empty strings can be imported", +{ + expect_no_error( + load(test_path("testdata", "test_redcapAPI_MetaData.Rdata")) + ) + expect_no_error(purgeProject(rcon, purge_all = TRUE)) + data <- test_redcapAPI_MetaData[1,] + data[is.na(data)] <- '' + expect_no_error(importMetaData(rcon, data)) }) \ No newline at end of file From 7961abf37b7761081fe0664c8c5ba86580d1e778 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 15 Mar 2024 09:16:15 -0500 Subject: [PATCH 071/155] Fixed issue introduced in importMetaData test #345 --- tests/testthat/test-002-projectSetup.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-002-projectSetup.R b/tests/testthat/test-002-projectSetup.R index d06608c8..95c3ba22 100644 --- a/tests/testthat/test-002-projectSetup.R +++ b/tests/testthat/test-002-projectSetup.R @@ -9,7 +9,7 @@ test_that("Metadata can be imported",{ load(test_path("testdata", "test_redcapAPI_MetaData.Rdata")) ) - expect_no_error(importMetaData(rcon, test_redcapAPI_MetaData)) + expect_no_error(importMetaData(rcon, test_redcapAPI_MetaData[1, ])) }) test_that("Metadata with empty strings can be imported", From 9246cf2600f7773bbbfda7f4c85385d8604df689 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 15 Mar 2024 09:50:05 -0500 Subject: [PATCH 072/155] Stop on invalid field name --- R/importRecords.R | 6 +++--- .../test-150-importDeleteRecords-ArgumentValidation.R | 5 +++-- 2 files changed, 6 insertions(+), 5 deletions(-) diff --git a/R/importRecords.R b/R/importRecords.R index 1102a402..d6c01c13 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -193,7 +193,7 @@ importRecords.redcapApiConnection <- function(rcon, checkmate::assert_list(x = api_param, names = "named", add = coll) - + checkmate::reportAssertions(coll) @@ -215,9 +215,9 @@ importRecords.redcapApiConnection <- function(rcon, if (any(unrecognized_names)) { - message("The variable(s) ", + stop("The variable(s) ", paste0(names(data)[unrecognized_names], collapse=", "), - " are not found in the project and/or cannot be imported. They have been removed from the imported data frame.") + " are not found in the project and/or cannot be imported.") data <- data[!unrecognized_names] } diff --git a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R index 5cd7059d..512f7c5e 100644 --- a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R +++ b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R @@ -60,10 +60,10 @@ test_that( ) test_that( - "Return an message if a field in data is not in meta data", + "Error and stop if a field in data is not in meta data", { local_reproducible_output(width = 200) - expect_message(importRecords(rcon, + expect_error(importRecords(rcon, data = data.frame(record_id = 1, not_a_field = "xyz"), returnData = TRUE), @@ -304,5 +304,6 @@ test_that( } ) + purgeProject(rcon, purge_all = TRUE) From 49a8c287235d725298d0ee8d70fba816bffd2e76 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 15 Mar 2024 09:51:03 -0500 Subject: [PATCH 073/155] Updated news for #331 --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index e712e0dc..a89a1023 100644 --- a/NEWS +++ b/NEWS @@ -12,6 +12,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.8.5 +* importRecords stops when provided fields not in the project. * Minor export optimizations for records. * unlockREDCap will now search for ENV variables. * New importFileToRecord which will import a file and create the record if it doesn't exist. From da2cd452ec68f586e624a44fd5c1e6078cf4f920 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Wed, 20 Mar 2024 10:04:48 -0400 Subject: [PATCH 074/155] add function to export data quality queries --- R/exportDataQuality.R | 88 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 88 insertions(+) create mode 100644 R/exportDataQuality.R diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R new file mode 100644 index 00000000..31378421 --- /dev/null +++ b/R/exportDataQuality.R @@ -0,0 +1,88 @@ + +exportDataQuality <- function(rcon, + ...){ + UseMethod("exportDataQuality") +} + +exportDataQuality.redcapApiConnection <- function(rcon, + ..., + error_handling = getOption("redcap_error_handling"), + config = list(), + api_param = list()){ + ################################################################### + # Argument Validation #### + + coll <- checkmate::makeAssertCollection() + + checkmate::assert_class(x = rcon, + classes = "redcapApiConnection", + add = coll) + + error_handling <- checkmate::matchArg(x = error_handling, + choices = c("null", "error"), + .var.name = "error_handling", + add = coll) + + checkmate::assert_list(x = config, + names = "named", + add = coll) + + checkmate::assert_list(x = api_param, + names = "named", + add = coll) + + checkmate::reportAssertions(coll) + + ################################################################### + # Build the query list #### + + url <- paste0("https://redcap.vanderbilt.edu/api/?prefix=vanderbilt_dataQuality&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) + + formData <- list(token = rcon$token) + + response <- httr::POST(url, body = formData, encode = "form") + tryCatch({ + result <- httr::content(response, type = 'application/json') + + for(j in 1:length(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} + result <- as.data.frame(do.call(rbind, result)) + + if (nrow(result) > 0) { + columns <- c("status_id", "project_id", "record", "event_id", "instance", "field_name") + for (c in columns) { + result[, c] <- unlist(result[, c]) + } + + result$codes <- lapply(result$resolutions, function(rs) { + rs_df <- as.data.frame(do.call(rbind, rs)) + m <- stringr::str_match(unlist(rs_df$comment), "^([a-zA-Z]+\\d+):\\s")[, 2] + m <- m[!is.na(m)] + return(m) + }) + } + + return(result) + }, error = function(e) { + cat("Error in result: Make sure the Data Quality API module is enabled in your project.", conditionMessage(e), "\n") + }) + + + + ################################################################### + # Make the API Call #### + + response <- makeApiCall(rcon, + body = c(body, api_param), + config = config) + + if (response$status_code != 200){ + redcapError(response, + error_handling = error_handling) + } + + if (as.character(response) == ""){ + return(REDCAP_DAG_ASSIGNMENT_STRUCTURE) + } + + as.data.frame(response) +} From 710b22b65ad18dc59e9e0664785d41371fe7733b Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Wed, 20 Mar 2024 10:52:24 -0400 Subject: [PATCH 075/155] add url prefix as arg --- R/exportDataQuality.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 31378421..1ec1d7b4 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -1,10 +1,10 @@ -exportDataQuality <- function(rcon, +exportDataQuality <- function(rcon, prefix, ...){ UseMethod("exportDataQuality") } -exportDataQuality.redcapApiConnection <- function(rcon, +exportDataQuality.redcapApiConnection <- function(rcon, prefix, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -18,6 +18,10 @@ exportDataQuality.redcapApiConnection <- function(rcon, classes = "redcapApiConnection", add = coll) + checkmate::assert_class(x = prefix, + classes = "character", + add = coll) + error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -36,7 +40,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, ################################################################### # Build the query list #### - url <- paste0("https://redcap.vanderbilt.edu/api/?prefix=vanderbilt_dataQuality&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) + url <- paste0("https://redcap.vanderbilt.edu/api/?prefix=", prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) formData <- list(token = rcon$token) From 1d84ccc8aef1d1cd9e76c4119a1fa72370f9e903 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 21 Mar 2024 09:59:26 -0500 Subject: [PATCH 076/155] Tests stop if missing codes are defined. #350 --- .../testthat/helper-00-REDCapQACredentials.R | 26 ++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 4dd3b7d6..27c5fd3b 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -22,11 +22,31 @@ library(keyring) url <- "https://redcap.vanderbilt.edu/api/" # Our institutions REDCap instance conns <- unlockREDCap( - c(rcon ="TestRedcapAPI"), ## Change to rcon when satisfied with testing - # c(rcon = "DataTypes"), ## Delete this to change to primary project + #c(rcon ="TestRedcapAPI"), + c(rcon = "ShawnTest"), url=url, keyring='API_KEYs', envir=globalenv()) + ############################################################################ + # +# Uncomment to create all API Keys with names in keylocker, +# with TestRedcapAPI being ones default. This allows me to change the above +# rcon easily for my desired target. For convenience, the REPORT_IDS +# for each environment is listed as well +# +# unlockREDCap( +# c(rcon = "TestRedcapAPI", # Desired default, Sys.setenv(REPORT_IDS=NULL) +# a1 = "SandboxTest", # pid 167416, Sys.setenv(REPORT_IDS=410354) +# a2 = "QATest", # pid 167509, Sys.setenv(REPORT_IDS='357209,362756') +# a3 = "DevTest", # pid 167805, Sys.setenv(REPORT_IDS='362274,375181') +# a4 = "ExprTest", # pid 174218, Sys.setenv(REPORT_IDS='371898,371899') +# a5 = "ThomasTest", # pid 178186, Sys.setenv(REPORT_IDS='384516,384517') +# a6 = "ShawnTest", # pid 188425, Sys.setenv(REPORT_IDS=NULL +# a7 = "DQTest" # pid 133406, Sys.setenv(REPORT_IDS=417554) +# ), +# url=url, keyring='API_KEYs') +missing_codes <- rcon$projectInformation()$missing_data_codes - +if(!is.na(missing_codes) && nchar(missing_codes) > 0) + stop("The test suite will fail if missing data codes are defined in the project.") From d5715e0134815c57f57564abe2dff1c91977eb42 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 21 Mar 2024 10:01:59 -0500 Subject: [PATCH 077/155] Minor correction to report id list, #350 --- tests/testthat/helper-00-REDCapQACredentials.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 27c5fd3b..8291fd5b 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -22,8 +22,8 @@ library(keyring) url <- "https://redcap.vanderbilt.edu/api/" # Our institutions REDCap instance conns <- unlockREDCap( - #c(rcon ="TestRedcapAPI"), - c(rcon = "ShawnTest"), + c(rcon ="TestRedcapAPI"), # Your default from keyring + #c(rcon = "YourChoiceOfKeyHere"), url=url, keyring='API_KEYs', envir=globalenv()) @@ -35,14 +35,14 @@ conns <- unlockREDCap( # for each environment is listed as well # # unlockREDCap( -# c(rcon = "TestRedcapAPI", # Desired default, Sys.setenv(REPORT_IDS=NULL) +# c(rcon = "TestRedcapAPI", # Desired default, Get REPORT_ID from below list # a1 = "SandboxTest", # pid 167416, Sys.setenv(REPORT_IDS=410354) # a2 = "QATest", # pid 167509, Sys.setenv(REPORT_IDS='357209,362756') # a3 = "DevTest", # pid 167805, Sys.setenv(REPORT_IDS='362274,375181') # a4 = "ExprTest", # pid 174218, Sys.setenv(REPORT_IDS='371898,371899') # a5 = "ThomasTest", # pid 178186, Sys.setenv(REPORT_IDS='384516,384517') -# a6 = "ShawnTest", # pid 188425, Sys.setenv(REPORT_IDS=NULL -# a7 = "DQTest" # pid 133406, Sys.setenv(REPORT_IDS=417554) +# a6 = "ShawnTest", # pid 188425, Sys.setenv(REPORT_IDS=417554) +# a7 = "DQTest" # pid 133406, Sys.setenv(REPORT_IDS=NULL) # ), # url=url, keyring='API_KEYs') From d83d88201dceb6d9e80357fa1e894ad65ca56b8e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 21 Mar 2024 10:14:34 -0500 Subject: [PATCH 078/155] 3rd person pronouns in comment --- tests/testthat/helper-00-REDCapQACredentials.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 8291fd5b..b6c485ff 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -30,8 +30,8 @@ conns <- unlockREDCap( ############################################################################ # # Uncomment to create all API Keys with names in keylocker, -# with TestRedcapAPI being ones default. This allows me to change the above -# rcon easily for my desired target. For convenience, the REPORT_IDS +# with TestRedcapAPI being ones default. This allows one to change the above +# rcon easily for desired target. For convenience, the REPORT_IDS # for each environment is listed as well # # unlockREDCap( From 76b6f658316c0d2fa1c278b1163384c3a52b2546 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 21 Mar 2024 13:47:44 -0500 Subject: [PATCH 079/155] Fix for odd failure due to global envir not available in all test modes. #350 --- tests/testthat/helper-00-REDCapQACredentials.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index b6c485ff..ca49ce47 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -46,7 +46,7 @@ conns <- unlockREDCap( # ), # url=url, keyring='API_KEYs') -missing_codes <- rcon$projectInformation()$missing_data_codes +missing_codes <- conns$rcon$projectInformation()$missing_data_codes if(!is.na(missing_codes) && nchar(missing_codes) > 0) stop("The test suite will fail if missing data codes are defined in the project.") From 134bf911a7f4129de490784219d5ce3037a61ee1 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 21 Mar 2024 17:03:20 -0500 Subject: [PATCH 080/155] Fix for some metadata test issues exposed by patch. #331 --- .../test-150-importDeleteRecords-Functionality.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-150-importDeleteRecords-Functionality.R b/tests/testthat/test-150-importDeleteRecords-Functionality.R index 3809bcec..a09419e4 100644 --- a/tests/testthat/test-150-importDeleteRecords-Functionality.R +++ b/tests/testthat/test-150-importDeleteRecords-Functionality.R @@ -13,7 +13,8 @@ fields <- c("record_id", "letters_only_test", "number_test", "date_dmy_test", "left_operand", "calc_squared", "prereq_checkbox___1", "prereq_checkbox___2", "prereq_checkbox___3", "prereq_checkbox___4") -MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$field_name %in% fields, ] +MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$field_name %in% fields | + test_redcapAPI_MetaData$field_name=='prereq_checkbox' , ] ImportData <- test_redcapAPI_Data ImportData <- ImportData[1, names(ImportData) %in% fields] @@ -32,9 +33,10 @@ importProjectInformation(rcon, rcon$refresh_arms() rcon$refresh_events() +n <- length(rcon$instruments()$instrument_name) importMappings(rcon, - data = data.frame(arm_num = rep(1, 5), - unique_event_name = rep("event_1_arm_1", 5), + data = data.frame(arm_num = rep(1, n), + unique_event_name = rep("event_1_arm_1", n), form = rcon$instruments()$instrument_name)) ##################################################################### @@ -164,7 +166,7 @@ test_that( { local_reproducible_output(width = 200) importRecords(rcon, - data = ImportData) + data = ImportData[,]) require(Hmisc) TheData <- exportRecordsTyped(rcon) From c6680c425bb678e0abb115ceb2b854530c6af364 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 14:21:36 -0500 Subject: [PATCH 081/155] Changed refresh cache strategy to invalidate #331 --- DESCRIPTION | 2 +- R/fieldCastingFunctions.R | 10 +++++ R/importArms.R | 17 ++++---- R/importEvents.R | 12 ++---- R/importMappings.R | 8 +--- R/importMetaData.R | 14 +++---- R/importProjectInformation.R | 13 +++---- R/importRecords.R | 12 ++++-- R/reviewInvalidRecords.R | 2 +- man/redcapAPI.Rd | 2 +- man/reviewInvalidRecords.Rd | 2 +- ...st-150-importDeleteRecords-Functionality.R | 39 +++++++++---------- 12 files changed, 67 insertions(+), 66 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7ca953ae..c4701267 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,4 +52,4 @@ URL: https://github.com/vubiostat/redcapAPI BugReports: https://github.com/vubiostat/redcapAPI/issues Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index 921800aa..f4b45cba 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -290,6 +290,16 @@ castForImport <- function(data, checkmate::reportAssertions(coll) + # Remove mChoice variables from frame + mchoices <- vapply(data, inherits, logical(1), 'mChoice') + if(sum(mchoices) > 0) + { + message(paste0("The following mChoice variables(s) were dropped: ", + paste0(fields[mchoices], collapse=', '), '.')) + data <- data[,!mchoices, drop=FALSE] + fields <- fields[!mchoices] + } + Raw <- as.data.frame(lapply(data, function(x) trimws(as.character(x)))) diff --git a/R/importArms.R b/R/importArms.R index dfa147ac..421b2603 100644 --- a/R/importArms.R +++ b/R/importArms.R @@ -92,15 +92,14 @@ importArms.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - if (response$status_code != 200) return(redcapError(response, error_handling)) - - if (refresh && rcon$has_arms()){ - rcon$refresh_arms() - # Changes to arms can impact events and if the project is - # still considered longitudinal - rcon$refresh_events() - rcon$refresh_projectInformation() - } + rcon$flush_arms() + # Changes to arms can impact events and if the project is + # still considered longitudinal + rcon$flush_events() + rcon$flush_projectInformation() + + if (response$status_code != 200) + return(redcapError(response, error_handling)) invisible(as.character(response)) } diff --git a/R/importEvents.R b/R/importEvents.R index 038f494a..a212ae75 100644 --- a/R/importEvents.R +++ b/R/importEvents.R @@ -86,15 +86,11 @@ importEvents.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - if (response$status_code != 200) return(redcapError(response, error_handling)) + rcon$flush_events() + rcon$flush_arms() + rcon$flush_projectInformation() - if (refresh && rcon$has_events()){ - rcon$refresh_events() - # changing events can change availability of arms - # and whether a project is considered longitudinal - rcon$refresh_arms() - rcon$refresh_projectInformation() - } + if (response$status_code != 200) return(redcapError(response, error_handling)) invisible(as.character(response)) } diff --git a/R/importMappings.R b/R/importMappings.R index 739c76b9..b41fde58 100644 --- a/R/importMappings.R +++ b/R/importMappings.R @@ -89,14 +89,10 @@ importMappings.redcapApiConnection <- function(rcon, response <- makeApiCall(rcon, body = c(body, api_param), config = config) + rcon$flush_mapping() - if (response$status_code != "200"){ + if (response$status_code != "200") redcapError(response, error_handling) - } - - if (refresh && rcon$has_mapping()){ - rcon$refresh_mapping() - } invisible(as.character(response)) } diff --git a/R/importMetaData.R b/R/importMetaData.R index dd6f95f5..3fdd060c 100644 --- a/R/importMetaData.R +++ b/R/importMetaData.R @@ -139,14 +139,12 @@ importMetaData.redcapApiConnection <- function(rcon, response <- as.character(response) - if (refresh){ - if (rcon$has_metadata()){ - rcon$refresh_metadata() - } - - if (rcon$has_instruments()){ - rcon$refresh_instruments() - } + # Flush affected cache + if (refresh) + { + if (rcon$has_metadata()) rcon$refresh_metadata() + if (rcon$has_instruments()) rcon$refresh_instruments() + if (rcon$has_fieldnames()) rcon$refresh_fieldnames() } invisible(as.character(response)) diff --git a/R/importProjectInformation.R b/R/importProjectInformation.R index d7dc033e..51b1d611 100644 --- a/R/importProjectInformation.R +++ b/R/importProjectInformation.R @@ -75,18 +75,17 @@ importProjectInformation.redcapApiConnection <- function(rcon, ################################################################### # Call the API - response <- makeApiCall(rcon, body = c(body, api_param), config = config) + rcon$flush_arms() + rcon$flush_events() + rcon$flush_projectInformation() - if (response$status_code != 200) return(redcapError(response, error_handling)) - - if (refresh && rcon$has_projectInformation()){ - rcon$refresh_projectInformation() - } - + if (response$status_code != 200) + return(redcapError(response, error_handling)) + invisible(as.character(response)) } diff --git a/R/importRecords.R b/R/importRecords.R index d6c01c13..981f25af 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -208,17 +208,23 @@ importRecords.redcapApiConnection <- function(rcon, which(names(data) %in% c("redcap_survey_identifier", paste0(unique(MetaData$form_name), "_timestamp"))) - if (length(w.remove)) data <- data[-w.remove] + if (length(w.remove) > 0) data <- data[-w.remove] + + mchoices <- which(vapply(data, inherits, logical(1), 'mChoice')) + if(length(mchoices) > 0) + { + stop("The variable(s) ", + paste0(names(data)[mchoices], collapse=", "), + " are mChoice formatted and cannot be imported.") + } # Validate field names unrecognized_names <- !(names(data) %in% c(with_complete_fields, REDCAP_SYSTEM_FIELDS)) - if (any(unrecognized_names)) { stop("The variable(s) ", paste0(names(data)[unrecognized_names], collapse=", "), " are not found in the project and/or cannot be imported.") - data <- data[!unrecognized_names] } # Check that the study id exists in data diff --git a/R/reviewInvalidRecords.R b/R/reviewInvalidRecords.R index ebbdb46a..0d174b96 100644 --- a/R/reviewInvalidRecords.R +++ b/R/reviewInvalidRecords.R @@ -72,7 +72,7 @@ #' #' #' # Review Invalid data frame before import -#' RecordsForIMport <- castForImport(rcon) +#' Records <- castForImport(rcon) #' reviewInvalidRecords(Records) #' #' diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 8dd7f7c1..66a83ccc 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/redcapAPI-package.R \docType{package} \name{redcapAPI} -\alias{redcapAPI} \alias{redcapAPI-package} +\alias{redcapAPI} \title{Access data, meta data, and files from REDCap using the API} \description{ REDCap is a database development tool built on MySQL. Visit diff --git a/man/reviewInvalidRecords.Rd b/man/reviewInvalidRecords.Rd index 133e37cb..df7d80ae 100644 --- a/man/reviewInvalidRecords.Rd +++ b/man/reviewInvalidRecords.Rd @@ -76,7 +76,7 @@ reviewInvalidRecords(Records) # Review Invalid data frame before import -RecordsForIMport <- castForImport(rcon) +Records <- castForImport(rcon) reviewInvalidRecords(Records) diff --git a/tests/testthat/test-150-importDeleteRecords-Functionality.R b/tests/testthat/test-150-importDeleteRecords-Functionality.R index a09419e4..091dd1a1 100644 --- a/tests/testthat/test-150-importDeleteRecords-Functionality.R +++ b/tests/testthat/test-150-importDeleteRecords-Functionality.R @@ -16,28 +16,25 @@ fields <- c("record_id", "letters_only_test", "number_test", "date_dmy_test", MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$field_name %in% fields | test_redcapAPI_MetaData$field_name=='prereq_checkbox' , ] +importMetaData(rcon, MetaData) + ImportData <- test_redcapAPI_Data ImportData <- ImportData[1, names(ImportData) %in% fields] -importMetaData(rcon, - MetaData) - -importArms(rcon, - data = test_redcapAPI_Arms) -importEvents(rcon, - data = test_redcapAPI_Events) -importProjectInformation(rcon, - data.frame(is_longitudinal = 1)) - -rcon$refresh_arms() -rcon$refresh_events() +importArms(rcon, test_redcapAPI_Arms, refresh=FALSE) +importEvents(rcon, test_redcapAPI_Events, refresh=FALSE) +importProjectInformation(rcon, data.frame(is_longitudinal = 1)) n <- length(rcon$instruments()$instrument_name) -importMappings(rcon, - data = data.frame(arm_num = rep(1, n), - unique_event_name = rep("event_1_arm_1", n), - form = rcon$instruments()$instrument_name)) +importMappings( + rcon, + data = data.frame( + arm_num = rep(1, n), + unique_event_name = rep("event_1_arm_1", n), + form = rcon$instruments()$instrument_name + ) +) ##################################################################### # Tests @@ -162,7 +159,7 @@ test_that( ) test_that( - "mChoice fields are dropped", + "mChoice fields are handled", { local_reproducible_output(width = 200) importRecords(rcon, @@ -171,10 +168,10 @@ test_that( require(Hmisc) TheData <- exportRecordsTyped(rcon) WithMChoice <- mChoiceCast(TheData, rcon) - WithMChoice <- suppressWarnings(castForImport(WithMChoice, rcon)) - expect_message(importRecords(rcon, WithMChoice)) - TheDataAfter <- exportRecordsTyped(rcon) - expect_true(identical(TheData, TheDataAfter)) + expect_error(importRecords(rcon, WithMChoice), + ".*prereq_checkbox.*mChoice.*") + expect_message(WithMChoice <- castForImport(WithMChoice, rcon), ".*mChoice.*dropped.*prereq_checkbox.*") + expect_equal(importRecords(rcon, WithMChoice), "1") detach("package:Hmisc", unload = TRUE) } ) From 22153bf5ae7e0e52f5af41fa87191a808d1f0e8f Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 14:55:19 -0500 Subject: [PATCH 082/155] Reworked test 109 instrument methods #331 --- R/importMappings.R | 9 +--- man/mappingMethods.Rd | 3 +- ...test-109-instrumentMethods-Functionality.R | 44 ++++--------------- 3 files changed, 11 insertions(+), 45 deletions(-) diff --git a/R/importMappings.R b/R/importMappings.R index b41fde58..1b2cdf8b 100644 --- a/R/importMappings.R +++ b/R/importMappings.R @@ -3,8 +3,7 @@ #' @export importMappings <- function(rcon, - data, - refresh = TRUE, + data, ...){ UseMethod("importMappings") } @@ -15,7 +14,6 @@ importMappings <- function(rcon, importMappings.redcapApiConnection <- function(rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -33,11 +31,6 @@ importMappings.redcapApiConnection <- function(rcon, col.names = "named", add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - any.missing = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", diff --git a/man/mappingMethods.Rd b/man/mappingMethods.Rd index 9d781c8f..9f580d4a 100644 --- a/man/mappingMethods.Rd +++ b/man/mappingMethods.Rd @@ -11,7 +11,7 @@ \usage{ exportMappings(rcon, arms, ...) -importMappings(rcon, data, refresh = TRUE, ...) +importMappings(rcon, data, ...) \method{exportMappings}{redcapApiConnection}( rcon, @@ -25,7 +25,6 @@ importMappings(rcon, data, refresh = TRUE, ...) \method{importMappings}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), diff --git a/tests/testthat/test-109-instrumentMethods-Functionality.R b/tests/testthat/test-109-instrumentMethods-Functionality.R index e9c91503..e5720358 100644 --- a/tests/testthat/test-109-instrumentMethods-Functionality.R +++ b/tests/testthat/test-109-instrumentMethods-Functionality.R @@ -18,22 +18,11 @@ Events <- data.frame(event_name = c("event_1", "event_2_arm_2", "event_1_arm_2"), stringsAsFactors = FALSE) - - -importMetaData(rcon, - test_redcapAPI_MetaData) - -importArms(rcon, - data = Arms) - -importEvents(rcon, - data = Events) - -importProjectInformation(rcon, - data = data.frame(is_longitudinal = 1)) - -rcon$refresh_arms() -rcon$refresh_events() +purgeProject(rcon, purge_all = TRUE) +importMetaData(rcon, test_redcapAPI_MetaData) +importArms(rcon, data = Arms) +importEvents(rcon, data = Events) +importProjectInformation(rcon, data = data.frame(is_longitudinal = 1)) Mapping <- data.frame(arm_num = c(1, 1, 1, 2, 2, 2), unique_event_name = c("event_1_arm_1", @@ -61,8 +50,9 @@ RecordToImport <- castForImport(RecordToImport, rcon, number_1dp_comma_decimal = as.numeric, number_2dp_comma_decimal = as.numeric, bioportal = as.character)) -importRecords(rcon, - data = RecordToImport) +importRecords( + rcon, + RecordToImport[,!names(RecordToImport) %in% c("signature_test", "file_upload_test"),drop=FALSE]) ##################################################################### # exportInstruments #### @@ -100,7 +90,6 @@ test_that( # This only works because the API isn't every called for a non-longitudinal project importProjectInformation(rcon, data.frame(is_longitudinal = 0)) - rcon$flush_projectInformation() # tmp_proj <- rcon$projectInformation() # tmp_proj$is_longitudinal <- 0 @@ -109,7 +98,6 @@ test_that( nrows = 0) importProjectInformation(rcon, data.frame(is_longitudinal = 1)) - rcon$flush_projectInformation() } ) @@ -125,21 +113,7 @@ test_that( n_imported <- importMappings(rcon, ArmOneMapping) expect_equal(n_imported, as.character(nrow(ArmOneMapping))) - - expect_equal(ArmOneMapping, - rcon$mapping()) - - importMappings(rcon, - Mapping, - refresh = FALSE) - - expect_data_frame(rcon$mapping(), - nrows = nrow(ArmOneMapping)) - - rcon$refresh_mapping() - - expect_equal(Mapping, - rcon$mapping()) + expect_equal(ArmOneMapping, rcon$mapping()) } ) From 2f0738862b3b1d9c4c4fc24bca707695ac7218f7 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 16:26:38 -0500 Subject: [PATCH 083/155] More major refactoring of refresh cache strategy #331 --- R/deleteUsers.R | 12 ++------ R/docsArmsMethods.R | 5 +--- R/docsMappingMethods.R | 3 -- R/importArms.R | 7 +---- R/importUsers.R | 12 ++------ .../test-100-projectInfo-ArgumentValidation.R | 17 ----------- .../test-101-userMethods-ArgumentValidation.R | 28 ------------------- .../test-101-userMethods-Functionality.R | 13 +-------- ...t-102-userRoleMethods-ArgumentValidation.R | 14 ---------- .../test-106-armsMethods-Functionality.R | 19 ++----------- ...109-instrumentMethods-ArgumentValidation.R | 18 ------------ ...t-110-repeatingInstruments-Functionality.R | 2 -- ...0-importDeleteRecords-ArgumentValidation.R | 6 ++-- 13 files changed, 13 insertions(+), 143 deletions(-) diff --git a/R/deleteUsers.R b/R/deleteUsers.R index 2cc0e90c..cbd3e624 100644 --- a/R/deleteUsers.R +++ b/R/deleteUsers.R @@ -14,7 +14,6 @@ deleteUsers <- function(rcon, deleteUsers.redcapApiConnection <- function(rcon, users, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -33,11 +32,6 @@ deleteUsers.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -77,14 +71,12 @@ deleteUsers.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) + rcon$flush_users() + if (response$status_code != 200){ redcapError(response, error_handling = error_handling) } - if (refresh){ - rcon$refresh_users() - } - invisible(as.character(response)) } diff --git a/R/docsArmsMethods.R b/R/docsArmsMethods.R index 014f0c8a..33f67113 100644 --- a/R/docsArmsMethods.R +++ b/R/docsArmsMethods.R @@ -14,8 +14,6 @@ #' @param override `logical(1)`. By default, data will add to or modify #' existing arms data. When `TRUE`, all the existing arms data is #' deleted and replaced with the contents of `data`. -#' @param refresh `logical(1)` If `TRUE`, the cached arms data will -#' be refreshed after the API action is complete. #' @param arms `character` or `integerish` identifying the arm #' numbers to export or delete. #' @@ -98,8 +96,7 @@ armsMethods <- function(rcon, arms, data, - override, - refresh, + override, ..., error_handling, config, diff --git a/R/docsMappingMethods.R b/R/docsMappingMethods.R index 3a89b1c3..2266e726 100644 --- a/R/docsMappingMethods.R +++ b/R/docsMappingMethods.R @@ -13,8 +13,6 @@ #' given, mappings are only exported for the given arms. #' @param data `data.frame` with columns `arm_num`, `unique_event_name`, #' and `form`. See Details -#' @param refresh `logical(1)`. When `TRUE`, cached mappings in the `rcon` -#' object are refreshed after the import. #' #' @details These methods are only applicable to longitudinal projects. #' If the project information reports that the project is not longitudinal, @@ -72,7 +70,6 @@ mappingMethods <- function(rcon, arms, data, - refresh, ..., error_handling, config, diff --git a/R/importArms.R b/R/importArms.R index 421b2603..44cb00f0 100644 --- a/R/importArms.R +++ b/R/importArms.R @@ -15,8 +15,7 @@ importArms <- function(rcon, importArms.redcapApiConnection <- function(rcon, data, - override = FALSE, - refresh = TRUE, + override = FALSE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -38,10 +37,6 @@ importArms.redcapApiConnection <- function(rcon, len = 1, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", diff --git a/R/importUsers.R b/R/importUsers.R index 8db85049..18be4423 100644 --- a/R/importUsers.R +++ b/R/importUsers.R @@ -13,7 +13,6 @@ importUsers <- function(rcon, data, ...){ importUsers.redcapApiConnection <- function(rcon, data, consolidate = TRUE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -36,11 +35,6 @@ importUsers.redcapApiConnection <- function(rcon, null.ok = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = TRUE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -98,6 +92,8 @@ importUsers.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) + rcon$flush_users() + if (response$status_code != 200){ redcapError(response, error_handling = error_handling) @@ -111,10 +107,6 @@ importUsers.redcapApiConnection <- function(rcon, data = OrigUserRoleAssign[1:2]) } - if (refresh){ - rcon$refresh_users() - } - invisible(as.character(response)) } diff --git a/tests/testthat/test-100-projectInfo-ArgumentValidation.R b/tests/testthat/test-100-projectInfo-ArgumentValidation.R index 8d15e945..5ce59f35 100644 --- a/tests/testthat/test-100-projectInfo-ArgumentValidation.R +++ b/tests/testthat/test-100-projectInfo-ArgumentValidation.R @@ -62,23 +62,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - - expect_error(importProjectInformation(rcon, - data = NewInfo, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(importProjectInformation(rcon, - data = NewInfo, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-101-userMethods-ArgumentValidation.R b/tests/testthat/test-101-userMethods-ArgumentValidation.R index 577d9018..6879f283 100644 --- a/tests/testthat/test-101-userMethods-ArgumentValidation.R +++ b/tests/testthat/test-101-userMethods-ArgumentValidation.R @@ -126,20 +126,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importUsers(rcon, - data = ProjectUser, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - expect_error(importUsers(rcon, - data = ProjectUser, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) test_that( "Validate error_handling, config, api_param", @@ -193,20 +179,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(deleteUsers(rcon, - users = EXPENDABLE_USER, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - expect_error(deleteUsers(rcon, - users = EXPENDABLE_USER, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) test_that( "Validate error_handling, config, api_param", diff --git a/tests/testthat/test-101-userMethods-Functionality.R b/tests/testthat/test-101-userMethods-Functionality.R index 78b08579..f9d28fab 100644 --- a/tests/testthat/test-101-userMethods-Functionality.R +++ b/tests/testthat/test-101-userMethods-Functionality.R @@ -37,24 +37,13 @@ test_that( skip_if(!RUN_USER_TESTS, "User tests without an expendable user could have negative consequences and are not run.") - rcon$refresh_users() if (EXPENDABLE_USER %in% rcon$users()$username){ deleteUsers(rcon, users = EXPENDABLE_USER) } - rcon$refresh_users() - - # refresh argument works as intended - importUsers(rcon, - data = data.frame(username = EXPENDABLE_USER), - refresh = FALSE) - - expect_false(EXPENDABLE_USER %in% rcon$users()$username) - importUsers(rcon, - data = data.frame(username = EXPENDABLE_USER), - refresh = TRUE) + data = data.frame(username = EXPENDABLE_USER)) expect_true(EXPENDABLE_USER %in% rcon$users()$username) diff --git a/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R b/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R index 4a355711..17e01666 100644 --- a/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R +++ b/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R @@ -104,20 +104,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importUserRoles(rcon, - data = REDCAP_USER_ROLE_STRUCTURE, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - expect_error(importUserRoles(rcon, - data = REDCAP_USER_ROLE_STRUCTURE, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) test_that( "Validate error_handling, config, api_param", diff --git a/tests/testthat/test-106-armsMethods-Functionality.R b/tests/testthat/test-106-armsMethods-Functionality.R index 22afada9..6ec46fa6 100644 --- a/tests/testthat/test-106-armsMethods-Functionality.R +++ b/tests/testthat/test-106-armsMethods-Functionality.R @@ -51,7 +51,6 @@ test_that( purgeProject(rcon, arms = TRUE, events = TRUE) -rcon$flush_all() test_that( "Import arms into a empty project.", @@ -67,9 +66,7 @@ test_that( arms_data = Arms) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - expect_equal(rcon$projectInformation()$is_longitudinal, - 0) + expect_equal(rcon$projectInformation()$is_longitudinal, 0) # Because we aren't yet longitudinal, we don't want arms back yet. expect_equal(exportArms(rcon), @@ -80,8 +77,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - # We haven't allowed the project to use arms/events, so it should # still not be longitudinal, even though we've uploaded arms and events. expect_equal(rcon$projectInformation()$is_longitudinal, @@ -105,9 +100,6 @@ test_that( expect_equal(exportEvents(rcon)[1:2], # we didn't provide a full specification for Events Events) - rcon$refresh_arms() - rcon$refresh_events() - # And now we clean up from our testing. purgeProject(rcon, @@ -154,19 +146,14 @@ test_that( # export the Arms and compare output with what was imported expect_equal(exportArms(rcon), Arms) - - rcon$refresh_arms() - + # delete the Arms n_deleted <- deleteArms(rcon, arms = 1:3) expect_equal(n_deleted, "3") - rcon$refresh_projectInformation() - # Now the project should no longer be considered longitudinal - expect_equal(rcon$projectInformation()$is_longitudinal, - 0) + expect_equal(rcon$projectInformation()$is_longitudinal, 0) } ) diff --git a/tests/testthat/test-109-instrumentMethods-ArgumentValidation.R b/tests/testthat/test-109-instrumentMethods-ArgumentValidation.R index 961674ec..aa4f128f 100644 --- a/tests/testthat/test-109-instrumentMethods-ArgumentValidation.R +++ b/tests/testthat/test-109-instrumentMethods-ArgumentValidation.R @@ -116,8 +116,6 @@ importEvents(rcon, importProjectInformation(rcon, data = data.frame(is_longitudinal = 1)) -rcon$refresh_arms() -rcon$refresh_events() test_that( "Return an error if rcon is not a redcapConnection", @@ -181,22 +179,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importMappings(rcon = rcon, - data = rcon$mapping(), - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - expect_error(importMappings(rcon = rcon, - data = rcon$mapping(), - refresh = c(FALSE, TRUE)), - "'refresh': Must have length 1") - } -) - - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-110-repeatingInstruments-Functionality.R b/tests/testthat/test-110-repeatingInstruments-Functionality.R index 7112a7cb..141aae7c 100644 --- a/tests/testthat/test-110-repeatingInstruments-Functionality.R +++ b/tests/testthat/test-110-repeatingInstruments-Functionality.R @@ -83,8 +83,6 @@ test_that( purgeProject(rcon, arms = TRUE, events = TRUE) -rcon$refresh_arms() -rcon$refresh_events() test_that( "Functionality on a test with no events or arms", diff --git a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R index 512f7c5e..99a70d93 100644 --- a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R +++ b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R @@ -5,6 +5,9 @@ load(file.path(test_path("testdata"), load(file.path(test_path("testdata"), "test_redcapAPI_Data.Rdata")) +purgeProject(rcon, + purge_all = TRUE) + fields <- c("record_id", "letters_only_test", "number_test", "date_dmy_test", "left_operand", "calc_squared") MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$field_name %in% fields, ] @@ -27,9 +30,6 @@ importEvents(rcon, importProjectInformation(rcon, data.frame(is_longitudinal = 1)) -rcon$refresh_arms() -rcon$refresh_events() - importMappings(rcon, data = data.frame(arm_num = rep(1, 5), unique_event_name = rep("event_1_arm_1", 5), From d3a96e40911cd8d2325285dc1c202f4d42c307a0 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 17:00:46 -0500 Subject: [PATCH 084/155] Bull in China shop edit #331, ripped out most of refresh --- R/deleteArms.R | 20 +++-------- R/deleteDags.R | 15 ++------- R/deleteEvents.R | 18 +++------- R/deleteUserRoles.R | 12 ++----- R/docsDagMethods.R | 3 -- R/docsEventMethods.R | 3 -- R/docsFromFileRepository.R | 5 +-- R/docsMetaDataMethods.R | 5 +-- R/docsProjectInformationMethods.R | 5 +-- R/docsRepeatingInstrumentEventMethods.R | 6 +--- R/docsUserMethods.R | 5 +-- R/docsUserRoleAssignmentMethods.R | 5 +-- R/docsUserRoleMethods.R | 3 +- R/importDags.R | 15 ++------- R/importEvents.R | 7 +--- R/importMetaData.R | 18 +++------- R/importProjectInformation.R | 8 +---- R/importRepeatingInstrumentsEvents.R | 15 +++------ R/importUserRoleAssignments.R | 15 ++------- R/importUserRoles.R | 21 ++++-------- R/switchDag.R | 18 +++------- .../test-102-userRoleMethods-Functionality.R | 2 -- ...RoleAssignmentMethods-ArgumentValidation.R | 1 - ...-userRoleAssignmentMethods-Functionality.R | 1 - .../test-106-armsMethods-ArgumentValidation.R | 33 ------------------- .../test-106-armsMethods-Functionality.R | 25 +++----------- ...est-107-eventsMethods-ArgumentValidation.R | 32 ------------------ .../test-107-eventsMethods-Functionality.R | 23 +++---------- ...t-108-metadataMethods-ArgumentValidation.R | 17 ---------- .../test-108-metadataMethods-Functionality.R | 16 +-------- ...-repeatingInstruments-ArgumentValidation.R | 16 --------- ...t-110-repeatingInstruments-Functionality.R | 8 ----- .../test-111-switchDag-ArgumentValidation.R | 15 --------- ...st-150-importDeleteRecords-Functionality.R | 10 ++---- ...est-200-exportTypedRecords-Functionality.R | 6 +--- ...ortTypedRecords-withRepeatingInstruments.R | 3 -- tests/testthat/test-354-getProjectIdFields.R | 4 --- 37 files changed, 58 insertions(+), 376 deletions(-) diff --git a/R/deleteArms.R b/R/deleteArms.R index b4deb3e9..c0e76dbf 100644 --- a/R/deleteArms.R +++ b/R/deleteArms.R @@ -14,8 +14,7 @@ deleteArms <- function(rcon, #' @export deleteArms.redcapApiConnection <- function(rcon, - arms, - refresh = TRUE, + arms, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -32,10 +31,6 @@ deleteArms.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -70,24 +65,17 @@ deleteArms.redcapApiConnection <- function(rcon, ################################################################### # Call the API - if (length(arms) > 0){ # Skip the call if there are no arms to delete response <- makeApiCall(rcon, body = c(body, api_param), config = config) - + rcon$flush_arms() + rcon$flush_events() + rcon$flush_projectInformation() if (response$status_code != 200) return(redcapError(response, error_handling)) } else { response <- "0" } - if (refresh && rcon$has_arms()){ - rcon$refresh_arms() - # Changes to arms can impact events and if the project is - # still considered longitudinal - rcon$refresh_events() - rcon$refresh_projectInformation() - } - invisible(as.character(response)) } diff --git a/R/deleteDags.R b/R/deleteDags.R index 95188eeb..f376905f 100644 --- a/R/deleteDags.R +++ b/R/deleteDags.R @@ -15,7 +15,6 @@ deleteDags <- function(rcon, deleteDags.redcapApiConnection <- function(rcon, dags, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -34,12 +33,6 @@ deleteDags.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - any.missing = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -78,12 +71,8 @@ deleteDags.redcapApiConnection <- function(rcon, response <- makeApiCall(rcon, body = c(body, api_param), config = config) - + rcon$flush_dags() if (response$status_code != 200) return(redcapError(response, error_handling)) - - if (refresh){ - rcon$refresh_dags() - } - + invisible(as.character(response)) } diff --git a/R/deleteEvents.R b/R/deleteEvents.R index 46ccff16..2a2256e1 100644 --- a/R/deleteEvents.R +++ b/R/deleteEvents.R @@ -13,8 +13,7 @@ deleteEvents <- function(rcon, #' @export deleteEvents.redcapApiConnection <- function(rcon, - events = NULL, - refresh = TRUE, + events = NULL, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -33,10 +32,6 @@ deleteEvents.redcapApiConnection <- function(rcon, null.ok = TRUE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -67,16 +62,11 @@ deleteEvents.redcapApiConnection <- function(rcon, response <- makeApiCall(rcon, body = c(body, api_param), config = config) + rcon$flush_events() + rcon$flush_arms() + rcon$flush_projectInformation() if (response$status_code != 200) return(redcapError(response, error_handling)) - if (refresh && rcon$has_events()){ - rcon$refresh_events() - # changing events can change availability of arms - # and whether a project is considered longitudinal - rcon$refresh_arms() - rcon$refresh_projectInformation() - } - invisible(as.character(response)) } diff --git a/R/deleteUserRoles.R b/R/deleteUserRoles.R index 5fb84575..68bcb3f1 100644 --- a/R/deleteUserRoles.R +++ b/R/deleteUserRoles.R @@ -14,7 +14,6 @@ deleteUserRoles <- function(rcon, deleteUserRoles.redcapApiConnection <- function(rcon, user_roles, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -33,11 +32,6 @@ deleteUserRoles.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -77,14 +71,12 @@ deleteUserRoles.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) + rcon$flush_user_roles() + if (response$status_code != 200){ redcapError(response, error_handling = error_handling) } - if (refresh){ - rcon$refresh_user_roles() - } - invisible(as.character(response)) } diff --git a/R/docsDagMethods.R b/R/docsDagMethods.R index 265367d8..1765f41c 100644 --- a/R/docsDagMethods.R +++ b/R/docsDagMethods.R @@ -11,8 +11,6 @@ #' @param data A `data.frame` with two columns: `data_access_group_name` #' and `unique_group_name`. #' @param dags `character` vector of names matching the `unique_group_name`. -#' @param refresh `logical(1)`. When `TRUE`, cached data access -#' group data will be refreshed after the import. #' #' @details To import new data access groups, the user must provide a value for #' `data_access_group_name` with no value (`NA`) for `unique_group_name`. @@ -75,7 +73,6 @@ dagMethods <- function(rcon, dags, data, - refresh, ..., error_handling, config, diff --git a/R/docsEventMethods.R b/R/docsEventMethods.R index 31ac4b3e..6ff4af5f 100644 --- a/R/docsEventMethods.R +++ b/R/docsEventMethods.R @@ -20,8 +20,6 @@ #' @param override `logical(1)`. By default, data will add to or modify #' existing arms data. When `TRUE`, all the existing arms data is #' deleted and replaced with the contents of `data`. -#' @param refresh `logical(1)`. When `TRUE`, the cached arms data will -#' be refreshed after the API action is complete. #' #' @details #' Exporting events is not supported for classical REDCap projects. If @@ -120,7 +118,6 @@ eventsMethods <- function(rcon, events, data, override, - refresh, ..., error_handling, config, diff --git a/R/docsFromFileRepository.R b/R/docsFromFileRepository.R index 4bac133b..b2b3dc9e 100644 --- a/R/docsFromFileRepository.R +++ b/R/docsFromFileRepository.R @@ -18,8 +18,6 @@ #' @param dir_create `logical(1)`. Create the directory `dir` #' if it does not already exist. Defaults to `FALSE`. #' If `dir` does not exist and `create = FALSE`, an error is thrown. -#' @param refresh `logical(1)` When `TRUE`, the cached -#' File Repository data on `rcon` will be refreshed. #' #' @details When a file is deleted, the file will remain in the Recycle Bin #' folder for up to 30 days. @@ -84,8 +82,7 @@ fromFileRepositoryMethods <- function(rcon, folder_id, file, dir, - dir_create, - refresh, + dir_create, ..., error_handling, config, diff --git a/R/docsMetaDataMethods.R b/R/docsMetaDataMethods.R index b0bed41a..a72beac1 100644 --- a/R/docsMetaDataMethods.R +++ b/R/docsMetaDataMethods.R @@ -16,8 +16,6 @@ #' not. Form names should match those in the second column of the data #' dictionary, and not the display names shown on the web interface. #' @param data `data.frame` with the Meta Data to import. -#' @param refresh `logical(1)`. When `TRUE`, the cached metadata -#' and instruments will be refreshed after the import. #' @param field_types `character` giving the acceptable field types #' when validating the `field_type` column. This #' @param validation_types `character` giving the acceptable values @@ -119,8 +117,7 @@ metaDataMethodsArgs <- function(rcon, fields, forms, - data, - refresh, + data, ..., field_types, validation_types, diff --git a/R/docsProjectInformationMethods.R b/R/docsProjectInformationMethods.R index f132b473..fb3c1ffb 100644 --- a/R/docsProjectInformationMethods.R +++ b/R/docsProjectInformationMethods.R @@ -10,8 +10,6 @@ #' @inheritParams common-api-args #' @param data `data.frame` with only one row and any subset of allowable fields to be #' updated. See Details. -#' @param refresh `logical(1)`. If `TRUE`, the cached project information -#' will be updated after the import. #' #' @details #' When importing, fields that are not editable will be quietly removed prior to @@ -112,8 +110,7 @@ #' @order 0 projectInformationMethods <- function(rcon, - data, - refresh, + data, ..., error_handling, config, diff --git a/R/docsRepeatingInstrumentEventMethods.R b/R/docsRepeatingInstrumentEventMethods.R index f0e42e3f..20991421 100644 --- a/R/docsRepeatingInstrumentEventMethods.R +++ b/R/docsRepeatingInstrumentEventMethods.R @@ -11,9 +11,6 @@ #' @param data `data.frame`. For classical projects, it must have the #' columns `form_name` and `custom_form_label`. Longitudinal #' projects also require a column for `event_name`. -#' @param refresh `logical(1)`. When `TRUE`, the cached -#' value of repeating instruments and events on `rcon` will be -#' refreshed. #' #' @details Repeating events (as opposed to repeating instruments) are #' provided as a row of data where the `form_name` column is `NA`. @@ -63,8 +60,7 @@ #' @order 0 repeatingInstrumentEventMethods <- function(rcon, - data, - refresh, + data, ..., error_handling, config, diff --git a/R/docsUserMethods.R b/R/docsUserMethods.R index 166a7aa4..ba4407e3 100644 --- a/R/docsUserMethods.R +++ b/R/docsUserMethods.R @@ -22,8 +22,6 @@ #' @param consolidate `logical(1)`. When `TRUE`, the form and data #' export access values will be read from the expanded columns. Otherwise, #' the consolidated values (as provided by the API export) are utilized. -#' @param refresh `logical(1)`. When `TRUE`, the cached data will -#' be refreshed after the API action is complete. #' #' @details #' User project access fields (those not related to forms or exports) @@ -184,8 +182,7 @@ userMethods <- function(rcon, form_rights, users, data, - consolidate, - refresh, + consolidate, ..., error_handling, config, diff --git a/R/docsUserRoleAssignmentMethods.R b/R/docsUserRoleAssignmentMethods.R index 038858e3..6f4e9db9 100644 --- a/R/docsUserRoleAssignmentMethods.R +++ b/R/docsUserRoleAssignmentMethods.R @@ -11,8 +11,6 @@ #' `unique_role_name`. Each `username` must be unique. #' Users without a `unique_role_name` will not be assigned to #' a user role. -#' @param refresh `logical(1)`. When `TRUE`, the cached value -#' in `rcon` will be refreshed after the import. #' #' @return #' `exportUserRoleAssignments` returns a data frame with the columns: @@ -55,8 +53,7 @@ #' @order 0 userRoleAssignmentMethods <- function(rcon, - data, - refresh, + data, ..., error_handling, config, diff --git a/R/docsUserRoleMethods.R b/R/docsUserRoleMethods.R index 09c72d7c..a4d2e812 100644 --- a/R/docsUserRoleMethods.R +++ b/R/docsUserRoleMethods.R @@ -113,8 +113,7 @@ userRoleMethods <- function(rcon, form_rights, user_roles, data, - consolidate, - refresh, + consolidate, ..., error_handling, config, diff --git a/R/importDags.R b/R/importDags.R index 7eb17b55..8d075c1f 100644 --- a/R/importDags.R +++ b/R/importDags.R @@ -13,8 +13,7 @@ importDags <- function(rcon, #' @export importDags.redcapApiConnection <- function(rcon, - data, - refresh = TRUE, + data, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -32,12 +31,6 @@ importDags.redcapApiConnection <- function(rcon, col.names = "named", add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - any.missing = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -89,11 +82,9 @@ importDags.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - if (response$status_code != 200) return(redcapError(response, error_handling)) + rcon$flush_dags() - if (refresh){ - rcon$refresh_dags() - } + if (response$status_code != 200) return(redcapError(response, error_handling)) invisible(as.character(response)) } diff --git a/R/importEvents.R b/R/importEvents.R index a212ae75..0f6bec92 100644 --- a/R/importEvents.R +++ b/R/importEvents.R @@ -15,8 +15,7 @@ importEvents <- function(rcon, importEvents.redcapApiConnection <- function(rcon, data, - override = FALSE, - refresh = TRUE, + override = FALSE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -42,10 +41,6 @@ importEvents.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", diff --git a/R/importMetaData.R b/R/importMetaData.R index 3fdd060c..defe5bda 100644 --- a/R/importMetaData.R +++ b/R/importMetaData.R @@ -13,7 +13,6 @@ importMetaData <- function(rcon, importMetaData.redcapApiConnection <- function(rcon, data, - refresh = TRUE, ..., field_types = REDCAP_METADATA_FIELDTYPE, # see redcapDataStructure validation_types = REDCAP_METADATA_VALIDATION_TYPE, # see redcapDataStructure @@ -32,11 +31,6 @@ importMetaData.redcapApiConnection <- function(rcon, checkmate::assert_data_frame(x = data, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - any.missing = FALSE, - add = coll) - checkmate::assert_character(x = field_types, add = coll) @@ -137,15 +131,11 @@ importMetaData.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - response <- as.character(response) + rcon$flush_metadata() + rcon$flush_instruments() + rcon$flush_fieldnames() - # Flush affected cache - if (refresh) - { - if (rcon$has_metadata()) rcon$refresh_metadata() - if (rcon$has_instruments()) rcon$refresh_instruments() - if (rcon$has_fieldnames()) rcon$refresh_fieldnames() - } + response <- as.character(response) invisible(as.character(response)) } diff --git a/R/importProjectInformation.R b/R/importProjectInformation.R index 51b1d611..54d83fb9 100644 --- a/R/importProjectInformation.R +++ b/R/importProjectInformation.R @@ -13,8 +13,7 @@ importProjectInformation <- function(rcon, #' @export importProjectInformation.redcapApiConnection <- function(rcon, - data, - refresh = TRUE, + data, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -33,11 +32,6 @@ importProjectInformation.redcapApiConnection <- function(rcon, nrows = 1, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - any.missing = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", diff --git a/R/importRepeatingInstrumentsEvents.R b/R/importRepeatingInstrumentsEvents.R index d79e1ac0..aa2d1079 100644 --- a/R/importRepeatingInstrumentsEvents.R +++ b/R/importRepeatingInstrumentsEvents.R @@ -13,8 +13,7 @@ importRepeatingInstrumentsEvents <- function(rcon, #' @export importRepeatingInstrumentsEvents.redcapApiConnection <- function(rcon, - data, - refresh = TRUE, + data, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -32,10 +31,6 @@ importRepeatingInstrumentsEvents.redcapApiConnection <- function(rcon, col.names = "named", add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -74,12 +69,10 @@ importRepeatingInstrumentsEvents.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - if (response$status_code != 200) return(redcapError(response, error_handling)) + rcon$flush_projectInformation() + rcon$flush_repeatInstrumentEvent() - if (refresh && rcon$has_repeatInstrumentEvent()){ - rcon$refresh_projectInformation() - rcon$refresh_repeatInstrumentEvent() - } + if (response$status_code != 200) return(redcapError(response, error_handling)) invisible(as.character(response)) } diff --git a/R/importUserRoleAssignments.R b/R/importUserRoleAssignments.R index cc148c71..76a8b883 100644 --- a/R/importUserRoleAssignments.R +++ b/R/importUserRoleAssignments.R @@ -14,7 +14,6 @@ importUserRoleAssignments <- function(rcon, importUserRoleAssignments.redcapApiConnection <- function(rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -32,12 +31,6 @@ importUserRoleAssignments.redcapApiConnection <- function(rcon, col.names = "named", add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - any.missing = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -102,15 +95,13 @@ importUserRoleAssignments.redcapApiConnection <- function(rcon, body = body, config = config) + rcon$flush_users() + rcon$flush_user_role_assignment() + if (response$status_code != 200){ redcapError(response, error_handling = error_handling) } - if (refresh){ - rcon$refresh_user_role_assignment() - rcon$refresh_users() - } - invisible(as.character(response)) } diff --git a/R/importUserRoles.R b/R/importUserRoles.R index 592f6956..0bc10257 100644 --- a/R/importUserRoles.R +++ b/R/importUserRoles.R @@ -15,7 +15,6 @@ importUserRoles <- function(rcon, importUserRoles.redcapApiConnection <- function(rcon, data, consolidate = TRUE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -38,11 +37,6 @@ importUserRoles.redcapApiConnection <- function(rcon, null.ok = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - null.ok = FALSE, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -87,21 +81,18 @@ importUserRoles.redcapApiConnection <- function(rcon, response <- makeApiCall(rcon, body = c(body, api_param), config = config) - + if (response$status_code != 200){ redcapError(response, error_handling = error_handling) } - if (refresh) + # From REDCap 14.0.2 forward, caching can sometimes catch an NA role pre-definition + roles <- c(NA) + while(length(roles > 0) && any(is.na(roles))) { - # From REDCap 14.0.2 forward, caching can sometimes catch an NA role pre-definition - roles <- c(NA) - while(length(roles > 0) && any(is.na(roles))) - { - rcon$refresh_user_roles() - roles <- rcon$user_roles()$unique_role_name - } + rcon$refresh_user_roles() + roles <- rcon$user_roles()$unique_role_name } invisible(as.character(response)) diff --git a/R/switchDag.R b/R/switchDag.R index 5c2a6fd9..0d244cba 100644 --- a/R/switchDag.R +++ b/R/switchDag.R @@ -11,8 +11,6 @@ #' @inheritParams common-api-args #' @param dag `character(1)` A unique data access group to which to #' assign the current user. Use `NA` to leave the user unassigned. -#' @param refresh `logical(1)` If `TRUE`, the cached data access -#' group assignments will be refreshed. #' #' @return Invisibly returns `TRUE` when the call is completed successfully. #' Otherwise an error is thrown. @@ -39,8 +37,7 @@ #' @order 0 # dummy function to control the order of arguments in the help file. switchDagArgs <- function(rcon, - dag, - refresh, + dag, ..., error_handling, config, @@ -61,8 +58,7 @@ switchDag <- function(rcon, #' @export switchDag.redcapApiConnection <- function(rcon, - dag, - refresh = TRUE, + dag, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -82,10 +78,6 @@ switchDag.redcapApiConnection <- function(rcon, any.missing = TRUE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -125,14 +117,12 @@ switchDag.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) + rcon$flush_dag_assignment() + if (response$status_code != 200) return(redcapError(response, error_handling)) success <- isTRUE(as.character(response) == "1") - if (refresh){ - rcon$refresh_dag_assignment() - } - if (!success) { message(as.character(response)) } diff --git a/tests/testthat/test-102-userRoleMethods-Functionality.R b/tests/testthat/test-102-userRoleMethods-Functionality.R index e7fba2af..879c4996 100644 --- a/tests/testthat/test-102-userRoleMethods-Functionality.R +++ b/tests/testthat/test-102-userRoleMethods-Functionality.R @@ -49,8 +49,6 @@ test_that( expect_equal(as.character(UserRoles$reports), "Access") - rcon$refresh_user_roles() - rcon$user_roles() nroles <- nrow(rcon$user_roles()) # Cleanup by deleting the user role n_deleted <- deleteUserRoles(rcon, diff --git a/tests/testthat/test-103-userRoleAssignmentMethods-ArgumentValidation.R b/tests/testthat/test-103-userRoleAssignmentMethods-ArgumentValidation.R index 5dedc9d1..808ffec7 100644 --- a/tests/testthat/test-103-userRoleAssignmentMethods-ArgumentValidation.R +++ b/tests/testthat/test-103-userRoleAssignmentMethods-ArgumentValidation.R @@ -85,7 +85,6 @@ test_that( importUserRoles(rcon, NewRole) - rcon$refresh_user_roles() the_role <- rcon$user_roles()$unique_role_name ImportAssignmentTest <- diff --git a/tests/testthat/test-103-userRoleAssignmentMethods-Functionality.R b/tests/testthat/test-103-userRoleAssignmentMethods-Functionality.R index 72b7eecb..06e24611 100644 --- a/tests/testthat/test-103-userRoleAssignmentMethods-Functionality.R +++ b/tests/testthat/test-103-userRoleAssignmentMethods-Functionality.R @@ -29,7 +29,6 @@ test_that( importUserRoles(rcon, NewRole) - rcon$refresh_user_roles() the_role <- rcon$user_roles()$unique_role_name ImportAssignmentTest <- diff --git a/tests/testthat/test-106-armsMethods-ArgumentValidation.R b/tests/testthat/test-106-armsMethods-ArgumentValidation.R index bf6acd6e..4b9d358e 100644 --- a/tests/testthat/test-106-armsMethods-ArgumentValidation.R +++ b/tests/testthat/test-106-armsMethods-ArgumentValidation.R @@ -107,22 +107,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importArms(rcon, - Arms, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(importArms(rcon, - Arms, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) - test_that( "Return an error when error handling isn't one of null, error", { @@ -176,23 +160,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - - expect_error(deleteArms(rcon, - arms = 1, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(deleteArms(rcon, - arms = 1, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-106-armsMethods-Functionality.R b/tests/testthat/test-106-armsMethods-Functionality.R index 6ec46fa6..9ecb8645 100644 --- a/tests/testthat/test-106-armsMethods-Functionality.R +++ b/tests/testthat/test-106-armsMethods-Functionality.R @@ -137,8 +137,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - # The project should now be recognized as longitudinal expect_equal(rcon$projectInformation()$is_longitudinal, 1) @@ -163,8 +161,7 @@ test_that( "Test the override argument in importArms", { local_reproducible_output(width = 200) - - rcon$refresh_projectInformation() + # start from an empty project with no arms. It should be recognized as a classical project. expect_equal(rcon$projectInformation()$is_longitudinal, 0) @@ -178,8 +175,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - expect_equal(exportArms(rcon), Arms) @@ -193,15 +188,10 @@ test_that( data = Events2) expect_equal(n_imported, "2") - rcon$refresh_projectInformation() - expect_equal(exportArms(rcon), Arms2) - - # Now Clean up from the test - rcon$refresh_arms() n_deleted <- deleteArms(rcon, arms = 10:11) expect_equal(n_deleted, "2") } @@ -212,8 +202,7 @@ test_that( "Confirm that we can add additional arms and delete specific arms", { local_reproducible_output(width = 200) - - rcon$refresh_projectInformation() + # start from an empty project with no arms. It should be recognized as a classical project. expect_equal(rcon$projectInformation()$is_longitudinal, 0) @@ -227,8 +216,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - expect_equal(exportArms(rcon), Arms) @@ -240,15 +227,11 @@ test_that( n_imported <- importEvents(rcon, data = Events2) expect_equal(n_imported, "2") - - rcon$refresh_projectInformation() - + # Confirm that all of the arms are present. expect_equal(exportArms(rcon), rbind(Arms, Arms2)) - - rcon$refresh_arms() - + # Delete only arms 3 and 10 n_deleted <- deleteArms(rcon, diff --git a/tests/testthat/test-107-eventsMethods-ArgumentValidation.R b/tests/testthat/test-107-eventsMethods-ArgumentValidation.R index 0a95bce3..2168ef1c 100644 --- a/tests/testthat/test-107-eventsMethods-ArgumentValidation.R +++ b/tests/testthat/test-107-eventsMethods-ArgumentValidation.R @@ -118,22 +118,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importEvents(rcon, - Events, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(importEvents(rcon, - Events, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) - test_that( "Return an error when error handling isn't one of null, error", { @@ -187,22 +171,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - - expect_error(deleteEvents(rcon, - Events, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(deleteEvents(rcon, - Events, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) test_that( "Validate error_handling, config, api_param", diff --git a/tests/testthat/test-107-eventsMethods-Functionality.R b/tests/testthat/test-107-eventsMethods-Functionality.R index cfd4433e..fa4a280c 100644 --- a/tests/testthat/test-107-eventsMethods-Functionality.R +++ b/tests/testthat/test-107-eventsMethods-Functionality.R @@ -48,9 +48,7 @@ test_that( n_imported <- importEvents(rcon, data = Events) expect_equal(n_imported, "3") - - rcon$refresh_projectInformation() - + # The project should now be recognized as longitudinal expect_equal(rcon$projectInformation()$is_longitudinal, 1) @@ -77,9 +75,7 @@ test_that( "event_1_arm_2", "event_1_arm_3")) expect_equal(n_deleted, "3") - - rcon$refresh_projectInformation() - + # Now the project should no longer be considered longitudinal expect_equal(rcon$projectInformation()$is_longitudinal, 0) @@ -93,7 +89,6 @@ test_that( { local_reproducible_output(width = 200) - rcon$refresh_projectInformation() # start from an empty project with no arms. It should be recognized as a classical project. expect_equal(rcon$projectInformation()$is_longitudinal, 0) @@ -107,8 +102,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - expect_data_frame(exportEvents(rcon), ncols = 5, nrows = 3) @@ -124,9 +117,7 @@ test_that( data = OverrideEvent, override = TRUE) expect_equal(n_imported, "3") - - rcon$refresh_events() - + expect_equal(rcon$events()$event_name, c("event_10", "event_11", "event_12")) @@ -136,7 +127,6 @@ test_that( # Now Clean up from the test - rcon$refresh_arms() n_deleted <- deleteArms(rcon, arms = 1:3) expect_equal(n_deleted, "3") } @@ -147,8 +137,7 @@ test_that( "Confirm that we can add additional events and delete specific events", { local_reproducible_output(width = 200) - - rcon$refresh_projectInformation() + # start from an empty project with no arms. It should be recognized as a classical project. expect_equal(rcon$projectInformation()$is_longitudinal, 0) @@ -162,8 +151,6 @@ test_that( data = Events) expect_equal(n_imported, "3") - rcon$refresh_projectInformation() - expect_data_frame(exportEvents(rcon), ncols = 5, nrows = 3) @@ -182,8 +169,6 @@ test_that( ncols = 5, nrows = 5) - rcon$refresh_arms() - rcon$refresh_events() # Delete only arms 3 and 10 n_deleted <- deleteEvents(rcon, diff --git a/tests/testthat/test-108-metadataMethods-ArgumentValidation.R b/tests/testthat/test-108-metadataMethods-ArgumentValidation.R index 1c7e019b..56c3249a 100644 --- a/tests/testthat/test-108-metadataMethods-ArgumentValidation.R +++ b/tests/testthat/test-108-metadataMethods-ArgumentValidation.R @@ -81,23 +81,6 @@ test_that( } ) -test_that( - "Return an error when refresh is not a logical(1)", - { - local_reproducible_output(width = 200) - - expect_error(importMetaData(rcon, - data = REDCAP_METADATA_STRUCTURE, - refresh = "FALSE"), - "'refresh': Must be of type 'logical'") - - expect_error(importMetaData(rcon, - data = REDCAP_METADATA_STRUCTURE, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) - test_that( "Return an error when field_types is not character", { diff --git a/tests/testthat/test-108-metadataMethods-Functionality.R b/tests/testthat/test-108-metadataMethods-Functionality.R index a1f95a6a..48d78807 100644 --- a/tests/testthat/test-108-metadataMethods-Functionality.R +++ b/tests/testthat/test-108-metadataMethods-Functionality.R @@ -25,21 +25,7 @@ test_that( NextMetaData <- MetaData[1:10, ] - - # Verify behaviors under refresh = FALSE - n_imported <- importMetaData(rcon, - NextMetaData, - refresh = FALSE) - expect_equal(n_imported, "10") - - expect_data_frame(rcon$metadata(), - nrows = nrow(MetaData)) - - expect_equal(rcon$instruments()$instrument_name, - orig_instrument) - - rcon$refresh_metadata() - rcon$refresh_instruments() + expect_data_frame(rcon$metadata(), nrows = nrow(NextMetaData)) diff --git a/tests/testthat/test-110-repeatingInstruments-ArgumentValidation.R b/tests/testthat/test-110-repeatingInstruments-ArgumentValidation.R index 1356e4cd..9a506693 100644 --- a/tests/testthat/test-110-repeatingInstruments-ArgumentValidation.R +++ b/tests/testthat/test-110-repeatingInstruments-ArgumentValidation.R @@ -49,22 +49,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importRepeatingInstrumentsEvents(rcon, - data = REDCAP_REPEAT_INSTRUMENT_STRUCTURE, - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - - expect_error(importRepeatingInstrumentsEvents(rcon, - data = REDCAP_REPEAT_INSTRUMENT_STRUCTURE, - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-110-repeatingInstruments-Functionality.R b/tests/testthat/test-110-repeatingInstruments-Functionality.R index 141aae7c..25ffcba5 100644 --- a/tests/testthat/test-110-repeatingInstruments-Functionality.R +++ b/tests/testthat/test-110-repeatingInstruments-Functionality.R @@ -41,11 +41,6 @@ importProjectInformation(rcon, data = data.frame(is_longitudinal = 1, has_repeating_instruments_or_events = 1)) -rcon$refresh_arms() -rcon$refresh_events() - - - test_that( "Import and Export Repeating Instrument Settings", { @@ -57,9 +52,6 @@ test_that( data = Repeat) expect_equal(n_imported, "1") - rcon$refresh_projectInformation() - rcon$refresh_repeatInstrumentEvent() - # Now let's check that we get the setting on the export expect_data_frame(exportRepeatingInstrumentsEvents(rcon), ncols = 3) diff --git a/tests/testthat/test-111-switchDag-ArgumentValidation.R b/tests/testthat/test-111-switchDag-ArgumentValidation.R index 0385b831..9738feeb 100644 --- a/tests/testthat/test-111-switchDag-ArgumentValidation.R +++ b/tests/testthat/test-111-switchDag-ArgumentValidation.R @@ -33,21 +33,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(switchDag(rcon, - dag = "test_dag_1", - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - expect_error(switchDag(rcon, - dag = "test_dag_1", - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-150-importDeleteRecords-Functionality.R b/tests/testthat/test-150-importDeleteRecords-Functionality.R index 091dd1a1..1238f89f 100644 --- a/tests/testthat/test-150-importDeleteRecords-Functionality.R +++ b/tests/testthat/test-150-importDeleteRecords-Functionality.R @@ -22,8 +22,8 @@ ImportData <- test_redcapAPI_Data ImportData <- ImportData[1, names(ImportData) %in% fields] -importArms(rcon, test_redcapAPI_Arms, refresh=FALSE) -importEvents(rcon, test_redcapAPI_Events, refresh=FALSE) +importArms(rcon, test_redcapAPI_Arms) +importEvents(rcon, test_redcapAPI_Events) importProjectInformation(rcon, data.frame(is_longitudinal = 1)) n <- length(rcon$instruments()$instrument_name) @@ -217,8 +217,6 @@ test_that( importMetaData(rcon, NewMetaData) - rcon$refresh_fieldnames() - NewMetaData <- rcon$metadata() w_var <- which(NewMetaData$field_name == "date_ymd_test") @@ -257,9 +255,7 @@ test_that( importMetaData(rcon, NewMetaData) - - rcon$refresh_fieldnames() - + NewMetaData <- rcon$metadata() w_var <- which(NewMetaData$field_name == "datetime_ymd_hms_test") diff --git a/tests/testthat/test-200-exportTypedRecords-Functionality.R b/tests/testthat/test-200-exportTypedRecords-Functionality.R index 68aaa444..d42822c9 100644 --- a/tests/testthat/test-200-exportTypedRecords-Functionality.R +++ b/tests/testthat/test-200-exportTypedRecords-Functionality.R @@ -16,8 +16,6 @@ load(file.path(test_path("testdata"), load(file.path(test_path("testdata"), "test_redcapAPI_Events.Rdata")) -rcon$flush_all() - forms <- c("record_id", "text_fields", "dates_and_times", "numbers", "slider_fields", "multiple_choice", "files_notes_descriptions", "calculated_fields") @@ -56,7 +54,7 @@ ImportData <- castForImport(ImportData, importRecords(rcon, ImportData) -rcon$flush_externalCoding() + ##################################################################### # Functional Testing #### @@ -324,7 +322,6 @@ test_that( NewMetaData$select_choices_or_calculations[2] <- "0, Zero | 1, One | 2, Two" importMetaData(rcon, NewMetaData) - rcon$refresh_fieldnames() importRecords(rcon, data = data.frame(record_id = 1:4, @@ -468,7 +465,6 @@ test_that( # Restore the meta data for further testing --------------------- importMetaData(rcon, MetaData) - rcon$refresh_fieldnames() } ) diff --git a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R index 5dbeba03..d0552da6 100644 --- a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R +++ b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R @@ -11,9 +11,6 @@ load(file.path(test_path("testdata"), importMetaData(rcon, test_redcapAPI_MetaData) -rcon$refresh_instruments() -rcon$refresh_fieldnames() - forms <- rcon$instruments()$instrument_name Mappings <- data.frame(arm_num = rep(1, length(forms)), unique_event_name = rep("event_1_arm_1", length(forms)), diff --git a/tests/testthat/test-354-getProjectIdFields.R b/tests/testthat/test-354-getProjectIdFields.R index bad678eb..5a41aa99 100644 --- a/tests/testthat/test-354-getProjectIdFields.R +++ b/tests/testthat/test-354-getProjectIdFields.R @@ -18,7 +18,6 @@ test_that( # Force a secondary unique field NewInfo <- data.frame(secondary_unique_field = "text_test") importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() expect_equal(getProjectIdFields(rcon), c("record_id", "text_test")) @@ -27,7 +26,6 @@ test_that( NewInfo <- data.frame(secondary_unique_field = "", surveys_enabled = 0) importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() } ) @@ -36,7 +34,6 @@ test_that("Does not return secondary field that is not in current fields", # Force a secondary unique field NewInfo <- data.frame(secondary_unique_field = "does_not_exist") importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() expect_warning(ids <- getProjectIdFields(rcon), "secondary unique field that does not exist") expect_equal(ids, "record_id") @@ -45,6 +42,5 @@ test_that("Does not return secondary field that is not in current fields", NewInfo <- data.frame(secondary_unique_field = "", surveys_enabled = 0) importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() } ) From 402fc4ec0c2fe147ffec8929dc9cddc57b4b942d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 17:27:15 -0500 Subject: [PATCH 085/155] More cleanup for refresh #331 --- .../test-108-metadataMethods-Functionality.R | 12 +++--------- ...204-exportTypedRecords-withRepeatingInstruments.R | 2 -- 2 files changed, 3 insertions(+), 11 deletions(-) diff --git a/tests/testthat/test-108-metadataMethods-Functionality.R b/tests/testthat/test-108-metadataMethods-Functionality.R index 48d78807..ba9b6e8b 100644 --- a/tests/testthat/test-108-metadataMethods-Functionality.R +++ b/tests/testthat/test-108-metadataMethods-Functionality.R @@ -1,13 +1,10 @@ context("Meta Data Methods Functionality") - - load(test_path("testdata", "test_redcapAPI_MetaData.Rdata")) test_that( "Import and Export Meta Data", { - MetaData <- test_redcapAPI_MetaData orig_instrument <- unique(MetaData$form_name) @@ -16,17 +13,16 @@ test_that( data = MetaData) expect_equal(n_imported, as.character(nrow(MetaData))) - expect_data_frame(rcon$metadata(), nrows = nrow(MetaData)) expect_equal(rcon$instruments()$instrument_name, orig_instrument) - + # Just do a subset of the metadata NextMetaData <- MetaData[1:10, ] + importMetaData(rcon, NextMetaData) - expect_data_frame(rcon$metadata(), nrows = nrow(NextMetaData)) @@ -34,8 +30,6 @@ test_that( unique(NextMetaData$form_name)) # Clean up - - importMetaData(rcon, - data = MetaData[1, ]) + importMetaData(rcon, MetaData[1, ]) } ) diff --git a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R index d0552da6..13c406fc 100644 --- a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R +++ b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R @@ -140,7 +140,6 @@ test_that( # Now let's make a secondary unique field NewInfo <- data.frame(secondary_unique_field = "text_test") importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() Rec <- exportRecordsTyped(rcon, forms = c("randomization")) @@ -149,7 +148,6 @@ test_that( NewInfo <- data.frame(secondary_unique_field = "", surveys_enabled = 0) importProjectInformation(rcon, NewInfo) - rcon$refresh_projectInformation() } ) From e888f2f5c85627ab3f971b7f1c2a4b224c5e7e13 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 22 Mar 2024 17:29:45 -0500 Subject: [PATCH 086/155] Updated docs #331 --- man/armsMethods.Rd | 5 ----- man/dagMethods.Rd | 5 ----- man/eventsMethods.Rd | 5 ----- man/fromFileRepositoryMethods.Rd | 3 --- man/mappingMethods.Rd | 3 --- man/metaDataMethods.Rd | 4 ---- man/projectInformationMethods.Rd | 4 ---- man/repeatingInstrumentMethods.Rd | 5 ----- man/switchDag.Rd | 4 ---- man/userMethods.Rd | 5 ----- man/userRoleAssignmentMethods.Rd | 4 ---- man/userRoleMethods.Rd | 5 ----- 12 files changed, 52 deletions(-) diff --git a/man/armsMethods.Rd b/man/armsMethods.Rd index 9a5ea657..9ea9a182 100644 --- a/man/armsMethods.Rd +++ b/man/armsMethods.Rd @@ -30,7 +30,6 @@ deleteArms(rcon, arms, ...) rcon, data, override = FALSE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -40,7 +39,6 @@ deleteArms(rcon, arms, ...) \method{deleteArms}{redcapApiConnection}( rcon, arms, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -62,9 +60,6 @@ this may also be passed as \code{arms_data}.} existing arms data. When \code{TRUE}, all the existing arms data is deleted and replaced with the contents of \code{data}.} -\item{refresh}{\code{logical(1)} If \code{TRUE}, the cached arms data will -be refreshed after the API action is complete.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/dagMethods.Rd b/man/dagMethods.Rd index 46e18293..c608f495 100644 --- a/man/dagMethods.Rd +++ b/man/dagMethods.Rd @@ -28,7 +28,6 @@ deleteDags(rcon, dags, ...) \method{importDags}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -38,7 +37,6 @@ deleteDags(rcon, dags, ...) \method{deleteDags}{redcapApiConnection}( rcon, dags, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -53,9 +51,6 @@ deleteDags(rcon, dags, ...) \item{data}{A \code{data.frame} with two columns: \code{data_access_group_name} and \code{unique_group_name}.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, cached data access -group data will be refreshed after the import.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/eventsMethods.Rd b/man/eventsMethods.Rd index 831d9665..31b2889d 100644 --- a/man/eventsMethods.Rd +++ b/man/eventsMethods.Rd @@ -30,7 +30,6 @@ deleteEvents(rcon, events = NULL, ...) rcon, data, override = FALSE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -40,7 +39,6 @@ deleteEvents(rcon, events = NULL, ...) \method{deleteEvents}{redcapApiConnection}( rcon, events = NULL, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -65,9 +63,6 @@ For backward compatibility, this argument may be passed as \code{event_data}.} existing arms data. When \code{TRUE}, all the existing arms data is deleted and replaced with the contents of \code{data}.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached arms data will -be refreshed after the API action is complete.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/fromFileRepositoryMethods.Rd b/man/fromFileRepositoryMethods.Rd index 3354bf84..f72b231c 100644 --- a/man/fromFileRepositoryMethods.Rd +++ b/man/fromFileRepositoryMethods.Rd @@ -69,9 +69,6 @@ the file is to be saved. Defaults to the working directory.} if it does not already exist. Defaults to \code{FALSE}. If \code{dir} does not exist and \code{create = FALSE}, an error is thrown.} -\item{refresh}{\code{logical(1)} When \code{TRUE}, the cached -File Repository data on \code{rcon} will be refreshed.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/mappingMethods.Rd b/man/mappingMethods.Rd index 9f580d4a..1f7c87c2 100644 --- a/man/mappingMethods.Rd +++ b/man/mappingMethods.Rd @@ -40,9 +40,6 @@ given, mappings are only exported for the given arms.} \item{data}{\code{data.frame} with columns \code{arm_num}, \code{unique_event_name}, and \code{form}. See Details} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, cached mappings in the \code{rcon} -object are refreshed after the import.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/metaDataMethods.Rd b/man/metaDataMethods.Rd index d5a73a16..bb44b548 100644 --- a/man/metaDataMethods.Rd +++ b/man/metaDataMethods.Rd @@ -27,7 +27,6 @@ importMetaData(rcon, data, ...) \method{importMetaData}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., field_types = REDCAP_METADATA_FIELDTYPE, validation_types = REDCAP_METADATA_VALIDATION_TYPE, @@ -50,9 +49,6 @@ dictionary, and not the display names shown on the web interface.} \item{data}{\code{data.frame} with the Meta Data to import.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached metadata -and instruments will be refreshed after the import.} - \item{...}{Arguments to pass to other methods} \item{field_types}{\code{character} giving the acceptable field types diff --git a/man/projectInformationMethods.Rd b/man/projectInformationMethods.Rd index 993fff86..0d17d0a2 100644 --- a/man/projectInformationMethods.Rd +++ b/man/projectInformationMethods.Rd @@ -24,7 +24,6 @@ importProjectInformation(rcon, data, ...) \method{importProjectInformation}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -37,9 +36,6 @@ importProjectInformation(rcon, data, ...) \item{data}{\code{data.frame} with only one row and any subset of allowable fields to be updated. See Details.} -\item{refresh}{\code{logical(1)}. If \code{TRUE}, the cached project information -will be updated after the import.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/repeatingInstrumentMethods.Rd b/man/repeatingInstrumentMethods.Rd index 31c14480..e3804871 100644 --- a/man/repeatingInstrumentMethods.Rd +++ b/man/repeatingInstrumentMethods.Rd @@ -25,7 +25,6 @@ importRepeatingInstrumentsEvents(rcon, data, ...) \method{importRepeatingInstrumentsEvents}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -39,10 +38,6 @@ importRepeatingInstrumentsEvents(rcon, data, ...) columns \code{form_name} and \code{custom_form_label}. Longitudinal projects also require a column for \code{event_name}.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached -value of repeating instruments and events on \code{rcon} will be -refreshed.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/switchDag.Rd b/man/switchDag.Rd index b4cf08bd..b0a04df0 100644 --- a/man/switchDag.Rd +++ b/man/switchDag.Rd @@ -11,7 +11,6 @@ switchDag(rcon, dag, ...) \method{switchDag}{redcapApiConnection}( rcon, dag, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -24,9 +23,6 @@ switchDag(rcon, dag, ...) \item{dag}{\code{character(1)} A unique data access group to which to assign the current user. Use \code{NA} to leave the user unassigned.} -\item{refresh}{\code{logical(1)} If \code{TRUE}, the cached data access -group assignments will be refreshed.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/userMethods.Rd b/man/userMethods.Rd index 7bc8c222..291f1321 100644 --- a/man/userMethods.Rd +++ b/man/userMethods.Rd @@ -32,7 +32,6 @@ deleteUsers(rcon, users, ...) rcon, data, consolidate = TRUE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -42,7 +41,6 @@ deleteUsers(rcon, users, ...) \method{deleteUsers}{redcapApiConnection}( rcon, users, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -72,9 +70,6 @@ a column titled \code{username}. All other columns are optional.} export access values will be read from the expanded columns. Otherwise, the consolidated values (as provided by the API export) are utilized.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached data will -be refreshed after the API action is complete.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/userRoleAssignmentMethods.Rd b/man/userRoleAssignmentMethods.Rd index 0401a66d..a708291a 100644 --- a/man/userRoleAssignmentMethods.Rd +++ b/man/userRoleAssignmentMethods.Rd @@ -24,7 +24,6 @@ importUserRoleAssignments(rcon, data, ...) \method{importUserRoleAssignments}{redcapApiConnection}( rcon, data, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -39,9 +38,6 @@ importUserRoleAssignments(rcon, data, ...) Users without a \code{unique_role_name} will not be assigned to a user role.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached value -in \code{rcon} will be refreshed after the import.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. diff --git a/man/userRoleMethods.Rd b/man/userRoleMethods.Rd index 4d22a8a0..8376bada 100644 --- a/man/userRoleMethods.Rd +++ b/man/userRoleMethods.Rd @@ -31,7 +31,6 @@ deleteUserRoles(rcon, user_roles, ...) rcon, data, consolidate = TRUE, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -41,7 +40,6 @@ deleteUserRoles(rcon, user_roles, ...) \method{deleteUserRoles}{redcapApiConnection}( rcon, user_roles, - refresh = TRUE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -69,9 +67,6 @@ a column titled \code{unique_role_name}. All other columns are optional.} export access values will be read from the expanded columns. Otherwise, the consolidated values (as provided by the API export) are utilized.} -\item{refresh}{\code{logical(1)}. When \code{TRUE}, the cached data will -be refreshed after the API action is complete.} - \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. From b91b6b29126d5f111c5cc9a4dfe153e235975bfc Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Sat, 23 Mar 2024 09:42:51 -0500 Subject: [PATCH 087/155] More work towards cleanup. #331. Bioportal fields are broken somehow. --- R/fieldCastingFunctions.R | 16 +++++++++++++++- R/importRecords.R | 8 +++++--- ...test-200-exportTypedRecords-Functionality.R | 18 +++++++----------- 3 files changed, 27 insertions(+), 15 deletions(-) diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index f4b45cba..e449a2db 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -290,7 +290,7 @@ castForImport <- function(data, checkmate::reportAssertions(coll) - # Remove mChoice variables from frame + # Drop mChoice variables from frame mchoices <- vapply(data, inherits, logical(1), 'mChoice') if(sum(mchoices) > 0) { @@ -300,6 +300,19 @@ castForImport <- function(data, fields <- fields[!mchoices] } + # Drop non importable field types + for(type in c("file", "calc")) + { + drops <- rcon$metadata()[match(fields, rcon$metadata()$field_name),'field_type'] == type + if(sum(drops) > 0) + { + message(paste0("The following ", type, ", variables(s) were dropped: ", + paste0(fields[drops], collapse=', '), '.')) + data <- data[,!drops, drop=FALSE] + fields <- fields[!drops] + } + } + Raw <- as.data.frame(lapply(data, function(x) trimws(as.character(x)))) @@ -319,6 +332,7 @@ castForImport <- function(data, } attr(data, "invalid") <- attr(Recast, "invalid") + attr(data, "castForImport") <- TRUE data } diff --git a/R/importRecords.R b/R/importRecords.R index 981f25af..1db1e36f 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -137,9 +137,11 @@ importRecords.redcapApiConnection <- function(rcon, batch.size = -1, error_handling = getOption("redcap_error_handling"), config = list(), - api_param = list()){ - message("importRecords will change how it validates data in version 3.0.0.\n", - "We recommend preparing your data for import using castForImport.") + api_param = list()) +{ + if(is.null(attr(data, "castForImport"))) + message("importRecords will change how it validates data in version 3.0.0.\n", + "We recommend preparing your data for import using castForImport .") ################################################################## # Argument Validation diff --git a/tests/testthat/test-200-exportTypedRecords-Functionality.R b/tests/testthat/test-200-exportTypedRecords-Functionality.R index d42822c9..a68f76a4 100644 --- a/tests/testthat/test-200-exportTypedRecords-Functionality.R +++ b/tests/testthat/test-200-exportTypedRecords-Functionality.R @@ -7,6 +7,7 @@ context("Export Typed Records Functionality") # # Subsequent files will deal with each of those specifics +purgeProject(rcon, records=TRUE) load(file.path(test_path("testdata"), "test_redcapAPI_MetaData.Rdata")) load(file.path(test_path("testdata"), @@ -21,13 +22,9 @@ forms <- c("record_id", "text_fields", "dates_and_times", "numbers", "files_notes_descriptions", "calculated_fields") MetaData <- test_redcapAPI_MetaData[test_redcapAPI_MetaData$form_name %in% forms, ] -importMetaData(rcon, - MetaData) -importArms(rcon, - data = test_redcapAPI_Arms) -importEvents(rcon, - data = test_redcapAPI_Events) - +importMetaData(rcon, MetaData) +importArms(rcon, test_redcapAPI_Arms) +importEvents(rcon, test_redcapAPI_Events) importProjectInformation(rcon, data.frame(is_longitudinal = 1, record_autonumbering_enabled = 0)) @@ -35,8 +32,7 @@ importProjectInformation(rcon, Mappings <- data.frame(arm_num = rep(1, length(forms)), unique_event_name = rep("event_1_arm_1", length(forms)), form = forms) -importMappings(rcon, - data = Mappings) +importMappings(rcon, Mappings) ImportData <- test_redcapAPI_Data[names(test_redcapAPI_Data) %in% MetaData$field_name] @@ -52,8 +48,7 @@ ImportData <- castForImport(ImportData, bioportal = as.character)) -importRecords(rcon, - ImportData) +importRecords(rcon, ImportData) ##################################################################### @@ -168,6 +163,7 @@ test_that( fields="number_test", records = 1:5, cast=raw_cast) + browser() recV <- expect_warning( exportRecordsTyped( rcon, From e020dabf7c006d1ea1bc96d0055284fcd3d545d1 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Sun, 24 Mar 2024 14:01:27 -0500 Subject: [PATCH 088/155] Skipping bioportal validation as it's mostly impossible #331 --- R/fieldValidationAndCasting.R | 2 +- tests/testthat/test-200-exportTypedRecords-Functionality.R | 1 - 2 files changed, 1 insertion(+), 2 deletions(-) diff --git a/R/fieldValidationAndCasting.R b/R/fieldValidationAndCasting.R index 9dee13f5..0a2cdad5 100644 --- a/R/fieldValidationAndCasting.R +++ b/R/fieldValidationAndCasting.R @@ -581,7 +581,7 @@ default_cast_character <- default_cast_no_factor radio = valChoice, dropdown = valChoice, sql = valChoice, - bioportal = valChoice + bioportal = valSkip ) .default_cast <- list( diff --git a/tests/testthat/test-200-exportTypedRecords-Functionality.R b/tests/testthat/test-200-exportTypedRecords-Functionality.R index a68f76a4..ab74ed23 100644 --- a/tests/testthat/test-200-exportTypedRecords-Functionality.R +++ b/tests/testthat/test-200-exportTypedRecords-Functionality.R @@ -163,7 +163,6 @@ test_that( fields="number_test", records = 1:5, cast=raw_cast) - browser() recV <- expect_warning( exportRecordsTyped( rcon, From 441e489e45b558757a6d1f35f27a5847a1d7b7dc Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 25 Mar 2024 08:58:11 -0500 Subject: [PATCH 089/155] More refactoring of tests to match new cache strategy #331 --- R/fieldCastingFunctions.R | 2 +- .../test-150-importDeleteRecords-Functionality.R | 2 +- .../test-200-exportTypedRecords-Functionality.R | 10 ++++------ tests/testthat/test-201-exportTypedRecords-withDAGs.R | 4 ++-- 4 files changed, 8 insertions(+), 10 deletions(-) diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index e449a2db..032a8710 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -304,7 +304,7 @@ castForImport <- function(data, for(type in c("file", "calc")) { drops <- rcon$metadata()[match(fields, rcon$metadata()$field_name),'field_type'] == type - if(sum(drops) > 0) + if(!is.na(sum(drops)) && sum(drops) > 0) { message(paste0("The following ", type, ", variables(s) were dropped: ", paste0(fields[drops], collapse=', '), '.')) diff --git a/tests/testthat/test-150-importDeleteRecords-Functionality.R b/tests/testthat/test-150-importDeleteRecords-Functionality.R index 1238f89f..ac1add41 100644 --- a/tests/testthat/test-150-importDeleteRecords-Functionality.R +++ b/tests/testthat/test-150-importDeleteRecords-Functionality.R @@ -290,4 +290,4 @@ test_that( } ) -purgeProject(rcon, purge_all = TRUE) \ No newline at end of file +#purgeProject(rcon, purge_all = TRUE) \ No newline at end of file diff --git a/tests/testthat/test-200-exportTypedRecords-Functionality.R b/tests/testthat/test-200-exportTypedRecords-Functionality.R index ab74ed23..3ef55b7d 100644 --- a/tests/testthat/test-200-exportTypedRecords-Functionality.R +++ b/tests/testthat/test-200-exportTypedRecords-Functionality.R @@ -237,12 +237,10 @@ test_that( test_that( "Calculated fields are exported", { - expect_data_frame( - exportRecordsTyped(rcon, - fields = c("left_operand", "right_operand", - "calc_addition", "calc_squared")), - ncols = 6 - ) + fields <- c("left_operand", "right_operand","calc_addition", "calc_squared") + expect_data_frame(x <- exportRecordsTyped(rcon, fields = fields), + min.cols = 6) + expect_subset(fields, names(x)) } ) diff --git a/tests/testthat/test-201-exportTypedRecords-withDAGs.R b/tests/testthat/test-201-exportTypedRecords-withDAGs.R index b90400c0..9150c834 100644 --- a/tests/testthat/test-201-exportTypedRecords-withDAGs.R +++ b/tests/testthat/test-201-exportTypedRecords-withDAGs.R @@ -3,7 +3,7 @@ context("Export Typed Records with DAGs Functionality") # NOTE: Data for these tests was established in # test-200-exportTypedRecords-Functionality.R -ImportData <- exportRecordsTyped(rcon, +ImportData <- exportRecordsTyped(rcon, cast = raw_cast) ImportData <- castForImport(ImportData, rcon, @@ -26,7 +26,7 @@ ImportData$redcap_data_access_group <- rep(rcon$dags()$unique_group_name, length.out = nrow(ImportData)) importRecords(rcon, ImportData) -rcon$flush_externalCoding() + ##################################################################### # Export Data Access Groups From 3684d511b893450d9b1f21c5089847a3050619f3 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 25 Mar 2024 09:45:29 -0500 Subject: [PATCH 090/155] Fixed bug in castForImport drops #331 --- R/fieldCastingFunctions.R | 7 ++++--- tests/testthat/test-201-exportTypedRecords-withDAGs.R | 1 + 2 files changed, 5 insertions(+), 3 deletions(-) diff --git a/R/fieldCastingFunctions.R b/R/fieldCastingFunctions.R index 032a8710..a86ecaa6 100644 --- a/R/fieldCastingFunctions.R +++ b/R/fieldCastingFunctions.R @@ -299,14 +299,15 @@ castForImport <- function(data, data <- data[,!mchoices, drop=FALSE] fields <- fields[!mchoices] } - + # Drop non importable field types for(type in c("file", "calc")) { drops <- rcon$metadata()[match(fields, rcon$metadata()$field_name),'field_type'] == type - if(!is.na(sum(drops)) && sum(drops) > 0) + drops[is.na(drops)] <- FALSE + if(sum(drops) > 0) { - message(paste0("The following ", type, ", variables(s) were dropped: ", + message(paste0("The following ", type, " variables(s) were dropped: ", paste0(fields[drops], collapse=', '), '.')) data <- data[,!drops, drop=FALSE] fields <- fields[!drops] diff --git a/tests/testthat/test-201-exportTypedRecords-withDAGs.R b/tests/testthat/test-201-exportTypedRecords-withDAGs.R index 9150c834..0a9cb9e6 100644 --- a/tests/testthat/test-201-exportTypedRecords-withDAGs.R +++ b/tests/testthat/test-201-exportTypedRecords-withDAGs.R @@ -7,6 +7,7 @@ ImportData <- exportRecordsTyped(rcon, cast = raw_cast) ImportData <- castForImport(ImportData, rcon, + validation = list(bioportal=valSkip), cast = list(number_1dp = as.numeric, number_2dp = as.numeric, number_1dp_comma_decimal = as.numeric, From 4566984d636c6f8f2eab633db5d9c63f55d80f13 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 25 Mar 2024 09:47:47 -0500 Subject: [PATCH 091/155] Removed more caching calls from tests #331 --- tests/testthat/test-102-userRoleMethods-Functionality.R | 2 -- tests/testthat/test-106-armsMethods-Functionality.R | 1 - .../test-204-exportTypedRecords-withRepeatingInstruments.R | 1 - tests/testthat/test-301-fileMethods-Functionality.R | 1 - 4 files changed, 5 deletions(-) diff --git a/tests/testthat/test-102-userRoleMethods-Functionality.R b/tests/testthat/test-102-userRoleMethods-Functionality.R index 879c4996..015ea0a6 100644 --- a/tests/testthat/test-102-userRoleMethods-Functionality.R +++ b/tests/testthat/test-102-userRoleMethods-Functionality.R @@ -4,8 +4,6 @@ test_that( "User Role Methods Functionality", { # Import a single user role - rcon$flush_all() - NewRole <- data.frame(role_label = "User Role 1", user_rights = 1) diff --git a/tests/testthat/test-106-armsMethods-Functionality.R b/tests/testthat/test-106-armsMethods-Functionality.R index 9ecb8645..3fba7a34 100644 --- a/tests/testthat/test-106-armsMethods-Functionality.R +++ b/tests/testthat/test-106-armsMethods-Functionality.R @@ -38,7 +38,6 @@ test_that( n_deleted <- deleteArms(rcon, arms = rcon$arms()$arm_num) expect_equal(n_deleted, "0") - rcon$flush_arms() } ) diff --git a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R index 13c406fc..babd6588 100644 --- a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R +++ b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R @@ -35,7 +35,6 @@ ImportData <- castForImport(test_redcapAPI_Data, bioportal = as.character)) importRecords(rcon, ImportData) -rcon$flush_externalCoding() ####################################################################### # Export Records with Repeating Instruments #### diff --git a/tests/testthat/test-301-fileMethods-Functionality.R b/tests/testthat/test-301-fileMethods-Functionality.R index b85e0e16..8d941074 100644 --- a/tests/testthat/test-301-fileMethods-Functionality.R +++ b/tests/testthat/test-301-fileMethods-Functionality.R @@ -71,7 +71,6 @@ NewRepeat <- data.frame(event_name = "event_1_arm_1", form_name = "files_notes_descriptions") importRepeatingInstrumentsEvents(rcon, NewRepeat) -rcon$flush_all() importRecords(rcon, data.frame(record_id = "1", From 455226f251ae76eb385e7d373e263df39cbf37b4 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 25 Mar 2024 10:01:44 -0500 Subject: [PATCH 092/155] Change to castForImport tests to match current behavior #331 --- tests/testthat/test-251-castForImport.R | 15 ++------------- 1 file changed, 2 insertions(+), 13 deletions(-) diff --git a/tests/testthat/test-251-castForImport.R b/tests/testthat/test-251-castForImport.R index 86e32eb7..da40ce06 100644 --- a/tests/testthat/test-251-castForImport.R +++ b/tests/testthat/test-251-castForImport.R @@ -692,19 +692,8 @@ test_that( test_field <- "calc_addition" invalid_value <- "some text" - expect_silent(castForImport(data = TheData[c("record_id", test_field)], - rcon = rcon)) - - TheData[[test_field]][1] <- invalid_value - - ImportData <- - expect_warning(castForImport(data = TheData[c("record_id", test_field)], - rcon = rcon), - "Some records failed validation") - - expect_true(attr(ImportData, "invalid")$value == invalid_value) - - expect_true(is.na(ImportData[[test_field]][1])) + expect_message(castForImport(data = TheData[c("record_id", test_field)], + rcon = rcon), 'calc_addition') } ) From 8bca1035ac2f617f0f8634a61219103c835b1411 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 25 Mar 2024 10:52:40 -0500 Subject: [PATCH 093/155] Fix for REPORT_ID issue introduced in #331 patches --- R/exportReportsTyped.R | 3 +++ tests/testthat/helper-01-QASystemValues.R | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/exportReportsTyped.R b/R/exportReportsTyped.R index 7c18c350..b9d1bbb1 100644 --- a/R/exportReportsTyped.R +++ b/R/exportReportsTyped.R @@ -109,6 +109,9 @@ exportReportsTyped.redcapApiConnection <- function(rcon, body = c(body, api_param), config) + if (response$status_code != 200) stop(paste("No report of ID", report_id, "in project.")) + + Raw <- as.data.frame(response, sep = csv_delimiter) if (length(drop_fields) > 0){ diff --git a/tests/testthat/helper-01-QASystemValues.R b/tests/testthat/helper-01-QASystemValues.R index 9c08f23d..130a7825 100644 --- a/tests/testthat/helper-01-QASystemValues.R +++ b/tests/testthat/helper-01-QASystemValues.R @@ -10,5 +10,5 @@ EXPORT_REPORTS_ID <- as.numeric(strsplit(Sys.getenv('REPORT_IDS', '357209'), ',' RUN_USER_TESTS <- length(EXPENDABLE_USER) == 1 RUN_REPORTS_TEST <- TRUE -tryCatch( {exportReportsTyped(conns$rcon, report_id = EXPORT_REPORTS_ID) }, +tryCatch( {exportReportsTyped(conns$rcon, report_id = EXPORT_REPORTS_ID[1]) }, error = function(cond) RUN_REPORTS_TEST <<- FALSE) From 7071223741649157f6703caa8865025846d07f57 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 26 Mar 2024 09:37:40 -0400 Subject: [PATCH 094/155] get url from rcon --- R/exportDataQuality.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 1ec1d7b4..bbde158a 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -40,7 +40,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, ################################################################### # Build the query list #### - url <- paste0("https://redcap.vanderbilt.edu/api/?prefix=", prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) + url <- paste0(rcon$url, prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) formData <- list(token = rcon$token) From e6eaf3c1f7f69dc02468f4c7acda86606240873e Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 26 Mar 2024 10:21:35 -0400 Subject: [PATCH 095/155] add DQ data structure --- R/exportDataQuality.R | 9 ++++----- R/redcapDataStructure.R | 23 +++++++++++++++++++++++ 2 files changed, 27 insertions(+), 5 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index bbde158a..a80296f6 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -40,7 +40,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, ################################################################### # Build the query list #### - url <- paste0(rcon$url, prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) + url <- paste0(rcon$url, "?prefix=", prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) formData <- list(token = rcon$token) @@ -66,9 +66,8 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, } return(result) - }, error = function(e) { - cat("Error in result: Make sure the Data Quality API module is enabled in your project.", conditionMessage(e), "\n") - }) + }, stop ("Error in result: Make sure the Data Quality API module is enabled in your project.") + ) @@ -85,7 +84,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, } if (as.character(response) == ""){ - return(REDCAP_DAG_ASSIGNMENT_STRUCTURE) + return(REDCAP_DQ_STRUCTURE) } as.data.frame(response) diff --git a/R/redcapDataStructure.R b/R/redcapDataStructure.R index 591e75a5..f88b95f1 100644 --- a/R/redcapDataStructure.R +++ b/R/redcapDataStructure.R @@ -87,6 +87,29 @@ REDCAP_DAG_ASSIGNMENT_STRUCTURE <- redcap_data_access_group = character(0), stringsAsFactors = FALSE) +# Data Quality ------------------------------------------------------ +# Data Quality Structure + +REDCAP_DQ_STRUCTURE <- + data.frame(status_id = character(0), + rule_id = character(0), + pd_rule_id = character(0), + non_rule = character(0), + project_id = character(0), + record = character(0), + event_id = character(0), + field_name = character(0), + repeat_instrument = character(0), + instance = character(0), + status = character(0), + exclude = character(0), + query_status = character(0), + group_id = character(0), + assigned_username = character(0), + resolutions = character(0), + codes = character(0), + stringsAsFactors = FALSE) + # Events ------------------------------------------------------------ # Event Structure From e79ca39e37e1e6e1ef4b795b58cd14f96dca9875 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 26 Mar 2024 10:25:45 -0400 Subject: [PATCH 096/155] remove redcapError --- R/exportDataQuality.R | 5 ----- 1 file changed, 5 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index a80296f6..af82264f 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -78,11 +78,6 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, body = c(body, api_param), config = config) - if (response$status_code != 200){ - redcapError(response, - error_handling = error_handling) - } - if (as.character(response) == ""){ return(REDCAP_DQ_STRUCTURE) } From fd0034132a564568083e7fe94be6c23860d671dc Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 26 Mar 2024 11:43:16 -0400 Subject: [PATCH 097/155] keep json format --- R/exportDataQuality.R | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index af82264f..92ef5602 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -45,12 +45,13 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, formData <- list(token = rcon$token) response <- httr::POST(url, body = formData, encode = "form") + tryCatch({ result <- httr::content(response, type = 'application/json') for(j in 1:length(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} result <- as.data.frame(do.call(rbind, result)) - + if (nrow(result) > 0) { columns <- c("status_id", "project_id", "record", "event_id", "instance", "field_name") for (c in columns) { @@ -64,12 +65,11 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, return(m) }) } - + return(result) - }, stop ("Error in result: Make sure the Data Quality API module is enabled in your project.") - ) - - + }, error = function(e) { + stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) + }) ################################################################### # Make the API Call #### From b475808b4d3a133d62671ec09183c160f4efd934 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 1 Apr 2024 16:36:45 -0500 Subject: [PATCH 098/155] Moved stop to coll #331 --- R/importRecords.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/importRecords.R b/R/importRecords.R index 1db1e36f..71449f58 100644 --- a/R/importRecords.R +++ b/R/importRecords.R @@ -215,18 +215,20 @@ importRecords.redcapApiConnection <- function(rcon, mchoices <- which(vapply(data, inherits, logical(1), 'mChoice')) if(length(mchoices) > 0) { - stop("The variable(s) ", - paste0(names(data)[mchoices], collapse=", "), - " are mChoice formatted and cannot be imported.") + coll$push(paste0( + "The variable(s) ", + paste0(names(data)[mchoices], collapse=", "), + " are mChoice formatted and cannot be imported.")) } # Validate field names unrecognized_names <- !(names(data) %in% c(with_complete_fields, REDCAP_SYSTEM_FIELDS)) if (any(unrecognized_names)) { - stop("The variable(s) ", - paste0(names(data)[unrecognized_names], collapse=", "), - " are not found in the project and/or cannot be imported.") + coll$push(paste0( + "The variable(s) ", + paste0(names(data)[unrecognized_names], collapse=", "), + " are not found in the project and/or cannot be imported.")) } # Check that the study id exists in data From 687afa8037e10f13c9cad9826dd7aed443030188 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 2 Apr 2024 12:31:07 -0500 Subject: [PATCH 099/155] remove extract of comments with stringr dependency --- R/exportDataQuality.R | 7 ------- 1 file changed, 7 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 92ef5602..2dd3bcb6 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -57,13 +57,6 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, for (c in columns) { result[, c] <- unlist(result[, c]) } - - result$codes <- lapply(result$resolutions, function(rs) { - rs_df <- as.data.frame(do.call(rbind, rs)) - m <- stringr::str_match(unlist(rs_df$comment), "^([a-zA-Z]+\\d+):\\s")[, 2] - m <- m[!is.na(m)] - return(m) - }) } return(result) From 1a951b384e8a013c183761a9bac45d8e0312dee9 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 5 Apr 2024 12:31:44 -0500 Subject: [PATCH 100/155] add exportDataQuality documentation --- R/exportDataQuality.R | 15 +++++++++++++++ man/exportDataQuality.Rd | 21 +++++++++++++++++++++ 2 files changed, 36 insertions(+) create mode 100644 man/exportDataQuality.Rd diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 2dd3bcb6..21214b83 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -1,3 +1,18 @@ +##################################################################### +# exportDataQuality #### + +#' @name exportDataQuality +#' @title A helper function to export data queries from the Data Quality REDCap +#' module. +#' @description Exports Data Quality queries by record. The Data Quality module +#' must be enabled on the Control Center of REDCap to use this function. Additionally, +#' this module must be enabled on each project before it can be used. +#' +#' @param rcon A REDCap connection object as generated by `redcapConnection`. +#' @param prefix A string from your REDCap institutions Data Quality module url. The +#' module prefix can be found by exporting module settings under External Modules +#' in REDCap. + exportDataQuality <- function(rcon, prefix, ...){ diff --git a/man/exportDataQuality.Rd b/man/exportDataQuality.Rd new file mode 100644 index 00000000..f1378c8c --- /dev/null +++ b/man/exportDataQuality.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/exportDataQuality.R +\name{exportDataQuality} +\alias{exportDataQuality} +\title{A helper function to export data queries from the Data Quality REDCap +module.} +\usage{ +exportDataQuality(rcon, prefix, ...) +} +\arguments{ +\item{rcon}{A REDCap connection object as generated by \code{redcapConnection}.} + +\item{prefix}{A string from your REDCap institutions Data Quality module url. The +module prefix can be found by exporting module settings under External Modules +in REDCap.} +} +\description{ +Exports Data Quality queries by record. The Data Quality module +must be enabled on the Control Center of REDCap to use this function. Additionally, +this module must be enabled on each project before it can be used. +} From 5579899b76f122f9f22f8d7821504630205e058b Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 11:17:02 -0500 Subject: [PATCH 101/155] Tests for makeApiCall now use defined url #353 --- tests/testthat/helper-00-REDCapQACredentials.R | 2 +- tests/testthat/test-050-makeApiCall.R | 14 ++++++++------ 2 files changed, 9 insertions(+), 7 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index ca49ce47..dc595586 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -19,7 +19,7 @@ library(checkmate) # for additional expect_* functions. library(keyring) -url <- "https://redcap.vanderbilt.edu/api/" # Our institutions REDCap instance +url <- "https://redcap.vumc.org/api/" # Our institutions REDCap instance conns <- unlockREDCap( c(rcon ="TestRedcapAPI"), # Your default from keyring diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index f7c1562b..91d906cb 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -46,8 +46,9 @@ test_that( { h <- new_handle(timeout = 1L) e <- structure( - list(message = "Timeout was reached: [redcap.vanderbilt.edu] Operation timed out after 300001 milliseconds with 0 bytes received", - call = curl_fetch_memory("https://redcap.vanderbilt.edu/api/params", handle = h) + list(message = paste0("Timeout was reached: [", url, + "] Operation timed out after 300001 milliseconds with 0 bytes received"), + call = curl_fetch_memory(paste0(url,"/params"), handle = h) ), class = c("simpleError", "error", "condition") ) @@ -71,7 +72,7 @@ test_that( { h <- new_handle(timeout = 1L) goodVersionPOST <- structure( - list(url = "https://redcap.vanderbilt.edu/api/", + list(url = url, status_code = 200L, content = charToRaw("13.10.3"), headers=structure(list( @@ -80,8 +81,9 @@ test_that( class = c("insensitive", "list")), class = "response") e <- structure( - list(message = "Timeout was reached: [redcap.vanderbilt.edu] Operation timed out after 300001 milliseconds with 0 bytes received", - call = curl_fetch_memory("https://redcap.vanderbilt.edu/api/params", handle = h) + list(message = paste0("Timeout was reached: [", url, + "] Operation timed out after 300001 milliseconds with 0 bytes received"), + call = curl_fetch_memory(paste0(url,"/params"), handle = h) ), class = c("simpleError", "error", "condition") ) @@ -127,7 +129,7 @@ test_that( expect_error(redcapError(response, "null"), "A network error has occurred. This can happen when too much data is") - response$content <- charToRaw("Timeout was reached: [redcap.vanderbilt.edu] SSL connection timeout") + response$content <- charToRaw(paste0("Timeout was reached: [",url,"] SSL connection timeout")) expect_error(redcapError(response, "null"), "A network error has occurred. This can happen when too much data is") From b031bf6aaa070b2ccd49631562d139b726d8dab0 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 11:26:39 -0500 Subject: [PATCH 102/155] Made REDCAP_URL environment variable #353 --- tests/testthat/helper-00-REDCapQACredentials.R | 11 +++++++---- tests/testthat/helper-01-QASystemValues.R | 2 +- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index dc595586..f3144192 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -19,12 +19,15 @@ library(checkmate) # for additional expect_* functions. library(keyring) -url <- "https://redcap.vumc.org/api/" # Our institutions REDCap instance +# Defaults for our institutions institutions REDCap instance +# Override using environment variable REDCAP_URL +url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") -conns <- unlockREDCap( +unlockREDCap( c(rcon ="TestRedcapAPI"), # Your default from keyring #c(rcon = "YourChoiceOfKeyHere"), - url=url, keyring='API_KEYs', + url=url, + keyring='API_KEYs', envir=globalenv()) ############################################################################ @@ -46,7 +49,7 @@ conns <- unlockREDCap( # ), # url=url, keyring='API_KEYs') -missing_codes <- conns$rcon$projectInformation()$missing_data_codes +missing_codes <- rcon$projectInformation()$missing_data_codes if(!is.na(missing_codes) && nchar(missing_codes) > 0) stop("The test suite will fail if missing data codes are defined in the project.") diff --git a/tests/testthat/helper-01-QASystemValues.R b/tests/testthat/helper-01-QASystemValues.R index 130a7825..7603e4ba 100644 --- a/tests/testthat/helper-01-QASystemValues.R +++ b/tests/testthat/helper-01-QASystemValues.R @@ -10,5 +10,5 @@ EXPORT_REPORTS_ID <- as.numeric(strsplit(Sys.getenv('REPORT_IDS', '357209'), ',' RUN_USER_TESTS <- length(EXPENDABLE_USER) == 1 RUN_REPORTS_TEST <- TRUE -tryCatch( {exportReportsTyped(conns$rcon, report_id = EXPORT_REPORTS_ID[1]) }, +tryCatch( {exportReportsTyped(rcon, report_id = EXPORT_REPORTS_ID[1]) }, error = function(cond) RUN_REPORTS_TEST <<- FALSE) From c1c4755a82882738c388b49e294ffdf41467cd06 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 11:28:57 -0500 Subject: [PATCH 103/155] Added more environment variables #353 --- tests/testthat/helper-00-REDCapQACredentials.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index f3144192..08f8fed3 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -20,12 +20,12 @@ library(checkmate) # for additional expect_* functions. library(keyring) # Defaults for our institutions institutions REDCap instance -# Override using environment variable REDCAP_URL -url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") +# Override using environment variable REDCAP_URL and REDCAP_TESTDB_NAME +url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") +testdb <- Sys.getenv("REDCAP_TESTDB_NAME", "TestRedcapAPI") # reference in keyring unlockREDCap( - c(rcon ="TestRedcapAPI"), # Your default from keyring - #c(rcon = "YourChoiceOfKeyHere"), + c(rcon = testdb), url=url, keyring='API_KEYs', envir=globalenv()) From e4b3ed771285c5fc1af87b7db225660207abb3f0 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 11:33:02 -0500 Subject: [PATCH 104/155] Minor cleanup #353 --- tests/testthat/helper-00-REDCapQACredentials.R | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 08f8fed3..98bb6f1b 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -20,15 +20,16 @@ library(checkmate) # for additional expect_* functions. library(keyring) # Defaults for our institutions institutions REDCap instance -# Override using environment variable REDCAP_URL and REDCAP_TESTDB_NAME -url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") +# Override using environment variable REDCAP_URL, REDCAP_TESTDB_NAME, REDCAP_KEYRING +url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") testdb <- Sys.getenv("REDCAP_TESTDB_NAME", "TestRedcapAPI") # reference in keyring +keyring <- Sys.getenv("REDCAP_KEYRING", "API_KEYs") unlockREDCap( - c(rcon = testdb), - url=url, - keyring='API_KEYs', - envir=globalenv()) + c(rcon = testdb), # Open the keyring name as the variable rcon + url = url, # Using the url + keyring = keyring,# from the defined keyring + envir = 1) # in the global environment ############################################################################ # From 1fa8f87d475c2073941dc3023a4863b883704c3f Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 12:21:21 -0500 Subject: [PATCH 105/155] Test for redirect created #353 --- R/makeApiCall.R | 13 ++++--- .../testthat/helper-00-REDCapQACredentials.R | 2 +- tests/testthat/test-050-makeApiCall.R | 34 +++++++++++++++++++ 3 files changed, 44 insertions(+), 5 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index d63e2fd9..63a24594 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -199,7 +199,9 @@ makeApiCall <- function(rcon, message(paste0(">>>\n", as.character(response), "<<<\n")) } - is_retry_eligible <- .makeApiCall_isRetryEligible(response = response) + response <- .makeApiCall_handleRedirect(rcon, response) + + is_retry_eligible <- .makeApiCall_isRetryEligible(response) if (!is_retry_eligible) break @@ -223,8 +225,13 @@ makeApiCall <- function(rcon, #################################################################### # Unexported +.makeApiCall_handleRedirect <- function(rcon, response) +{ + response # the don't handle case for writing broken test cases +} -.makeApiCall_isRetryEligible <- function(response){ +.makeApiCall_isRetryEligible <- function(response) +{ # the return from this is a logical indicating if we are ready to break the loop. # we want to break the loop in cases where the response is anything that does # not justify a retry. @@ -238,8 +245,6 @@ makeApiCall <- function(rcon, return(retry_eligible) } - - .makeApiCall_retryMessage <- function(rcon, response, iteration){ diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 98bb6f1b..cb108f8b 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -29,7 +29,7 @@ unlockREDCap( c(rcon = testdb), # Open the keyring name as the variable rcon url = url, # Using the url keyring = keyring,# from the defined keyring - envir = 1) # in the global environment + envir = environment()) # in the global environment ############################################################################ # diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 91d906cb..1848b934 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -198,4 +198,38 @@ test_that( ) } +) + +test_that( + "makeApiCall handles redirect 301 and 302", + { + local_reproducible_output(width = 200) + rcon$url <- "https://test.xyz/api" # bogus entry + h <- new_handle(timeout = 1L) + redirect <- structure( + list(url = rcon$url, + status_code = 301L, + content = "", + headers=structure(list( + 'Content-Type'="text/csv; charset=utf-8", + 'Location'=url + ), + class = c("insensitive", "list")), + class = "response") + ) + + redirectCall <- TRUE + stub(makeApiCall, "httr::POST", function(...) + if(redirectCall) { redirectCall <<- FALSE; redirect } else {httr:::POST(...)}) + + expect_warning( + response <- makeApiCall(rcon, + body = list(content = "version", + format = "csv")), + paste0("Call redirected from https://test.xyz/api to ", url) + ) + + expect_equal(response$status_code, 200L) + expect_equal(rcon$url, url) + } ) \ No newline at end of file From 1e2a217d270a1c7a07e98ddeb7baefa294b52793 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 14:51:41 -0500 Subject: [PATCH 106/155] Working redirect. Note: Does not modify original connection. #353 --- R/makeApiCall.R | 22 +++++++++++-- tests/testthat/test-050-makeApiCall.R | 45 ++++++++++++++++++++++++--- 2 files changed, 59 insertions(+), 8 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 63a24594..0cd20f27 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -199,7 +199,7 @@ makeApiCall <- function(rcon, message(paste0(">>>\n", as.character(response), "<<<\n")) } - response <- .makeApiCall_handleRedirect(rcon, response) + response <- .makeApiCall_handleRedirect(rcon, body, config, response) is_retry_eligible <- .makeApiCall_isRetryEligible(response) @@ -225,9 +225,25 @@ makeApiCall <- function(rcon, #################################################################### # Unexported -.makeApiCall_handleRedirect <- function(rcon, response) +.makeApiCall_handleRedirect <- function(rcon, body, config, response) { - response # the don't handle case for writing broken test cases + if(response$status_code %in% c(301L, 302L)) + { + if(response$status_code == 301L) + { + warning(paste("Permanent 301 redirect", rcon$url, "to", response$headers$Location)) + } else + { + message(paste("Temporary 302 redirect", rcon$url, "to", response$headers$Location)) + } + + ## FIXME + ## Need some method to modify original source object!!! + rcon$url <- response$headers$location + + makeApiCall(rcon, body, config) + } else + response # The not redirected case } .makeApiCall_isRetryEligible <- function(response) diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 1848b934..92fb177e 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -2,6 +2,7 @@ context("makeApiCall Argument Validation") library(mockery) library(curl) +library(httr) # Note: This file will only test that arguments fail appropriately, or # that submethods perform as expected. the makeApiCall function @@ -201,7 +202,7 @@ test_that( ) test_that( - "makeApiCall handles redirect 301 and 302", + "makeApiCall handles permanent redirect", { local_reproducible_output(width = 200) rcon$url <- "https://test.xyz/api" # bogus entry @@ -211,8 +212,8 @@ test_that( status_code = 301L, content = "", headers=structure(list( - 'Content-Type'="text/csv; charset=utf-8", - 'Location'=url + 'content-type'="text/csv; charset=utf-8", + 'location'=url ), class = c("insensitive", "list")), class = "response") @@ -226,10 +227,44 @@ test_that( response <- makeApiCall(rcon, body = list(content = "version", format = "csv")), - paste0("Call redirected from https://test.xyz/api to ", url) + paste0("Permanent 301 redirect https://test.xyz/api to ", url) ) expect_equal(response$status_code, 200L) - expect_equal(rcon$url, url) + #expect_equal(rcon$url, url) + } +) + +test_that( + "makeApiCall handles temporary redirect", + { + local_reproducible_output(width = 200) + rcon$url <- "https://test.xyz/api" # bogus entry + h <- new_handle(timeout = 1L) + redirect <- structure( + list(url = rcon$url, + status_code = 302L, + content = "", + headers=structure(list( + 'content-type'="text/csv; charset=utf-8", + 'location'=url + ), + class = c("insensitive", "list")), + class = "response") + ) + + redirectCall <- TRUE + stub(makeApiCall, "httr::POST", function(...) + if(redirectCall) { redirectCall <<- FALSE; redirect } else {httr:::POST(...)}) + + expect_message( + response <- makeApiCall(rcon, + body = list(content = "version", + format = "csv")), + paste0("Temporary 302 redirect https://test.xyz/api to ", url) + ) + + expect_equal(response$status_code, 200L) + #expect_equal(rcon$url, url) } ) \ No newline at end of file From 67a3a34a6ab4e21742c0233f02bf2be10ab43259 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 15:01:51 -0500 Subject: [PATCH 107/155] Updated domain name in vignettes #353 --- inst/vignette-source/UsingOfflineConnections.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/vignette-source/UsingOfflineConnections.Rmd b/inst/vignette-source/UsingOfflineConnections.Rmd index 21a2f670..900fb182 100644 --- a/inst/vignette-source/UsingOfflineConnections.Rmd +++ b/inst/vignette-source/UsingOfflineConnections.Rmd @@ -94,7 +94,7 @@ With all of these components in place, the offline connection can now be created ```{r} off_con <- offlineConnection(meta_data = metadata_file, records = records_file, - url = "https://redcap.vanderbilt.edu/api/", + url = "https://redcap.vumc.org/api/", version = "13.10.3", events = event_data, project_info = project_info) From 53a332ddd560705643bd077737408bdab9b71a53 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 16:53:14 -0500 Subject: [PATCH 108/155] Working modifiable URL on a connection #353 --- R/makeApiCall.R | 8 +++----- R/redcapConnection.R | 8 +++++++- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 0cd20f27..54242b1f 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -231,15 +231,13 @@ makeApiCall <- function(rcon, { if(response$status_code == 301L) { - warning(paste("Permanent 301 redirect", rcon$url, "to", response$headers$Location)) + warning(paste("Permanent 301 redirect", response$url, "to", response$headers$Location)) } else { - message(paste("Temporary 302 redirect", rcon$url, "to", response$headers$Location)) + message(paste("Temporary 302 redirect", response$url, "to", response$headers$Location)) } - ## FIXME - ## Need some method to modify original source object!!! - rcon$url <- response$headers$location + assign("url", response$headers$location, envir=rcon$env.url) makeApiCall(rcon, body, config) } else diff --git a/R/redcapConnection.R b/R/redcapConnection.R index a62996f4..4cf8956b 100644 --- a/R/redcapConnection.R +++ b/R/redcapConnection.R @@ -250,7 +250,8 @@ redcapConnection <- function(url = getOption('redcap_api_url'), rc <- list( - url = u, + #url = u, + env.url = new.env(), token = t, config = config, @@ -391,9 +392,14 @@ redcapConnection <- function(url = getOption('redcap_api_url'), } ) class(rc) <- c("redcapApiConnection", "redcapConnection") + assign("url", url, envir=rc$env.url) rc } +#' @rdname redcapConnection +#' @export +`$.redcapApiConnection` <- function(x, i) if(i=='url') x$env.url$url else NextMethod() + #' @rdname redcapConnection #' @export From 41e736e884ae96008c9119b538aedd324c0713d6 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 17:14:07 -0500 Subject: [PATCH 109/155] Missed some refresh calls in prior updated to #350 --- R/createFileRepositoryFolder.R | 16 ++-------- R/deleteFileRepository.R | 12 ++----- R/deleteFromFileRepository.R | 11 ++----- R/docsFileRepositoryMethods.R | 3 -- R/importFileRepository.R | 17 +++------- R/importToFileRepository.R | 11 ++----- man/createFileRepositoryFolder.Rd | 4 --- man/fileRepositoryMethods.Rd | 5 --- man/fromFileRepositoryMethods.Rd | 2 -- ...-createFileRepository-ArgumentValidation.R | 16 ---------- ...ory-SingleFileMethods-ArgumentValidation.R | 32 ------------------- ...itory-BulkFileMethods-ArgumentValidation.R | 30 ----------------- 12 files changed, 13 insertions(+), 146 deletions(-) diff --git a/R/createFileRepositoryFolder.R b/R/createFileRepositoryFolder.R index 5d3be76f..d48e092f 100644 --- a/R/createFileRepositoryFolder.R +++ b/R/createFileRepositoryFolder.R @@ -16,8 +16,6 @@ #' provided, access to the folder will be restricted to the DAG. #' @param role_id `integerish(0/1)` The ID of a role. When provided, #' access to the folder will be restricted to users with that role. -#' @param refresh `logical(1)` When `TRUE` (default), the cached -#' File Repository data on `rcon` will be refreshed. #' #' @return #' Returns a data frame with the columns @@ -79,8 +77,7 @@ createFileRepositoryFolder.redcapApiConnection <- function(rcon, folder_id = numeric(0), dag_id = numeric(0), role_id = numeric(0), - ..., - refresh = TRUE, + ..., error_handling = getOption("redcap_error_handling"), config = list(), api_param = list()){ @@ -109,10 +106,6 @@ createFileRepositoryFolder.redcapApiConnection <- function(rcon, max.len = 1, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -182,11 +175,8 @@ createFileRepositoryFolder.redcapApiConnection <- function(rcon, } # Refresh the cached file repository ------------------------------ - - if (refresh && rcon$has_fileRepository()){ - rcon$refresh_fileRepository() - } - + rcon$flush_fileRepository() + # Prepare Output -------------------------------------------------- NewFolder <- as.data.frame(response) diff --git a/R/deleteFileRepository.R b/R/deleteFileRepository.R index b942fe0c..dd34dc5f 100644 --- a/R/deleteFileRepository.R +++ b/R/deleteFileRepository.R @@ -16,7 +16,6 @@ deleteFileRepository <- function(rcon, deleteFileRepository.redcapApiConnection <- function(rcon, folder_id, recursive = FALSE, - refresh = TRUE, ..., confirm = c("ask", "no", "yes"), error_handling = getOption("redcap_error_handling"), @@ -38,10 +37,6 @@ deleteFileRepository.redcapApiConnection <- function(rcon, len = 1, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - confirm <- checkmate::matchArg(x = confirm, choices = c("ask", "no", "yes"), add = coll, @@ -99,13 +94,10 @@ deleteFileRepository.redcapApiConnection <- function(rcon, for (i in seq_len(nrow(ToDelete))){ deleteFromFileRepository(rcon, - doc_id = ToDelete$doc_id[i], - refresh = FALSE) + doc_id = ToDelete$doc_id[i]) } - if (refresh && rcon$has_fileRepository()){ - rcon$refresh_fileRepository() - } + rcon$flush_fileRepository() ToDelete } diff --git a/R/deleteFromFileRepository.R b/R/deleteFromFileRepository.R index 8777372a..0c5b5a53 100644 --- a/R/deleteFromFileRepository.R +++ b/R/deleteFromFileRepository.R @@ -15,7 +15,6 @@ deleteFromFileRepository <- function(rcon, deleteFromFileRepository.redcapApiConnection <- function(rcon, doc_id, ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list()){ @@ -32,10 +31,6 @@ deleteFromFileRepository.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -84,10 +79,8 @@ deleteFromFileRepository.redcapApiConnection <- function(rcon, error_handling = error_handling) } - # Refresh the cached File Repository ------------------------------ - if (refresh && rcon$has_fileRepository()){ - rcon$refresh_fileRepository() - } + # Flush cached info + rcon$flush_fileRepository() data.frame(directory = dirname(file_path), filename = basename(file_path), diff --git a/R/docsFileRepositoryMethods.R b/R/docsFileRepositoryMethods.R index 87956643..019f800f 100644 --- a/R/docsFileRepositoryMethods.R +++ b/R/docsFileRepositoryMethods.R @@ -17,8 +17,6 @@ #' If `dir` does not exist and `dir_create = FALSE`, an error is thrown. #' @param recursive `logical(1)`. When `TRUE`, export all subfolders #' and their files as well. -#' @param refresh `logical(1)`. When `TRUE` (default), the cached -#' File Repository data on `rcon` will be refreshed. #' @param dag_id `integerish(0/1)` The ID of a data access group. When #' provided, access to the folder will be restricted to the DAG. #' @param role_id `integerish(0/1)` The ID of a role. When provided, @@ -129,7 +127,6 @@ fileRepositoryMethods <- function(rcon, dag_id, role_id, recursive, - refresh, confirm, ..., error_handling, diff --git a/R/importFileRepository.R b/R/importFileRepository.R index 3d811bc4..23bd9bae 100644 --- a/R/importFileRepository.R +++ b/R/importFileRepository.R @@ -19,8 +19,7 @@ importFileRepository.redcapApiConnection <- function(rcon, dag_id = numeric(0), role_id = numeric(0), recursive = FALSE, - ..., - refresh = TRUE, + ..., error_handling = getOption("redcap_error_handling"), config = list(), api_param = list()){ @@ -53,10 +52,6 @@ importFileRepository.redcapApiConnection <- function(rcon, len = 1, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -89,9 +84,7 @@ importFileRepository.redcapApiConnection <- function(rcon, dag_id = dag_id, role_id = dag_id) - if (refresh && rcon$has_fileRepository()){ - rcon$refresh_fileRepository() - } + rcon$flush_fileRepository() LocalRepo } @@ -214,8 +207,7 @@ importFileRepository.redcapApiConnection <- function(rcon, name = LocalRepo$name[i], folder_id = this_folder_id, dag_id = dag_id, - role_id = role_id, - refresh = TRUE) + role_id = role_id) LocalRepo$remote_folder_id[i] <- NewFolder$folder_id } else { @@ -228,8 +220,7 @@ importFileRepository.redcapApiConnection <- function(rcon, NewFile <- importToFileRepository(rcon, file = this_file, - folder_id = this_folder_id, - refresh = TRUE) + folder_id = this_folder_id) } } diff --git a/R/importToFileRepository.R b/R/importToFileRepository.R index a544e121..db582ac1 100644 --- a/R/importToFileRepository.R +++ b/R/importToFileRepository.R @@ -17,7 +17,6 @@ importToFileRepository.redcapApiConnection <- function(rcon, file, folder_id = numeric(0), ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list()){ @@ -38,10 +37,6 @@ importToFileRepository.redcapApiConnection <- function(rcon, any.missing = FALSE, add = coll) - checkmate::assert_logical(x = refresh, - len = 1, - add = coll) - error_handling <- checkmate::matchArg(x = error_handling, choices = c("null", "error"), .var.name = "error_handling", @@ -78,10 +73,8 @@ importToFileRepository.redcapApiConnection <- function(rcon, body = c(body, api_param), config = config) - # Refresh the cached File Repository ------------------------------ - if (refresh && rcon$has_fileRepository()){ - rcon$refresh_fileRepository() - } + # flush the cached File Repository ------------------------------ + rcon$flush_fileRepository() # Get the path of the file in the File Repository ----------------- fileRepo <- rcon$fileRepository() diff --git a/man/createFileRepositoryFolder.Rd b/man/createFileRepositoryFolder.Rd index d32e7aa1..de701f86 100644 --- a/man/createFileRepositoryFolder.Rd +++ b/man/createFileRepositoryFolder.Rd @@ -21,7 +21,6 @@ createFileRepositoryFolder( dag_id = numeric(0), role_id = numeric(0), ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list() @@ -44,9 +43,6 @@ access to the folder will be restricted to users with that role.} \item{...}{Arguments to pass to other methods} -\item{refresh}{\code{logical(1)} When \code{TRUE} (default), the cached -File Repository data on \code{rcon} will be refreshed.} - \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. An option for how to handle errors returned by the API. see \code{\link[=redcapError]{redcapError()}}.} diff --git a/man/fileRepositoryMethods.Rd b/man/fileRepositoryMethods.Rd index 27d83afb..7566f2c2 100644 --- a/man/fileRepositoryMethods.Rd +++ b/man/fileRepositoryMethods.Rd @@ -44,7 +44,6 @@ deleteFileRepository(rcon, folder_id, recursive = FALSE, ...) role_id = numeric(0), recursive = FALSE, ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list() @@ -54,7 +53,6 @@ deleteFileRepository(rcon, folder_id, recursive = FALSE, ...) rcon, folder_id, recursive = FALSE, - refresh = TRUE, ..., confirm = c("ask", "no", "yes"), error_handling = getOption("redcap_error_handling"), @@ -84,9 +82,6 @@ access to the folder will be restricted to users with that role.} \item{recursive}{\code{logical(1)}. When \code{TRUE}, export all subfolders and their files as well.} -\item{refresh}{\code{logical(1)}. When \code{TRUE} (default), the cached -File Repository data on \code{rcon} will be refreshed.} - \item{confirm}{\code{character}. One of \code{c("ask", "no", "yes")}. When \code{"ask"}, user will be prompted to confirm the deletion. When \code{"no"}, the function will terminate with no action. When diff --git a/man/fromFileRepositoryMethods.Rd b/man/fromFileRepositoryMethods.Rd index 3354bf84..46a426fc 100644 --- a/man/fromFileRepositoryMethods.Rd +++ b/man/fromFileRepositoryMethods.Rd @@ -34,7 +34,6 @@ deleteFromFileRepository(rcon, doc_id, ...) file, folder_id = numeric(0), ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list() @@ -44,7 +43,6 @@ deleteFromFileRepository(rcon, doc_id, ...) rcon, doc_id, ..., - refresh = TRUE, error_handling = getOption("redcap_error_handling"), config = list(), api_param = list() diff --git a/tests/testthat/test-302-createFileRepository-ArgumentValidation.R b/tests/testthat/test-302-createFileRepository-ArgumentValidation.R index 7864f077..8c7207ae 100644 --- a/tests/testthat/test-302-createFileRepository-ArgumentValidation.R +++ b/tests/testthat/test-302-createFileRepository-ArgumentValidation.R @@ -97,22 +97,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(createFileRepositoryFolder(rcon, - name = "folder", - refresh = c(TRUE, FALSE)), - "'refresh': Must have length 1") - - expect_error(createFileRepositoryFolder(rcon, - name = "folder", - refresh = "TRUE"), - "'refresh': Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-303-fileRepository-SingleFileMethods-ArgumentValidation.R b/tests/testthat/test-303-fileRepository-SingleFileMethods-ArgumentValidation.R index fb321f32..a4626b69 100644 --- a/tests/testthat/test-303-fileRepository-SingleFileMethods-ArgumentValidation.R +++ b/tests/testthat/test-303-fileRepository-SingleFileMethods-ArgumentValidation.R @@ -175,23 +175,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importToFileRepository(rcon, - file = "file1", - folder_id = 123, - refresh = c(TRUE, FALSE)), - "'refresh'[:] Must have length 1") - expect_error(importToFileRepository(rcon, - file = "file1", - folder_id = 123, - refresh = "TRUE"), - "Variable 'refresh'[:] Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { @@ -253,21 +236,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(deleteFromFileRepository(rcon, - doc_id = 123, - refresh = c(TRUE, FALSE)), - "'refresh'[:] Must have length 1") - expect_error(deleteFromFileRepository(rcon, - doc_id = 123, - refresh = "TRUE"), - "'refresh'[:] Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { diff --git a/tests/testthat/test-304-fileRepository-BulkFileMethods-ArgumentValidation.R b/tests/testthat/test-304-fileRepository-BulkFileMethods-ArgumentValidation.R index c7f9b8ae..57092d45 100644 --- a/tests/testthat/test-304-fileRepository-BulkFileMethods-ArgumentValidation.R +++ b/tests/testthat/test-304-fileRepository-BulkFileMethods-ArgumentValidation.R @@ -191,21 +191,6 @@ test_that( } ) -test_that( - "Return an error when refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(importFileRepository(rcon, - dir = tempdir(), - refresh = c(TRUE, FALSE)), - "'refresh'[:] Must have length 1") - expect_error(importFileRepository(rcon, - dir = tempdir(), - refresh = "TRUE"), - "'refresh'[:] Must be of type 'logical'") - } -) - test_that( "Validate error_handling, config, api_param", { @@ -276,21 +261,6 @@ test_that( } ) -test_that( - "Return an error if refresh is not logical(1)", - { - local_reproducible_output(width = 200) - expect_error(deleteFileRepository(rcon, - folder_id = 123, - refresh = c(TRUE, FALSE)), - "Variable 'refresh'[:] Must have length 1") - expect_error(deleteFileRepository(rcon, - folder_id = 123, - refresh = "TRUE"), - "Variable 'refresh'[:] Must be of type 'logical'") - } -) - test_that( "Return an error when confirm is not ask, no, or yes", { From 05c35cface057c05f3c1c0d1a0bacc13bcc6d2ea Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 17:26:42 -0500 Subject: [PATCH 110/155] Working on passing CHECK #353 --- NAMESPACE | 1 + R/redcapConnection.R | 1 - 2 files changed, 1 insertion(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 3ae881dd..6930eb8a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,5 +1,6 @@ # Generated by roxygen2: do not edit by hand +S3method("$",redcapApiConnection) S3method("[",redcapFactor) S3method(allocationTable,redcapApiConnection) S3method(as.list,redcapCodebook) diff --git a/R/redcapConnection.R b/R/redcapConnection.R index 4cf8956b..fe3f765f 100644 --- a/R/redcapConnection.R +++ b/R/redcapConnection.R @@ -396,7 +396,6 @@ redcapConnection <- function(url = getOption('redcap_api_url'), rc } -#' @rdname redcapConnection #' @export `$.redcapApiConnection` <- function(x, i) if(i=='url') x$env.url$url else NextMethod() From cef428e7998a24521853e213ee0af238f484877c Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 17 Apr 2024 22:41:16 -0500 Subject: [PATCH 111/155] Added news #353 --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index 7740e49e..e86c4b47 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.0 * Refactor of missingSummary to use exportRecordsTyped. This is a breaking change in prep of 3.0.0. +* Added handling of url redirects (301,302) on makeApiCall. ## 2.8.5 From d3a9dcdc11b6dc67c1d6af836e7b0a9f8a91a553 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 18 Apr 2024 08:36:32 -0500 Subject: [PATCH 112/155] Fixed test for new method on url #353 --- tests/testthat/test-050-makeApiCall.R | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 92fb177e..4e328bb6 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -205,7 +205,7 @@ test_that( "makeApiCall handles permanent redirect", { local_reproducible_output(width = 200) - rcon$url <- "https://test.xyz/api" # bogus entry + assign("url", "https://test.xyz/api", envir=rcon$env.url) h <- new_handle(timeout = 1L) redirect <- structure( list(url = rcon$url, @@ -231,7 +231,10 @@ test_that( ) expect_equal(response$status_code, 200L) - #expect_equal(rcon$url, url) + expect_equal(rcon$url, url) + + assign("url", url, envir=rcon$env.url) + } ) @@ -239,7 +242,8 @@ test_that( "makeApiCall handles temporary redirect", { local_reproducible_output(width = 200) - rcon$url <- "https://test.xyz/api" # bogus entry + assign("url", "https://test.xyz/api", envir=rcon$env.url) + h <- new_handle(timeout = 1L) redirect <- structure( list(url = rcon$url, @@ -265,6 +269,8 @@ test_that( ) expect_equal(response$status_code, 200L) - #expect_equal(rcon$url, url) + expect_equal(rcon$url, url) + assign("url", url, envir=rcon$env.url) + } ) \ No newline at end of file From 17f7ffd330a1f68111836302e7f59698a424d257 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 18 Apr 2024 13:20:52 -0500 Subject: [PATCH 113/155] Stripped out url by reference code based on Cole's feedback #353 --- NAMESPACE | 1 - R/makeApiCall.R | 2 -- R/redcapConnection.R | 7 +------ tests/testthat/test-050-makeApiCall.R | 13 ++----------- 4 files changed, 3 insertions(+), 20 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 6930eb8a..3ae881dd 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,6 +1,5 @@ # Generated by roxygen2: do not edit by hand -S3method("$",redcapApiConnection) S3method("[",redcapFactor) S3method(allocationTable,redcapApiConnection) S3method(as.list,redcapCodebook) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index 54242b1f..fe1276c3 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -237,8 +237,6 @@ makeApiCall <- function(rcon, message(paste("Temporary 302 redirect", response$url, "to", response$headers$Location)) } - assign("url", response$headers$location, envir=rcon$env.url) - makeApiCall(rcon, body, config) } else response # The not redirected case diff --git a/R/redcapConnection.R b/R/redcapConnection.R index fe3f765f..a62996f4 100644 --- a/R/redcapConnection.R +++ b/R/redcapConnection.R @@ -250,8 +250,7 @@ redcapConnection <- function(url = getOption('redcap_api_url'), rc <- list( - #url = u, - env.url = new.env(), + url = u, token = t, config = config, @@ -392,13 +391,9 @@ redcapConnection <- function(url = getOption('redcap_api_url'), } ) class(rc) <- c("redcapApiConnection", "redcapConnection") - assign("url", url, envir=rc$env.url) rc } -#' @export -`$.redcapApiConnection` <- function(x, i) if(i=='url') x$env.url$url else NextMethod() - #' @rdname redcapConnection #' @export diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index 4e328bb6..bbea4c14 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -205,10 +205,9 @@ test_that( "makeApiCall handles permanent redirect", { local_reproducible_output(width = 200) - assign("url", "https://test.xyz/api", envir=rcon$env.url) h <- new_handle(timeout = 1L) redirect <- structure( - list(url = rcon$url, + list(url = "https://test.xyz/api", status_code = 301L, content = "", headers=structure(list( @@ -231,10 +230,6 @@ test_that( ) expect_equal(response$status_code, 200L) - expect_equal(rcon$url, url) - - assign("url", url, envir=rcon$env.url) - } ) @@ -242,11 +237,10 @@ test_that( "makeApiCall handles temporary redirect", { local_reproducible_output(width = 200) - assign("url", "https://test.xyz/api", envir=rcon$env.url) h <- new_handle(timeout = 1L) redirect <- structure( - list(url = rcon$url, + list(url = "https://test.xyz/api", status_code = 302L, content = "", headers=structure(list( @@ -269,8 +263,5 @@ test_that( ) expect_equal(response$status_code, 200L) - expect_equal(rcon$url, url) - assign("url", url, envir=rcon$env.url) - } ) \ No newline at end of file From cdb110eebc5f1ee90dc084dde99cbcbdc6a713f3 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 18 Apr 2024 14:21:39 -0500 Subject: [PATCH 114/155] unlockREDCap now deals with redirects. #353 --- R/unlockREDCap.R | 21 +++++++++-- tests/testthat/test-024-unlockREDCap.R | 52 +++++++++++++++++++++++++- 2 files changed, 68 insertions(+), 5 deletions(-) diff --git a/R/unlockREDCap.R b/R/unlockREDCap.R index f2c60c89..4542850d 100644 --- a/R/unlockREDCap.R +++ b/R/unlockREDCap.R @@ -21,9 +21,24 @@ { tryCatch( { - conn <- redcapConnection(token=key, url=url, ...) - conn$metadata() # Test connection by reading metadata into cache - conn + rcon <- redcapConnection(token=key, url=url, ...) + version <- list(content = "version", format = "csv") + # Test connection by checking version + response <- makeApiCall(rcon, body = version) + + # No redirect, this is success + if(!response$status_code %in% c(301L, 302L)) return(rcon) + + # Handle redirect + rcon <- redcapConnection(token=key, url=response$header$location, ...) + + # Test connection by checking version post redirect + response <- makeApiCall(rcon, body = version) + + if(response$status_code %in% c(301L, 302L)) + stop(paste("Too many redirects from", url)) + + rcon }, error = function(e) { diff --git a/tests/testthat/test-024-unlockREDCap.R b/tests/testthat/test-024-unlockREDCap.R index ddb015ca..9c3f276e 100644 --- a/tests/testthat/test-024-unlockREDCap.R +++ b/tests/testthat/test-024-unlockREDCap.R @@ -1,13 +1,61 @@ context("unlockREDCap") library(mockery) +library(curl) +library(httr) + +h <- new_handle(timeout = 1L) +redirect <- structure( + list(url = "https://test.xyz/api", + status_code = 302L, + content = "", + headers=structure(list( + 'content-type'="text/csv; charset=utf-8", + 'location'=url + ), + class = c("insensitive", "list")), + class = "response") +) test_that( ".connectAndCheck returns result of redcapConnection", { - stub(.connectAndCheck, "redcapConnection", list(metadata=function(...) TRUE)) + stub(.connectAndCheck, "redcapConnection", rcon) - expect_true(.connectAndCheck("key", "url")$metadata()) + expect_identical(.connectAndCheck("key", "url"), rcon) + } +) + +test_that( + ".connectAndCheck deals with redirect 301 status", + { + redirectCall <- TRUE + stub(.connectAndCheck, "makeApiCall", function(...) + if(redirectCall) { redirectCall <<- FALSE; redirect } else {makeApiCall(...)}) + + rcon <- .connectAndCheck(rcon$token, "https://test.xyz/api") + expect_equal(rcon$url, url) + } +) + +test_that( + ".connectAndCheck deals with redirect 302 status", + { + redirectCall <- TRUE + stub(.connectAndCheck, "makeApiCall", function(...) + if(redirectCall) { redirectCall <<- FALSE; redirect } else {makeApiCall(...)}) + + rcon <- .connectAndCheck(rcon$token, "https://test.xyz/api") + expect_equal(rcon$url, url) + } +) + +test_that( + ".connectAndCheck does not allow for more than one redirect", + { + stub(.connectAndCheck, "makeApiCall", redirect) + + expect_error(.connectAndCheck(rcon$token, "https://test.xyz/api")) } ) From 0ee2730db8a49281daa3d404b8394d02bb5a935e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 19 Apr 2024 09:59:46 -0500 Subject: [PATCH 115/155] Missed redirect in redirect code #353 --- R/makeApiCall.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/makeApiCall.R b/R/makeApiCall.R index fe1276c3..a1ddace3 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -237,6 +237,8 @@ makeApiCall <- function(rcon, message(paste("Temporary 302 redirect", response$url, "to", response$headers$Location)) } + # Good for a single call + rcon$url <- response$header$location makeApiCall(rcon, body, config) } else response # The not redirected case From b3f447bdbd3ff27e4a47ba48d8c443f0c1294a9c Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 19 Apr 2024 13:23:56 -0500 Subject: [PATCH 116/155] Bumped version number so all changes will be numbered after CRAN release --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b40d608b..f76a842a 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: redcapAPI Type: Package Title: Interface to 'REDCap' -Version: 2.9.0 +Version: 2.9.1 Authors@R: c( person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", role = c("ctb", "aut")), From 5ebdb3c4054911c35f05531e891d50b9f3632948 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 22 Apr 2024 08:55:22 -0500 Subject: [PATCH 117/155] delete records more arguments #315 --- R/deleteRecords.R | 62 +++++++++++++++++++++++++++++++++++++---------- 1 file changed, 49 insertions(+), 13 deletions(-) diff --git a/R/deleteRecords.R b/R/deleteRecords.R index 3882ab1d..9c2f2e24 100644 --- a/R/deleteRecords.R +++ b/R/deleteRecords.R @@ -39,23 +39,32 @@ #' @export deleteRecords <- function(rcon, - records, - arm = NULL, - ...){ + records, + arm = NULL, + instrument = NULL, + event = NULL, + repeat_instance = NULL, + delete_logging = FALSE, + ...) +{ UseMethod("deleteRecords") } #' @rdname deleteRecords #' @export - -deleteRecords.redcapApiConnection <- function(rcon, - records, - arm = NULL, - ..., - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list()){ - +deleteRecords.redcapApiConnection <- function( + rcon, + records, + arm = NULL, + instrument = NULL, + event = NULL, + repeat_instance = NULL, + delete_logging = FALSE, + ..., + error_handling = getOption("redcap_error_handling"), + config = list(), + api_param = list()) +{ if (is.numeric(records)) records <- as.character(records) if (is.character(arm)) arm <- as.numeric(arm) @@ -69,6 +78,29 @@ deleteRecords.redcapApiConnection <- function(rcon, min.len = 1, add = coll) + checkmate::assert_character(x = instrument, + any.missing = FALSE, + len = 1, + null.ok = TRUE, + add = coll) + + checkmate::assert_character(x = event, + any.missing = FALSE, + len = 1, + null.ok = TRUE, + add = coll) + + checkmate::assert_integerish(x = repeat_instance, + len = 1, + any.missing = FALSE, + null.ok = TRUE, + add = coll) + + checkmate::assert_logical(x=delete_logging, + any.missing = FALSE, + len = 1, + add = coll) + checkmate::assert_integerish(arm, len = 1, any.missing = FALSE, @@ -104,7 +136,11 @@ deleteRecords.redcapApiConnection <- function(rcon, body <- list(token = rcon$token, content = "record", action = "delete", - arm = arm) + arm = arm, + instrument = instrument, + event = event, + repeat_instance = repeat_instance, + delete_logging = delete_logging) body <- c(body, vectorToApiBodyList(vector = records, From 5d9bedaa02f6d56201bac57ebae56bf71b653c6d Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 22 Apr 2024 08:56:44 -0500 Subject: [PATCH 118/155] Bumped new for deleteRecords #315 --- NEWS | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS b/NEWS index e86c4b47..889c39c8 100644 --- a/NEWS +++ b/NEWS @@ -10,6 +10,10 @@ A future release of version 3.0.0 will introduce several breaking changes! * The `exportProjectInfo` and `exportBundle` functions are being discontinued. Their functionality is replaced by caching values on the connection object. * The `cleanseMetaData` function is being discontinued. +## 2.9.1 + +* Added additional supported arguments to deleteRecords + ## 2.9.0 * Refactor of missingSummary to use exportRecordsTyped. This is a breaking change in prep of 3.0.0. From d630e64787aa1458b986d80ab85f1ed459ea9fcd Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 22 Apr 2024 09:01:55 -0500 Subject: [PATCH 119/155] Added documentation for new parameters of deleteRecords #315 --- R/deleteRecords.R | 7 ++++++- man/deleteRecords.Rd | 24 +++++++++++++++++++++++- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/R/deleteRecords.R b/R/deleteRecords.R index 9c2f2e24..d052e306 100644 --- a/R/deleteRecords.R +++ b/R/deleteRecords.R @@ -13,7 +13,12 @@ #' longitudinal with more than one arm. If the arm parameter is not #' provided, the specified records will be deleted from all arms in which #' they exist. Whereas, if `arm` is provided, they will only be deleted from -#' the specified arm. +#' the specified arm. +#' @param instrument `character(1)` Optional instrument to delete records from. +#' @param event `character(1)` Optional event to delete records from. +#' @param repeat_instance `numeric(1)` optional repeat instance to delete records from. +#' @param delete_logging `logical`. Should the logging for this record be +#' delete as well. Default to FALSE. #' #' @return #' `deleteRecords` invisibly returns a character value giving the number of records deleted. diff --git a/man/deleteRecords.Rd b/man/deleteRecords.Rd index 620712db..3eedb748 100644 --- a/man/deleteRecords.Rd +++ b/man/deleteRecords.Rd @@ -5,12 +5,25 @@ \alias{deleteRecords.redcapApiConnection} \title{Delete Records from a Project} \usage{ -deleteRecords(rcon, records, arm = NULL, ...) +deleteRecords( + rcon, + records, + arm = NULL, + instrument = NULL, + event = NULL, + repeat_instance = NULL, + delete_logging = FALSE, + ... +) \method{deleteRecords}{redcapApiConnection}( rcon, records, arm = NULL, + instrument = NULL, + event = NULL, + repeat_instance = NULL, + delete_logging = FALSE, ..., error_handling = getOption("redcap_error_handling"), config = list(), @@ -30,6 +43,15 @@ provided, the specified records will be deleted from all arms in which they exist. Whereas, if \code{arm} is provided, they will only be deleted from the specified arm.} +\item{instrument}{\code{character(1)} Optional instrument to delete records from.} + +\item{event}{\code{character(1)} Optional event to delete records from.} + +\item{repeat_instance}{\code{numeric(1)} optional repeat instance to delete records from.} + +\item{delete_logging}{\code{logical}. Should the logging for this record be +delete as well. Default to FALSE.} + \item{...}{Arguments to pass to other methods} \item{error_handling}{\code{character(1)}. One of \code{c("error", "null")}. From 8146a7b66dac8ba5b613001e1d8aa36c06e21c81 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 22 Apr 2024 09:13:25 -0500 Subject: [PATCH 120/155] Added additional deleteRecords argument validation tests #315 --- ...0-importDeleteRecords-ArgumentValidation.R | 62 +++++++++++++++++++ 1 file changed, 62 insertions(+) diff --git a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R index 99a70d93..95f54da1 100644 --- a/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R +++ b/tests/testthat/test-150-importDeleteRecords-ArgumentValidation.R @@ -49,6 +49,7 @@ test_that( } ) + test_that( "Return an error if data is not a data frame", { @@ -241,6 +242,7 @@ test_that( ##################################################################### # Delete Records Argument Validation #### +context("deleteRecords Argument Validation") importRecords(rcon, ImportData) @@ -264,6 +266,66 @@ test_that( } ) +test_that( + "Return an error if instrument is not a character(1)", + { + local_reproducible_output(width = 200) + expect_error(deleteRecords(rcon, + records = 1, + instrument = TRUE), + "'instrument': Must be of type 'character'") + expect_error(deleteRecords(rcon, + records = 1, + instrument = c("a", "b")), + "'instrument': Must have length 1") + } +) + +test_that( + "Return an error if event is not a character(1)", + { + local_reproducible_output(width = 200) + expect_error(deleteRecords(rcon, + records = 1, + event = TRUE), + "'event': Must be of type 'character'") + expect_error(deleteRecords(rcon, + records = 1, + event = c("a", "b")), + "'event': Must have length 1") + } +) + +test_that( + "Return an error if repeat_instance is not a numeric(1)", + { + local_reproducible_output(width = 200) + expect_error(deleteRecords(rcon, + records = 1, + repeat_instance = TRUE), + "'repeat_instance': Must be of type 'integerish'") + expect_error(deleteRecords(rcon, + records = 1, + repeat_instance = c(1,2)), + "'repeat_instance': Must have length 1") + } +) + +test_that( + "Return an error if delete_logging is not a logical(1)", + { + local_reproducible_output(width = 200) + expect_error(deleteRecords(rcon, + records = 1, + delete_logging = 1), + "'delete_logging': Must be of type 'logical'") + expect_error(deleteRecords(rcon, + records = 1, + delete_logging = c(TRUE, FALSE)), + "'delete_logging': Must have length 1") + } +) + test_that( "Return an error if arm is not an arm in the project", { From af48c20859d5739fb09e4ec33d0fa59d5c7fa705 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Mon, 22 Apr 2024 09:22:50 -0500 Subject: [PATCH 121/155] Updated issue triage to add choice problem #344 --- README.md | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/README.md b/README.md index d910cfec..a6b77cfc 100644 --- a/README.md +++ b/README.md @@ -77,12 +77,13 @@ If you wish to contribute new features to this software, we are open to [pull re REDCap and it's API have a large number of options and choices, with such complexity the possibility of bugs increases as well. This is a checklist for troubleshooting exports. 1. Does `Rec <- exportRecordsTyped(rcon)` give you a warning about data that failed validations? If so, what kind of content are you seeing from `reviewInvalidRecords(Rec)`? -2. What is returned by `exportRecordsTyped(rcon, validation = skip_validation, cast = raw_cast)`? This is a completely raw export with no processing by the library. -3. Do you have any project level missing data codes? `rcon$projectInformation()$missing_data_codes` -4. Do you have a secondary id field defined? `rcon$projectInformation()$secondary_unique_field`. In earlier versions REDCap will report one even if it's been disabled later, if this column doesn't exist then the library is unable to properly handle exports as the definition of the unique key doesn't exist. If one is defined and the field doesn't exist, one will have to contact their REDCap administrator to get the project fixed. -5. Is it an empty row filtering issue? Try the option `filter_empty_rows=FALSE` and see if that fixes it. -6. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. -7. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) +2. Did you see 'choice string does not appear to be formatted for choices' as an error? If so see [Issue #344](https://github.com/vubiostat/redcapAPI/issues/344) +3. What is returned by `exportRecordsTyped(rcon, validation = skip_validation, cast = raw_cast)`? This is a completely raw export with no processing by the library. +4. Do you have any project level missing data codes? `rcon$projectInformation()$missing_data_codes` +5. Do you have a secondary id field defined? `rcon$projectInformation()$secondary_unique_field`. In earlier versions REDCap will report one even if it's been disabled later, if this column doesn't exist then the library is unable to properly handle exports as the definition of the unique key doesn't exist. If one is defined and the field doesn't exist, one will have to contact their REDCap administrator to get the project fixed. +6. Is it an empty row filtering issue? Try the option `filter_empty_rows=FALSE` and see if that fixes it. +7. Search known open and closed [issues](https://github.com/vubiostat/redcapAPI/issues) to see if it's already been reported. If an issue matches your problem, then feel free to post a "me too" message with the information from the next step. Feel free to reopen a closed issue if one matches. +8. If these steps fail to diagnose the issue, open an [issue](https://github.com/vubiostat/redcapAPI/issues) on github.com and we are happy to assist you. Please include your version of R, RStudio and `packageVersion('redcapAPI')`. #### What does "Project contains invalid characters. Mapped to '□'." mean? From 76317b4a5d52f86615b45b933353947af470e0bb Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 1 May 2024 13:06:47 -0500 Subject: [PATCH 122/155] Added comparison matrix to README --- README.md | 23 ++++++++++++++++++++++- 1 file changed, 22 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index a6b77cfc..192a7cda 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ [![License: GPL v2](https://img.shields.io/badge/License-GPL_v2-blue.svg)](https://www.gnu.org/licenses/old-licenses/gpl-2.0.en.html) redcapAPI -====== +========= `redcapAPI` is an [R](https://www.r-project.org) package to pull data from a [REDCap](https://www.project-redcap.org/) project. Its design goes far beyond a 'thin' client which just exposes the raw REDCap API into R. One principal goal is to get data into memory using base R in a format that is analysis ready with a minimum of function calls. There are over 7,000 institutions and 3 million users of REDCap worldwide collecting data. Analysis in R for monitoring and reporting that data is a common concern for these projects. @@ -22,6 +22,27 @@ Core concerns handled by the library: * Additional helper functions, e.g. longitudinal wider/long conversions, guessing if a character field is actually a date, and SAS exports. * Importing data reuses a lot of the casting functions in reverse to ensure data integrity both directions. +## Comparison to Other REDCap Packages + +| Feature | redcapAPI | REDCapR | REDCapExporter | tidyREDCap | REDCapTidieR | REDCapDM | +|--------------------------|:---------:|:-------:|:--------------:|:----------:|:------------:|:--------:| +| CRAN Downloads | ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapExportera) | ![](https://cranlogs.r-pkg.org/badges/grand-total/tidyREDCap) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapTidieR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapDM) | +| Export Data To R | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | +| Import Data From R | ✅ | ✅ | ❌ | ❌ | ❌ | ❌ | +| Sparse Block Splitting | ✅ | ✅ | ❌ | ✅ | ✅ | ✅ | +| Field Labelling | ✅ | ❌ | ❌ | ✅ | ❌ | ✅ | +| Attribute Processing | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | +| Logical Expression Query | partial | ❌ | ❌ | ❌ | ❌ | ✅ | +| Tidy/Tibble Support | ❌ | ❌ | ❌ | ❌ | ✅ | ❌ | +| Metadata Summarization | ❌ | ❌ | ❌ | ❌ | ✅ | ❌ | +| Type Conversion Callbacks| ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | +| API Failure Auto-Retry | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | +| Secure API Key Storage | ✅ | ❌ | ✅ | ❌ | ❌ | ❌ | +| Validation Reporting | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | +| Extensive Test Suite | ✅ | ✅ | ❌ | ❌ | ✅ | ❌ | +| Logfile Processing | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | +| Offline Calculated Fields| ❌ | ❌ | ❌ | ❌ | ❌ | ✅ | + ## Quick Start Guide There are 2 basic functions that are key to understanding the core approach: From 0f34901b31f3cb0912238de9928c67fcf855a352 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Wed, 1 May 2024 13:10:04 -0500 Subject: [PATCH 123/155] Minor typo in package comparison --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 192a7cda..4c30119b 100644 --- a/README.md +++ b/README.md @@ -26,7 +26,7 @@ Core concerns handled by the library: | Feature | redcapAPI | REDCapR | REDCapExporter | tidyREDCap | REDCapTidieR | REDCapDM | |--------------------------|:---------:|:-------:|:--------------:|:----------:|:------------:|:--------:| -| CRAN Downloads | ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapExportera) | ![](https://cranlogs.r-pkg.org/badges/grand-total/tidyREDCap) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapTidieR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapDM) | +| CRAN Downloads | ![](https://cranlogs.r-pkg.org/badges/grand-total/redcapAPI) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapExporter) | ![](https://cranlogs.r-pkg.org/badges/grand-total/tidyREDCap) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapTidieR) | ![](https://cranlogs.r-pkg.org/badges/grand-total/REDCapDM) | | Export Data To R | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | | Import Data From R | ✅ | ✅ | ❌ | ❌ | ❌ | ❌ | | Sparse Block Splitting | ✅ | ✅ | ❌ | ✅ | ✅ | ✅ | From 84981391b183a3e555076d4c71849647c977c4f2 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Thu, 2 May 2024 07:40:28 -0500 Subject: [PATCH 124/155] Minor edits to README --- README.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 4c30119b..d2189ac5 100644 --- a/README.md +++ b/README.md @@ -30,11 +30,11 @@ Core concerns handled by the library: | Export Data To R | ✅ | ✅ | ✅ | ✅ | ✅ | ✅ | | Import Data From R | ✅ | ✅ | ❌ | ❌ | ❌ | ❌ | | Sparse Block Splitting | ✅ | ✅ | ❌ | ✅ | ✅ | ✅ | -| Field Labelling | ✅ | ❌ | ❌ | ✅ | ❌ | ✅ | +| Field Labeling | ✅ | ❌ | ❌ | ✅ | ❌ | ✅ | | Attribute Processing | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | | Logical Expression Query | partial | ❌ | ❌ | ❌ | ❌ | ✅ | | Tidy/Tibble Support | ❌ | ❌ | ❌ | ❌ | ✅ | ❌ | -| Metadata Summarization | ❌ | ❌ | ❌ | ❌ | ✅ | ❌ | +| Data Summary | ❌ | ❌ | ❌ | ❌ | ✅ | ❌ | | Type Conversion Callbacks| ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | | API Failure Auto-Retry | ✅ | ❌ | ❌ | ❌ | ❌ | ❌ | | Secure API Key Storage | ✅ | ❌ | ✅ | ❌ | ❌ | ❌ | From f13d98fcc20147c4970783ae48a0c8b9e2c8e26e Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 10:41:39 -0400 Subject: [PATCH 125/155] use seq_along in loop --- R/exportDataQuality.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 21214b83..21ca618c 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -64,7 +64,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, tryCatch({ result <- httr::content(response, type = 'application/json') - for(j in 1:length(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} + for(j in seq_along(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} result <- as.data.frame(do.call(rbind, result)) if (nrow(result) > 0) { From 7d38a72afc23b10138a1b9db8e8ad52951849d6c Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 12:20:21 -0400 Subject: [PATCH 126/155] remove make api call --- R/exportDataQuality.R | 12 ------------ 1 file changed, 12 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 21ca618c..33f44d93 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -79,16 +79,4 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) }) - ################################################################### - # Make the API Call #### - - response <- makeApiCall(rcon, - body = c(body, api_param), - config = config) - - if (as.character(response) == ""){ - return(REDCAP_DQ_STRUCTURE) - } - - as.data.frame(response) } From a44b10e07cca6cc655173a8bcf29556eecb9d404 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 12:39:48 -0400 Subject: [PATCH 127/155] remove unlisting of columns, return RC DQ Structure if no queries are present --- R/exportDataQuality.R | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 33f44d93..7ed089e6 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -67,13 +67,10 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, for(j in seq_along(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} result <- as.data.frame(do.call(rbind, result)) - if (nrow(result) > 0) { - columns <- c("status_id", "project_id", "record", "event_id", "instance", "field_name") - for (c in columns) { - result[, c] <- unlist(result[, c]) - } + if (!nrow(result) > 0) { + return(REDCAP_DQ_STRUCTURE) } - + return(result) }, error = function(e) { stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) From 7a1b5bf21cddfcf40281426b38d2164e28c569ed Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 14:11:56 -0400 Subject: [PATCH 128/155] add .make_dq helper functions, return result --- R/exportDataQuality.R | 71 +++++++++++++++++++++++++++++++++++++------ 1 file changed, 62 insertions(+), 9 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 7ed089e6..c86599f3 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -63,17 +63,70 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, tryCatch({ result <- httr::content(response, type = 'application/json') - - for(j in seq_along(result)){i=result[[j]];if(is.null(i$resolutions)){result[[j]]$resolutions=list()}} - result <- as.data.frame(do.call(rbind, result)) - - if (!nrow(result) > 0) { - return(REDCAP_DQ_STRUCTURE) - } - - return(result) }, error = function(e) { stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) }) + list_swap_NULL2NA <- function(x) { + size <- vapply(x, length, numeric(1)) + nr <- max(size) + na_vals <- rep(NA, nr) + for(j in which(size == 0)) x[[j]] <- na_vals + x + } + + .make_dq <- function(result) { + empty_dq <- data.frame( + status_id = NA, + rule_id = NA, + pd_rule_id = NA, + non_rule = NA, + project_id = NA, + record = NA, + event_id = NA, + field_name = NA, + repeat_instrument = NA, + instance = NA, + status = NA, + exclude = NA, + query_status = NA, + group_id = NA, + assigned_username = NA + )[FALSE,] + empty_res <- data.frame( + res_id = NA, + status_id = NA, + ts = NA, + response_requested = NA, + response = NA, + comment = NA, + current_query_status = NA, + upload_doc_id = NA, + field_comment_edited = NA, + username = NA + )[FALSE,] + + dq_info <- vector('list', length(result)) + res_info <- vector('list', length(result)) + for(i in seq_along(result)) { + tmp <- result[[i]] + res_i <- lapply(tmp$resolutions, function(i) { + as.data.frame(list_swap_NULL2NA(i)) + }) + res_ii <- do.call(rbind, res_i) + if(is.null(res_ii) || nrow(res_ii) == 0) res_ii <- empty_res + res_info[[i]] <- res_ii + tmp$resolutions <- NULL + dq_ii <- as.data.frame(list_swap_NULL2NA(tmp)) + if(nrow(dq_ii) == 0) dq_ii <- empty_dq + dq_info[[i]] <- dq_ii + } + dq_dat <- do.call(rbind, dq_info) + res_dat <- do.call(rbind, res_info) + if(nrow(dq_dat) == 0) dq_dat <- empty_dq + merge(dq_dat, res_dat, all.x = TRUE) + } + + return(.make_dq(result)) + } From f0811a652e826dd23f14c7fa4c29ac9e89fda8d6 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 16:33:48 -0400 Subject: [PATCH 129/155] move helper functions outside of export data quality --- R/exportDataQuality.R | 124 +++++++++++++++++++++--------------------- 1 file changed, 61 insertions(+), 63 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index c86599f3..934e862a 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -56,9 +56,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, # Build the query list #### url <- paste0(rcon$url, "?prefix=", prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) - formData <- list(token = rcon$token) - response <- httr::POST(url, body = formData, encode = "form") tryCatch({ @@ -67,66 +65,66 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) }) - list_swap_NULL2NA <- function(x) { - size <- vapply(x, length, numeric(1)) - nr <- max(size) - na_vals <- rep(NA, nr) - for(j in which(size == 0)) x[[j]] <- na_vals - x - } - - .make_dq <- function(result) { - empty_dq <- data.frame( - status_id = NA, - rule_id = NA, - pd_rule_id = NA, - non_rule = NA, - project_id = NA, - record = NA, - event_id = NA, - field_name = NA, - repeat_instrument = NA, - instance = NA, - status = NA, - exclude = NA, - query_status = NA, - group_id = NA, - assigned_username = NA - )[FALSE,] - empty_res <- data.frame( - res_id = NA, - status_id = NA, - ts = NA, - response_requested = NA, - response = NA, - comment = NA, - current_query_status = NA, - upload_doc_id = NA, - field_comment_edited = NA, - username = NA - )[FALSE,] - - dq_info <- vector('list', length(result)) - res_info <- vector('list', length(result)) - for(i in seq_along(result)) { - tmp <- result[[i]] - res_i <- lapply(tmp$resolutions, function(i) { - as.data.frame(list_swap_NULL2NA(i)) - }) - res_ii <- do.call(rbind, res_i) - if(is.null(res_ii) || nrow(res_ii) == 0) res_ii <- empty_res - res_info[[i]] <- res_ii - tmp$resolutions <- NULL - dq_ii <- as.data.frame(list_swap_NULL2NA(tmp)) - if(nrow(dq_ii) == 0) dq_ii <- empty_dq - dq_info[[i]] <- dq_ii - } - dq_dat <- do.call(rbind, dq_info) - res_dat <- do.call(rbind, res_info) - if(nrow(dq_dat) == 0) dq_dat <- empty_dq - merge(dq_dat, res_dat, all.x = TRUE) +} + +.listSwapNullToNa <- function(x) { + size <- vapply(x, length, numeric(1)) + nr <- max(size) + na_vals <- rep(NA, nr) + for(j in which(size == 0)) x[[j]] <- na_vals + x +} + +.makeDq <- function(result) { + empty_dq <- data.frame( + status_id = NA, + rule_id = NA, + pd_rule_id = NA, + non_rule = NA, + project_id = NA, + record = NA, + event_id = NA, + field_name = NA, + repeat_instrument = NA, + instance = NA, + status = NA, + exclude = NA, + query_status = NA, + group_id = NA, + assigned_username = NA + )[FALSE,] + empty_res <- data.frame( + res_id = NA, + status_id = NA, + ts = NA, + response_requested = NA, + response = NA, + comment = NA, + current_query_status = NA, + upload_doc_id = NA, + field_comment_edited = NA, + username = NA + )[FALSE,] + + dq_info <- vector('list', length(result)) + res_info <- vector('list', length(result)) + for(i in seq_along(result)) { + tmp <- result[[i]] + res_i <- lapply(tmp$resolutions, function(i) { + as.data.frame(.listSwapNullToNa(i)) + }) + res_ii <- do.call(rbind, res_i) + if(is.null(res_ii) || nrow(res_ii) == 0) res_ii <- empty_res + res_info[[i]] <- res_ii + tmp$resolutions <- NULL + dq_ii <- as.data.frame(.listSwapNullToNa(tmp)) + if(nrow(dq_ii) == 0) dq_ii <- empty_dq + dq_info[[i]] <- dq_ii } - - return(.make_dq(result)) - + dq_dat <- do.call(rbind, dq_info) + res_dat <- do.call(rbind, res_info) + if(nrow(dq_dat) == 0) dq_dat <- empty_dq + merge(dq_dat, res_dat, all.x = TRUE) } + +.makeDq(result) From 122fb8b4be931273bf31fdb8d99f3c8a0c70f6aa Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 2 May 2024 17:26:01 -0400 Subject: [PATCH 130/155] move .makeDq function call --- R/exportDataQuality.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 934e862a..93e1a76b 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -65,6 +65,8 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) }) + .makeDq(result) + } .listSwapNullToNa <- function(x) { @@ -127,4 +129,4 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, merge(dq_dat, res_dat, all.x = TRUE) } -.makeDq(result) + From 0b86f6160185528631a2172b73e1b42180614bf2 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 3 May 2024 15:12:58 -0400 Subject: [PATCH 131/155] remove unused redcap DQ structure --- R/redcapDataStructure.R | 23 ----------------------- 1 file changed, 23 deletions(-) diff --git a/R/redcapDataStructure.R b/R/redcapDataStructure.R index f88b95f1..591e75a5 100644 --- a/R/redcapDataStructure.R +++ b/R/redcapDataStructure.R @@ -87,29 +87,6 @@ REDCAP_DAG_ASSIGNMENT_STRUCTURE <- redcap_data_access_group = character(0), stringsAsFactors = FALSE) -# Data Quality ------------------------------------------------------ -# Data Quality Structure - -REDCAP_DQ_STRUCTURE <- - data.frame(status_id = character(0), - rule_id = character(0), - pd_rule_id = character(0), - non_rule = character(0), - project_id = character(0), - record = character(0), - event_id = character(0), - field_name = character(0), - repeat_instrument = character(0), - instance = character(0), - status = character(0), - exclude = character(0), - query_status = character(0), - group_id = character(0), - assigned_username = character(0), - resolutions = character(0), - codes = character(0), - stringsAsFactors = FALSE) - # Events ------------------------------------------------------------ # Event Structure From 5aa2396f57752180d25afe5d037da942021f62e4 Mon Sep 17 00:00:00 2001 From: Nutter Date: Wed, 8 May 2024 06:55:06 -0400 Subject: [PATCH 132/155] Diagnostic print statements --- R/exportRecordsTyped.R | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 24eb8907..62cdace8 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -125,7 +125,8 @@ exportRecordsTyped.redcapApiConnection <- add = coll) checkmate::reportAssertions(coll) - + print("fields at start-------------------------") + print(fields) .exportRecordsTyped_validateFieldForm(rcon = rcon, fields = fields, drop_fields = drop_fields, @@ -148,7 +149,8 @@ exportRecordsTyped.redcapApiConnection <- if (user_requested_only_system_fields){ fields <- rcon$metadata()$field_name[1] } - + print("fields after system fields-----------------------") + print(fields) # Check that the events exist in the project checkmate::assert_subset(x = events, @@ -164,7 +166,8 @@ exportRecordsTyped.redcapApiConnection <- fields = fields, drop_fields = drop_fields, forms = forms) - + print("fields after exportRecordsTyped_fieldsArray--------") + print(fields) ################################################################### # Call API for Raw Results From dc4bfed0976a469b30371feeb1b9487905ebb535 Mon Sep 17 00:00:00 2001 From: Nutter Date: Wed, 8 May 2024 06:59:24 -0400 Subject: [PATCH 133/155] More diagnostic print statements --- R/exportRecordsTyped.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 62cdace8..3ccc2f13 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -551,6 +551,9 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, by.y = "field_name", all.x = TRUE) + print("FieldFormMap initialization --------------") + print(FieldFormMap[FieldFormMap$field_name == "aedecod", ]) + # Assign [form]_complete fields to their forms FieldFormMap$form_name <- ifelse(is.na(FieldFormMap$form_name) & # if form name is missing and end in _complete @@ -635,7 +638,9 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, } else { Fields$export_field_name } - + print("fields_to_request-----------------") + print(fields_to_request) + print(fields) # Lastly, we need to ensure that the identifier fields are included. # We will include the record ID field if it is not already included. # We will also include the secondary unique ID field if one is specified. From 5021912a945e19a7e46522608ce3ac8935e22cdb Mon Sep 17 00:00:00 2001 From: Nutter Date: Wed, 8 May 2024 11:21:20 -0400 Subject: [PATCH 134/155] Different diagnostic print statements --- R/exportRecordsTyped.R | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 3ccc2f13..e4cfd8d2 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -125,8 +125,7 @@ exportRecordsTyped.redcapApiConnection <- add = coll) checkmate::reportAssertions(coll) - print("fields at start-------------------------") - print(fields) + .exportRecordsTyped_validateFieldForm(rcon = rcon, fields = fields, drop_fields = drop_fields, @@ -149,8 +148,7 @@ exportRecordsTyped.redcapApiConnection <- if (user_requested_only_system_fields){ fields <- rcon$metadata()$field_name[1] } - print("fields after system fields-----------------------") - print(fields) + # Check that the events exist in the project checkmate::assert_subset(x = events, @@ -166,8 +164,7 @@ exportRecordsTyped.redcapApiConnection <- fields = fields, drop_fields = drop_fields, forms = forms) - print("fields after exportRecordsTyped_fieldsArray--------") - print(fields) + ################################################################### # Call API for Raw Results @@ -188,6 +185,8 @@ exportRecordsTyped.redcapApiConnection <- body <- body[lengths(body) > 0] + print(body) + Raw <- if (length(batch_size) == 0) { @@ -551,9 +550,6 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, by.y = "field_name", all.x = TRUE) - print("FieldFormMap initialization --------------") - print(FieldFormMap[FieldFormMap$field_name == "aedecod", ]) - # Assign [form]_complete fields to their forms FieldFormMap$form_name <- ifelse(is.na(FieldFormMap$form_name) & # if form name is missing and end in _complete @@ -638,9 +634,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, } else { Fields$export_field_name } - print("fields_to_request-----------------") - print(fields_to_request) - print(fields) + # Lastly, we need to ensure that the identifier fields are included. # We will include the record ID field if it is not already included. # We will also include the secondary unique ID field if one is specified. From 6e13a4a9fb1c58bd37e49d76f4d8dc834116ef08 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Thu, 9 May 2024 12:19:24 -0400 Subject: [PATCH 135/155] set default dag arg to false --- R/exportRecordsTyped.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 24eb8907..348357e7 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -34,7 +34,7 @@ exportRecordsTyped.redcapApiConnection <- records = NULL, events = NULL, survey = TRUE, - dag = TRUE, + dag = FALSE, date_begin = NULL, date_end = NULL, From ea67a5d95d8c79d2ba29d4d7e5cdab876ace0972 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 10 May 2024 10:18:55 -0400 Subject: [PATCH 136/155] update documentation, udpate news --- NEWS | 1 + R/docsRecordsTypedMethods.R | 3 +++ man/recordsTypedMethods.Rd | 7 +++++-- man/redcapAPI.Rd | 2 +- 4 files changed, 10 insertions(+), 3 deletions(-) diff --git a/NEWS b/NEWS index 889c39c8..f4b46d85 100644 --- a/NEWS +++ b/NEWS @@ -13,6 +13,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.1 * Added additional supported arguments to deleteRecords +* Change the default for the DAG flag to FALSE for exportRecordsTyped ## 2.9.0 diff --git a/R/docsRecordsTypedMethods.R b/R/docsRecordsTypedMethods.R index b6410cc8..c6fd23b8 100644 --- a/R/docsRecordsTypedMethods.R +++ b/R/docsRecordsTypedMethods.R @@ -33,6 +33,9 @@ #' This flag is only viable if the user whose token is #' being used to make the API request is not in a data access group. #' If the user is in a group, then this flag will revert to its default value. +#' Data Access Groups privilege is required when creating/renaming/deleting +#' DAGs and when importing/exporting user-DAG assignments. Therefore, the +#' default for this flag is FALSE. To export DAG information set this flag to TRUE. #' @param date_begin `POSIXct(1)` or `NULL`. Ignored if `NULL` (default). #' Otherwise, records created or modified after this date will be returned. #' @param date_end `POSIXct(1)` or `NULL`. Ignored if `NULL` (default). diff --git a/man/recordsTypedMethods.Rd b/man/recordsTypedMethods.Rd index 918f0d17..d3999a44 100644 --- a/man/recordsTypedMethods.Rd +++ b/man/recordsTypedMethods.Rd @@ -30,7 +30,7 @@ exportReportsTyped(rcon, report_id, ...) records = NULL, events = NULL, survey = TRUE, - dag = TRUE, + dag = FALSE, date_begin = NULL, date_end = NULL, na = list(), @@ -110,7 +110,10 @@ misspellings may result in unexpected results.} when data access groups are utilized in the project. This flag is only viable if the user whose token is being used to make the API request is not in a data access group. -If the user is in a group, then this flag will revert to its default value.} +If the user is in a group, then this flag will revert to its default value. +Data Access Groups privilege is required when creating/renaming/deleting +DAGs and when importing/exporting user-DAG assignments. Therefore, the +default for this flag is FALSE. To export DAG information set this flag to TRUE.} \item{date_begin}{\code{POSIXct(1)} or \code{NULL}. Ignored if \code{NULL} (default). Otherwise, records created or modified after this date will be returned.} diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 66a83ccc..8dd7f7c1 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/redcapAPI-package.R \docType{package} \name{redcapAPI} -\alias{redcapAPI-package} \alias{redcapAPI} +\alias{redcapAPI-package} \title{Access data, meta data, and files from REDCap using the API} \description{ REDCap is a database development tool built on MySQL. Visit From 7ce9d483a04a9e0e2b7f86dc31fd34d02385621a Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 10 May 2024 09:35:10 -0500 Subject: [PATCH 137/155] Minor edit to NEWS --- NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS b/NEWS index f4b46d85..626f30ee 100644 --- a/NEWS +++ b/NEWS @@ -13,7 +13,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.1 * Added additional supported arguments to deleteRecords -* Change the default for the DAG flag to FALSE for exportRecordsTyped +* Change the default to `dag=FALSE` for exportRecordsTyped ## 2.9.0 From cca94f68af606beba103a67ecf9f3b7073613573 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 10 May 2024 09:35:30 -0500 Subject: [PATCH 138/155] Even more minor edit to NEWS to correct last one --- NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS b/NEWS index 626f30ee..cea7e7cb 100644 --- a/NEWS +++ b/NEWS @@ -13,7 +13,7 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.1 * Added additional supported arguments to deleteRecords -* Change the default to `dag=FALSE` for exportRecordsTyped +* Changed the default to `dag=FALSE` for exportRecordsTyped ## 2.9.0 From f7cf78d0fea150997e1560478bb9010fe272ffe9 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 10 May 2024 09:53:32 -0500 Subject: [PATCH 139/155] Fixed failing 204 tests for dag=FALSE default --- NEWS | 4 ++-- ...204-exportTypedRecords-withRepeatingInstruments.R | 12 ++++++++---- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index cea7e7cb..f53d8854 100644 --- a/NEWS +++ b/NEWS @@ -12,8 +12,8 @@ A future release of version 3.0.0 will introduce several breaking changes! ## 2.9.1 -* Added additional supported arguments to deleteRecords -* Changed the default to `dag=FALSE` for exportRecordsTyped +* Added additional supported arguments to deleteRecords. +* Changed the default to `dag=FALSE` for exportRecordsTyped. ## 2.9.0 diff --git a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R index babd6588..ce9c43fb 100644 --- a/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R +++ b/tests/testthat/test-204-exportTypedRecords-withRepeatingInstruments.R @@ -84,7 +84,8 @@ test_that( # Return actual fields + system fields Rec <- exportRecordsTyped(rcon, - fields = "record_id") + fields = "record_id", + dag=TRUE) expect_true(all(REDCAP_SYSTEM_FIELDS %in% names(Rec))) # 3. User requests actual fields + system fields. @@ -126,14 +127,16 @@ test_that( # ID field and system fields when just the ID field is requested Rec <- exportRecordsTyped(rcon, - fields = "record_id") + fields = "record_id", + dag=TRUE) expect_equal(names(Rec), minimum_field) # ID field and system fields when a single form is requested Rec <- exportRecordsTyped(rcon, - forms = c("randomization")) + forms = c("randomization"), + dag=TRUE) expect_true(all(minimum_field %in% names(Rec))) # Now let's make a secondary unique field @@ -141,7 +144,8 @@ test_that( importProjectInformation(rcon, NewInfo) Rec <- exportRecordsTyped(rcon, - forms = c("randomization")) + forms = c("randomization"), + dag=TRUE) expect_true(all(c(minimum_field, "text_test") %in% names(Rec))) NewInfo <- data.frame(secondary_unique_field = "", From 929580ce95d86b7beebf23031104e33001ff80aa Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 10 May 2024 11:30:55 -0400 Subject: [PATCH 140/155] update tests with default false for dag arg --- tests/testthat/test-250-recastRecords.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-250-recastRecords.R b/tests/testthat/test-250-recastRecords.R index 4006734e..54056876 100644 --- a/tests/testthat/test-250-recastRecords.R +++ b/tests/testthat/test-250-recastRecords.R @@ -14,7 +14,7 @@ export_fields <- c("dropdown_test", "yesno_test", "truefalse_test") -Records <- exportRecordsTyped(rcon, +Records <- exportRecordsTyped(rcon, fields = fields) ##################################################################### @@ -56,10 +56,10 @@ test_that( test_that( "Handle numeric indexing appropriately", { - local_reproducible_output(width = 200) + # local_reproducible_output(width = 200) Recast <- recastRecords(Records, rcon = rcon, - fields = c(9, 10, 6), + fields = c(8, 9, 5), cast = list(dropdown = castRaw, radio = castRaw, checkbox = castRaw, @@ -76,7 +76,7 @@ test_that( Recast <- recastRecords(Records, rcon = rcon, - fields = c(10, 7, 12), + fields = c(9, 6, 11), cast = list(dropdown = castRaw, radio = castRaw, checkbox = castRaw, @@ -94,7 +94,7 @@ test_that( expect_error(recastRecords(Records, rcon = rcon, fields = c(11:17)), - "Columns [{]13, 14, 15, 16, 17[}] requested in a data frame with 12 columns") + "Columns [{]12, 13, 14, 15, 16, 17[}] requested in a data frame with 11 columns") } ) @@ -103,7 +103,7 @@ test_that( { local_reproducible_output(width = 200) to_recast <- logical(ncol(Records)) - to_recast[c(9, 10, 6)] <- TRUE + to_recast[c(8, 9, 5)] <- TRUE Recast <- recastRecords(Records, rcon = rcon, fields = to_recast, @@ -122,7 +122,7 @@ test_that( expect_true(is.logical(Recast$truefalse_test)) to_recast <- logical(ncol(Records)) - to_recast[c(10, 7, 12)] <- TRUE + to_recast[c(9, 6, 11)] <- TRUE Recast <- recastRecords(Records, rcon = rcon, fields = to_recast, @@ -144,7 +144,7 @@ test_that( rcon = rcon, fields = rep(c(FALSE, TRUE), length.out = 7)), - "'fields' [(]logical[)] should be of length 12 and is length 7") + "'fields' [(]logical[)] should be of length 11 and is length 7") } ) From 45ff79836bf6b685a4c8babd8f81c87c7fd7dc0e Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 10 May 2024 10:57:35 -0500 Subject: [PATCH 141/155] Fix for dag and fields interaction on exportRecordsTyped, plus minor cleanup of another test #365 --- R/exportRecordsTyped.R | 3 +++ tests/testthat/test-240-exportTypedReports-Functionality.R | 2 -- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index 348357e7..97c60f94 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -139,6 +139,9 @@ exportRecordsTyped.redcapApiConnection <- user_requested_only_system_fields <- length(fields) > 0 && all(fields %in% REDCAP_SYSTEM_FIELDS) system_fields_user_requested <- REDCAP_SYSTEM_FIELDS[REDCAP_SYSTEM_FIELDS %in% fields] + # dag must be set to TRUE to pull the dag field + if(length(fields) > 0 && "redcap_data_access_group" %in% fields) dag <- TRUE + # The REDCap API will not accept system fields in the fields argument. # we have to remove them from the request. fields <- fields[!fields %in% REDCAP_SYSTEM_FIELDS] # redcapDataStructures.R diff --git a/tests/testthat/test-240-exportTypedReports-Functionality.R b/tests/testthat/test-240-exportTypedReports-Functionality.R index 13d0ace8..308d8fa1 100644 --- a/tests/testthat/test-240-exportTypedReports-Functionality.R +++ b/tests/testthat/test-240-exportTypedReports-Functionality.R @@ -1,7 +1,5 @@ context("Export Typed Report Functionality") -report_ids = as.numeric(strsplit(Sys.getenv('REPORT_IDS', '357209,362756'), ',')[[1]]) - report_ids <- EXPORT_REPORTS_ID test_that( From ae25ce3c9525bdb95a0c4e0468a4ed4d4049cf70 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 10 May 2024 13:42:58 -0400 Subject: [PATCH 142/155] set dag to TRUE for test --- tests/testthat/test-356-missingSummary.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-356-missingSummary.R b/tests/testthat/test-356-missingSummary.R index 5b5c2a70..9ea09feb 100644 --- a/tests/testthat/test-356-missingSummary.R +++ b/tests/testthat/test-356-missingSummary.R @@ -48,6 +48,7 @@ test_that( local_reproducible_output(width = 200) expect_identical( missingSummary(rcon, + dag = TRUE, fields = "record_id", records = as.character(1:20), forms = "branching_logic"), From db97cb372b13cc1596efdc997811438e3c45ba2b Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Fri, 10 May 2024 15:34:09 -0400 Subject: [PATCH 143/155] patch to ignore NA field types --- R/exportExternalCoding.R | 2 +- R/exportRecordsTyped.R | 4 +--- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/R/exportExternalCoding.R b/R/exportExternalCoding.R index 71c45cc3..e55f2eb5 100644 --- a/R/exportExternalCoding.R +++ b/R/exportExternalCoding.R @@ -107,7 +107,7 @@ exportExternalCoding.redcapApiConnection <- function(rcon, MetaData$field_name[grepl("BIOPORTAL", MetaData$select_choices_or_calculations, ignore.case = TRUE) | - MetaData$field_type == "sql"] + (!is.na(MetaData$field_type) & MetaData$field_type == "sql")] if (is.null(fields)){ fields <- external_fields diff --git a/R/exportRecordsTyped.R b/R/exportRecordsTyped.R index e4cfd8d2..d147ef2b 100644 --- a/R/exportRecordsTyped.R +++ b/R/exportRecordsTyped.R @@ -185,8 +185,6 @@ exportRecordsTyped.redcapApiConnection <- body <- body[lengths(body) > 0] - print(body) - Raw <- if (length(batch_size) == 0) { @@ -419,7 +417,7 @@ exportRecordsTyped.redcapOfflineConnection <- function(rcon, coll, warn_zero_coded, ...) -{ +{ checkmate::assert_character(x = fields, any.missing = FALSE, null.ok = TRUE, From b9d41c703dfaf66e6a50cebe4502e21101ab751b Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Fri, 10 May 2024 14:58:54 -0500 Subject: [PATCH 144/155] News for #364 --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index f53d8854..3652ff62 100644 --- a/NEWS +++ b/NEWS @@ -14,6 +14,7 @@ A future release of version 3.0.0 will introduce several breaking changes! * Added additional supported arguments to deleteRecords. * Changed the default to `dag=FALSE` for exportRecordsTyped. +* exportRecordsTyped more robust against some forms of corrupted meta data. ## 2.9.0 From 8f22613b86d151876643cd94a13f249883c753b1 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 14 May 2024 10:02:17 -0400 Subject: [PATCH 145/155] add data quality module tests --- tests/testthat/helper-00-REDCapQACredentials.R | 3 ++- tests/testthat/test-904-exportDataQuality.R | 17 +++++++++++++++++ 2 files changed, 19 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/test-904-exportDataQuality.R diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index cb108f8b..2c5b5ed8 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -23,10 +23,11 @@ library(keyring) # Override using environment variable REDCAP_URL, REDCAP_TESTDB_NAME, REDCAP_KEYRING url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") testdb <- Sys.getenv("REDCAP_TESTDB_NAME", "TestRedcapAPI") # reference in keyring +dqdb <- Sys.getenv("REDCAP_DQDB_NAME", "DQTest") # Data Quality REDCap project keyring <- Sys.getenv("REDCAP_KEYRING", "API_KEYs") unlockREDCap( - c(rcon = testdb), # Open the keyring name as the variable rcon + c(rcon = testdb, dqRcon = dqdb), # Open the keyring name as the variable rcon url = url, # Using the url keyring = keyring,# from the defined keyring envir = environment()) # in the global environment diff --git a/tests/testthat/test-904-exportDataQuality.R b/tests/testthat/test-904-exportDataQuality.R new file mode 100644 index 00000000..09eb5d86 --- /dev/null +++ b/tests/testthat/test-904-exportDataQuality.R @@ -0,0 +1,17 @@ +context("exportDataQuality.R") + +prefix <- 'vanderbilt_dataQuality' + +test_that("Data queries can be exported",{ + dq <- exportDataQuality(dqrcon, prefix) + expect_gte(length(dq), 1) +}) + +test_that( + "Return error messages if Data Quality Module not enabled", + { + expect_error(exportDataQuality(rcon, prefix), + "Error in result: Make sure the Data Quality API module is enabled in your project.") + } +) + From 208a20850a2311c56a57893a22a19a900a411e0a Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 14 May 2024 10:02:55 -0400 Subject: [PATCH 146/155] minor change to connection object name --- tests/testthat/helper-00-REDCapQACredentials.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 2c5b5ed8..94c985e9 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -27,7 +27,7 @@ dqdb <- Sys.getenv("REDCAP_DQDB_NAME", "DQTest") # Data Quality REDCap projec keyring <- Sys.getenv("REDCAP_KEYRING", "API_KEYs") unlockREDCap( - c(rcon = testdb, dqRcon = dqdb), # Open the keyring name as the variable rcon + c(rcon = testdb, dqrcon = dqdb), # Open the keyring name as the variable rcon url = url, # Using the url keyring = keyring,# from the defined keyring envir = environment()) # in the global environment From c4c3b1ffb956c46e2e31dab656b758adc25ba813 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 10:27:13 -0500 Subject: [PATCH 147/155] Added code to skip data quality tests if no project. #321 --- tests/testthat/helper-00-REDCapQACredentials.R | 9 +++++++-- tests/testthat/test-904-exportDataQuality.R | 3 +++ 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/tests/testthat/helper-00-REDCapQACredentials.R b/tests/testthat/helper-00-REDCapQACredentials.R index 94c985e9..fa2ffa9c 100644 --- a/tests/testthat/helper-00-REDCapQACredentials.R +++ b/tests/testthat/helper-00-REDCapQACredentials.R @@ -23,11 +23,16 @@ library(keyring) # Override using environment variable REDCAP_URL, REDCAP_TESTDB_NAME, REDCAP_KEYRING url <- Sys.getenv("REDCAP_URL", "https://redcap.vumc.org/api/") testdb <- Sys.getenv("REDCAP_TESTDB_NAME", "TestRedcapAPI") # reference in keyring -dqdb <- Sys.getenv("REDCAP_DQDB_NAME", "DQTest") # Data Quality REDCap project +dqdb <- Sys.getenv("REDCAP_DQDB_NAME", "") # "DQTest") Data Quality REDCap project keyring <- Sys.getenv("REDCAP_KEYRING", "API_KEYs") +RUN_DATAQUALITY_TEST <- dqdb != '' +databases <- if(RUN_DATAQUALITY_TEST) + c(rcon = testdb, dqrcon = dqdb) else + c(rcon = testdb) + unlockREDCap( - c(rcon = testdb, dqrcon = dqdb), # Open the keyring name as the variable rcon + databases, # Open the keyring name as the variable rcon url = url, # Using the url keyring = keyring,# from the defined keyring envir = environment()) # in the global environment diff --git a/tests/testthat/test-904-exportDataQuality.R b/tests/testthat/test-904-exportDataQuality.R index 09eb5d86..e97d801d 100644 --- a/tests/testthat/test-904-exportDataQuality.R +++ b/tests/testthat/test-904-exportDataQuality.R @@ -3,6 +3,9 @@ context("exportDataQuality.R") prefix <- 'vanderbilt_dataQuality' test_that("Data queries can be exported",{ + skip_if(!RUN_DATAQUALITY_TEST, + "No Data Quality Project provided. Tests Skipped") + dq <- exportDataQuality(dqrcon, prefix) expect_gte(length(dq), 1) }) From 7d1a65386e429ed4b8faa74b356a82bcf5b1f79a Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 14 May 2024 11:35:00 -0400 Subject: [PATCH 148/155] export exportDataQuality funciton --- NAMESPACE | 1 + R/exportDataQuality.R | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 3ae881dd..4e0b95e7 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -129,6 +129,7 @@ export(exportArms) export(exportBulkRecords) export(exportBundle) export(exportDags) +export(exportDataQuality) export(exportEvents) export(exportFieldNames) export(exportFileRepository) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 93e1a76b..86b9b02c 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -12,7 +12,8 @@ #' @param prefix A string from your REDCap institutions Data Quality module url. The #' module prefix can be found by exporting module settings under External Modules #' in REDCap. - + +#' @export exportDataQuality <- function(rcon, prefix, ...){ From b20977b35788ea24c237ee17ca5f9968bb37cd05 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 11:07:39 -0500 Subject: [PATCH 149/155] Added another export #321 --- NAMESPACE | 1 + R/exportDataQuality.R | 1 + man/redcapAPI.Rd | 2 +- 3 files changed, 3 insertions(+), 1 deletion(-) diff --git a/NAMESPACE b/NAMESPACE index 4e0b95e7..2f013332 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ S3method(deleteUsers,redcapApiConnection) S3method(exportArms,redcapApiConnection) S3method(exportBundle,redcapApiConnection) S3method(exportDags,redcapApiConnection) +S3method(exportDataQuality,redcapApiConnection) S3method(exportEvents,redcapApiConnection) S3method(exportExternalCoding,redcapApiConnection) S3method(exportFieldNames,redcapApiConnection) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 86b9b02c..72d6eb97 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -20,6 +20,7 @@ exportDataQuality <- function(rcon, prefix, UseMethod("exportDataQuality") } +#' @export exportDataQuality.redcapApiConnection <- function(rcon, prefix, ..., error_handling = getOption("redcap_error_handling"), diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 8dd7f7c1..66a83ccc 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/redcapAPI-package.R \docType{package} \name{redcapAPI} -\alias{redcapAPI} \alias{redcapAPI-package} +\alias{redcapAPI} \title{Access data, meta data, and files from REDCap using the API} \description{ REDCap is a database development tool built on MySQL. Visit From 719e153152f880708499ff50f54b4f67674f7f2a Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 12:41:27 -0500 Subject: [PATCH 150/155] Changed to makeApiCall for Data Quality, #321 --- R/exportDataQuality.R | 49 +++++++++++---------- R/makeApiCall.R | 35 +++++++++------ man/exportDataQuality.Rd | 2 +- man/makeApiCall.Rd | 4 +- tests/testthat/test-050-makeApiCall.R | 8 ++++ tests/testthat/test-904-exportDataQuality.R | 2 +- 6 files changed, 60 insertions(+), 40 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 72d6eb97..64dd2a66 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -11,21 +11,20 @@ #' @param rcon A REDCap connection object as generated by `redcapConnection`. #' @param prefix A string from your REDCap institutions Data Quality module url. The #' module prefix can be found by exporting module settings under External Modules -#' in REDCap. +#' in REDCap. At VUMC the prefix is 'vanderbilt_dataQuality'. #' @export - -exportDataQuality <- function(rcon, prefix, - ...){ +exportDataQuality <- function(rcon, prefix, ...) UseMethod("exportDataQuality") -} #' @export -exportDataQuality.redcapApiConnection <- function(rcon, prefix, - ..., - error_handling = getOption("redcap_error_handling"), - config = list(), - api_param = list()){ +exportDataQuality.redcapApiConnection <- + function(rcon, + prefix, + ..., + config = list(), + api_param = list()) +{ ################################################################### # Argument Validation #### @@ -38,12 +37,7 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, checkmate::assert_class(x = prefix, classes = "character", add = coll) - - error_handling <- checkmate::matchArg(x = error_handling, - choices = c("null", "error"), - .var.name = "error_handling", - add = coll) - + checkmate::assert_list(x = config, names = "named", add = coll) @@ -57,18 +51,27 @@ exportDataQuality.redcapApiConnection <- function(rcon, prefix, ################################################################### # Build the query list #### - url <- paste0(rcon$url, "?prefix=", prefix, "&page=export&type=module&NOAUTH&pid=", rcon$projectInformation()$project_id) - formData <- list(token = rcon$token) - response <- httr::POST(url, body = formData, encode = "form") + url <- paste0(rcon$url, + "?prefix=", + prefix, + "&page=export&type=module&NOAUTH&pid=", + rcon$projectInformation()$project_id) + + response <- makeApiCall(rcon, body=api_param, config=config, url) - tryCatch({ + if (response$status_code != 200) + return(redcapError(response, error_handling)) + + tryCatch( + { result <- httr::content(response, type = 'application/json') - }, error = function(e) { - stop ("Error in result: Make sure the Data Quality API module is enabled in your project. ", e$message) + }, + error = function(e) + { + stop("Make sure the Data Quality API module is enabled in your project.") }) .makeDq(result) - } .listSwapNullToNa <- function(x) { diff --git a/R/makeApiCall.R b/R/makeApiCall.R index a1ddace3..57e973a1 100644 --- a/R/makeApiCall.R +++ b/R/makeApiCall.R @@ -12,6 +12,7 @@ #' @param config `list` A list of options to be passed to [httr::POST()]. #' These will be appended to the `config` options included in the #' `rcon` object. +#' @param url `character(1)` A url string to hit. Defaults to rcon$url. #' #' @details The intent of this function is to provide an approach to execute #' calls to the REDCap API that is both consistent and flexible. Importantly, @@ -135,10 +136,11 @@ #' } #' #' @export - makeApiCall <- function(rcon, - body = list(), - config = list()){ + body = list(), + config = list(), + url = NULL) +{ # Argument Validation --------------------------------------------- coll <- checkmate::makeAssertCollection() @@ -154,19 +156,25 @@ makeApiCall <- function(rcon, names = "named", add = coll) + checkmate::assert_character(x = url, + null.ok = TRUE, + len = 1, + add = coll) + checkmate::reportAssertions(coll) # Functional Code ------------------------------------------------- - for (i in seq_len(rcon$retries())){ + if(is.null(url)) url <- rcon$url + + for (i in seq_len(rcon$retries())) + { response <- tryCatch( { - httr::POST(url = rcon$url, - body = c(list(token = rcon$token), - body), - config = c(rcon$config, - config)) + httr::POST(url = url, + body = c(list(token = rcon$token), body), + config = c(rcon$config, config)) }, error=function(e) { @@ -203,11 +211,11 @@ makeApiCall <- function(rcon, is_retry_eligible <- .makeApiCall_isRetryEligible(response) - if (!is_retry_eligible) - break + if (!is_retry_eligible) break # The attempt failed. Produce a message detailing the failure (when not quiet) - if (!rcon$retry_quietly()){ + if (!rcon$retry_quietly()) + { .makeApiCall_retryMessage(rcon = rcon, response = response, iteration = i) @@ -215,9 +223,8 @@ makeApiCall <- function(rcon, # Wait the designated time until trying again. # when i = rcon$retries(), we've made all our attempts, we do not need to wait to exit the loop - if (i < rcon$retries()) { + if (i < rcon$retries()) Sys.sleep(rcon$retry_interval()[i]) - } } response diff --git a/man/exportDataQuality.Rd b/man/exportDataQuality.Rd index f1378c8c..2e1ce1d2 100644 --- a/man/exportDataQuality.Rd +++ b/man/exportDataQuality.Rd @@ -12,7 +12,7 @@ exportDataQuality(rcon, prefix, ...) \item{prefix}{A string from your REDCap institutions Data Quality module url. The module prefix can be found by exporting module settings under External Modules -in REDCap.} +in REDCap. At VUMC the prefix is 'vanderbilt_dataQuality'.} } \description{ Exports Data Quality queries by record. The Data Quality module diff --git a/man/makeApiCall.Rd b/man/makeApiCall.Rd index 9abebe7a..96e5bd44 100644 --- a/man/makeApiCall.Rd +++ b/man/makeApiCall.Rd @@ -4,7 +4,7 @@ \alias{makeApiCall} \title{Make REDCap API Calls} \usage{ -makeApiCall(rcon, body = list(), config = list()) +makeApiCall(rcon, body = list(), config = list(), url = NULL) } \arguments{ \item{rcon}{A \code{redcapConnection} object.} @@ -15,6 +15,8 @@ makeApiCall(rcon, body = list(), config = list()) \item{config}{\code{list} A list of options to be passed to \code{\link[httr:POST]{httr::POST()}}. These will be appended to the \code{config} options included in the \code{rcon} object.} + +\item{url}{\code{character(1)} A url string to hit. Defaults to rcon$url.} } \description{ Constructs and executes API calls to the REDCap API. These diff --git a/tests/testthat/test-050-makeApiCall.R b/tests/testthat/test-050-makeApiCall.R index bbea4c14..5616ac9f 100644 --- a/tests/testthat/test-050-makeApiCall.R +++ b/tests/testthat/test-050-makeApiCall.R @@ -11,6 +11,14 @@ library(httr) # Test .makeApiCall_validateResponse +test_that( + "makeApiCall will not allow a non-character url", + { + expect_error( + makeApiCall(rcon, body = list(format = "csv"), url=TRUE), + "url.*Must be of type 'character'") + } +) test_that( ".makeApiCall_isRetryEligible returns appropriate logical values", diff --git a/tests/testthat/test-904-exportDataQuality.R b/tests/testthat/test-904-exportDataQuality.R index e97d801d..328c4970 100644 --- a/tests/testthat/test-904-exportDataQuality.R +++ b/tests/testthat/test-904-exportDataQuality.R @@ -14,7 +14,7 @@ test_that( "Return error messages if Data Quality Module not enabled", { expect_error(exportDataQuality(rcon, prefix), - "Error in result: Make sure the Data Quality API module is enabled in your project.") + "Make sure the Data Quality API module is enabled in your project.") } ) From 2c2c89cf666ed2f352c19b8ce785a54e36d36d51 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 12:51:53 -0500 Subject: [PATCH 151/155] Bumping NEWS #321 --- NEWS | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS b/NEWS index 3652ff62..fc841f77 100644 --- a/NEWS +++ b/NEWS @@ -15,6 +15,7 @@ A future release of version 3.0.0 will introduce several breaking changes! * Added additional supported arguments to deleteRecords. * Changed the default to `dag=FALSE` for exportRecordsTyped. * exportRecordsTyped more robust against some forms of corrupted meta data. +* Added a new feature exportDataQuality for querying the DataQuality module. ## 2.9.0 From 79bd9e7679e4b55676966b0dfcc33178c714b3a8 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 14 May 2024 14:02:30 -0400 Subject: [PATCH 152/155] small update to NEWS --- NEWS | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS b/NEWS index fc841f77..6cf25c30 100644 --- a/NEWS +++ b/NEWS @@ -15,7 +15,7 @@ A future release of version 3.0.0 will introduce several breaking changes! * Added additional supported arguments to deleteRecords. * Changed the default to `dag=FALSE` for exportRecordsTyped. * exportRecordsTyped more robust against some forms of corrupted meta data. -* Added a new feature exportDataQuality for querying the DataQuality module. +* Added a new feature exportDataQuality for pulling queries from the DataQuality module. ## 2.9.0 From 532f97e5cb2e9e8aa5501adca6b636b43e455ee2 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 13:02:53 -0500 Subject: [PATCH 153/155] Fixing error handling #321 --- R/exportDataQuality.R | 3 +-- R/redcapError.R | 2 +- man/redcapError.Rd | 2 +- 3 files changed, 3 insertions(+), 4 deletions(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index 64dd2a66..ec137702 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -59,8 +59,7 @@ exportDataQuality.redcapApiConnection <- response <- makeApiCall(rcon, body=api_param, config=config, url) - if (response$status_code != 200) - return(redcapError(response, error_handling)) + if (response$status_code != 200) redcapError(response) tryCatch( { diff --git a/R/redcapError.R b/R/redcapError.R index 5c090e76..8ae3715e 100644 --- a/R/redcapError.R +++ b/R/redcapError.R @@ -36,7 +36,7 @@ #' #' -redcapError <- function(x, error_handling) +redcapError <- function(x, error_handling=getOption("redcap_error_handling")) { error_message <- as.character(x) diff --git a/man/redcapError.Rd b/man/redcapError.Rd index 152020a7..e2f70e38 100644 --- a/man/redcapError.Rd +++ b/man/redcapError.Rd @@ -4,7 +4,7 @@ \alias{redcapError} \title{Handle Errors from the REDCap API} \usage{ -redcapError(x, error_handling) +redcapError(x, error_handling = getOption("redcap_error_handling")) } \arguments{ \item{x}{Object returned by \code{\link[httr:POST]{httr::POST()}}.} From 2d44bc133c9f3e855a19afc9f2de65d8e9024627 Mon Sep 17 00:00:00 2001 From: Shawn Garbett Date: Tue, 14 May 2024 13:23:49 -0500 Subject: [PATCH 154/155] Added name check on Data Quality returned object #321 --- tests/testthat/test-904-exportDataQuality.R | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/tests/testthat/test-904-exportDataQuality.R b/tests/testthat/test-904-exportDataQuality.R index 328c4970..ccb45cf9 100644 --- a/tests/testthat/test-904-exportDataQuality.R +++ b/tests/testthat/test-904-exportDataQuality.R @@ -8,6 +8,17 @@ test_that("Data queries can be exported",{ dq <- exportDataQuality(dqrcon, prefix) expect_gte(length(dq), 1) + + expect_contains(names(dq), + c("status_id", "rule_id", "pd_rule_id", + "non_rule", "project_id", "record", + "event_id", "field_name", "repeat_instrument", + "instance", "status", "exclude", + "query_status", "group_id", "assigned_username", + "res_id", "ts", "response_requested", + "response", "comment", "username", + "current_query_status", "upload_doc_id", "field_comment_edited") + ) }) test_that( From cd8a610ebb454aa182019a4765835db5666eaad9 Mon Sep 17 00:00:00 2001 From: "Obregon, Savannah" Date: Tue, 14 May 2024 15:38:09 -0400 Subject: [PATCH 155/155] add dots parameter and regenerate documentation --- R/exportDataQuality.R | 1 + man/exportDataQuality.Rd | 2 ++ man/redcapAPI.Rd | 2 +- 3 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/exportDataQuality.R b/R/exportDataQuality.R index ec137702..86f53689 100644 --- a/R/exportDataQuality.R +++ b/R/exportDataQuality.R @@ -12,6 +12,7 @@ #' @param prefix A string from your REDCap institutions Data Quality module url. The #' module prefix can be found by exporting module settings under External Modules #' in REDCap. At VUMC the prefix is 'vanderbilt_dataQuality'. +#' @param ..., additional arguments that are ignored. #' @export exportDataQuality <- function(rcon, prefix, ...) diff --git a/man/exportDataQuality.Rd b/man/exportDataQuality.Rd index 2e1ce1d2..cb6e71ab 100644 --- a/man/exportDataQuality.Rd +++ b/man/exportDataQuality.Rd @@ -13,6 +13,8 @@ exportDataQuality(rcon, prefix, ...) \item{prefix}{A string from your REDCap institutions Data Quality module url. The module prefix can be found by exporting module settings under External Modules in REDCap. At VUMC the prefix is 'vanderbilt_dataQuality'.} + +\item{..., }{additional arguments that are ignored.} } \description{ Exports Data Quality queries by record. The Data Quality module diff --git a/man/redcapAPI.Rd b/man/redcapAPI.Rd index 66a83ccc..8dd7f7c1 100644 --- a/man/redcapAPI.Rd +++ b/man/redcapAPI.Rd @@ -2,8 +2,8 @@ % Please edit documentation in R/redcapAPI-package.R \docType{package} \name{redcapAPI} -\alias{redcapAPI-package} \alias{redcapAPI} +\alias{redcapAPI-package} \title{Access data, meta data, and files from REDCap using the API} \description{ REDCap is a database development tool built on MySQL. Visit