Merge pull request #543 from OuhscBbmc/dev

more portable tests & dev server

.Rbuildignore

@@ -9,6 +9,10 @@
 ^cran-comments\.md$
 README.html$
 
+project\.xml$
+\.zip$
+\.tar.xz$
+
 documentation-peek.pdf
 documentation-for-developers/
 lastMiKTeXException/

DESCRIPTION

@@ -61,7 +61,8 @@ Suggests:
     rmarkdown (>= 2.0),
     sessioninfo (>= 1.1.1),
     testthat (>= 3.0),
-    tidyselect
+    tidyselect,
+    yaml
 License: MIT + file LICENSE
 VignetteBuilder: knitr
 Encoding: UTF-8

NEWS.md

@@ -10,11 +10,18 @@ Quick links:
 * [Current & previous GitHub Issues](https://github.com/OuhscBbmc/REDCapR/issues?q=is%3Aissue)
 * [Documentation for current GitHub version](https://ouhscbbmc.github.io/REDCapR/)
 
-Version 1.2.0  (released 2024-09-08)
+Version 1.3.x  (Not yet released on CRAN)
 ==========================================================
 
 These features are not yet on CRAN.  Install with `remotes::install_github("OuhscBbmc/REDCapR")`
 
+### Minor Enhancements
+
+* Redirection layer for test suite allows you to plug in your own server (#539)
+
+Version 1.2.0  (released 2024-09-08)
+==========================================================
+
 ### Possibly Breaking Change
 
 These changes could possibly break existing code --but it's very unlikely.  We feel they will (directly and indirectly) improve the package considerably.
@@ -175,7 +182,7 @@ Version 0.11.0 (Released 2020-04-20)
 
 * [`redcap_metadata_write()`](https://ouhscbbmc.github.io/REDCapR/reference/redcap_metadata_write.html) writes to the project's metadata. (#274, @felixetorres)
 
-* [`redcap_survey_link_export_oneshot()`](https://ouhscbbmc.github.io/REDCapR/reference/redcap_survey_link_export_oneshot.html) retrieves the URL to a specific record's survey (*e.g.*, "https://bbmc.ouhsc.edu/redcap/surveys/?s=8KuzSLMHf6") (#293)
+* [`redcap_survey_link_export_oneshot()`](https://ouhscbbmc.github.io/REDCapR/reference/redcap_survey_link_export_oneshot.html) retrieves the URL to a specific record's survey (*e.g.*, "https://redcap-dev-2.ouhsc.edu/redcap/surveys/?s=8KuzSLMHf6") (#293)
 
 * `convert_logical_to_integer` is a new parameter for [`redcap_write()`](https://ouhscbbmc.github.io/REDCapR/reference/redcap_write.html) and [`redcap_write_oneshot()`](https://ouhscbbmc.github.io/REDCapR/reference/redcap_write_oneshot.html). If `TRUE`, all [base::logical] columns in `ds` are cast to an integer before uploading to REDCap.  Boolean values are typically represented as 0/1 in REDCap radio buttons.  Defaults to `FALSE` to maintain backwards compatibility. (#305)
 

R/constant.R

@@ -214,18 +214,18 @@ constant_list <- list(
   form_unverified       = 1L,
   form_complete         = 2L,
 
-  # https://bbmc.ouhsc.edu/redcap/api/help/?content=exp_users
+  # https://redcap-dev-2.ouhsc.edu/redcap/api/help/?content=exp_users
   data_export_rights_no_access    = 0L,
   data_export_rights_deidentified = 1L,
   data_export_rights_full         = 2L,
 
-  # https://bbmc.ouhsc.edu/redcap/api/help/?content=exp_users
+  # https://redcap-dev-2.ouhsc.edu/redcap/api/help/?content=exp_users
   form_rights_no_access    = 0L,
   form_rights_readonly     = 2L,
   form_rights_edit_form    = 1L,  # Notice order is not sequential
   form_rights_edit_survey  = 3L,
 
-  # https://bbmc.ouhsc.edu/redcap/api/help/?content=exp_users
+  # https://redcap-dev-2.ouhsc.edu/redcap/api/help/?content=exp_users
   access_no    = 0L,
   access_yes   = 1L
 )

R/helpers-testing.R

@@ -1,8 +1,51 @@
-retrieve_credential_testing <- function(project_id = 153L, username = NA_character_) {
-  checkmate::assert_integer(project_id, lower = 1, len = 1, any.missing = FALSE)
-  REDCapR::retrieve_credential_local(
-    path_credential = system.file("misc/example.credentials", package = "REDCapR"),
-    project_id      = project_id,
+retrieve_credential_testing <- function(project_tag = "simple", server_instance = "dev-2", username = NA_character_) {
+  checkmate::assert_character(project_tag     , any.missing = FALSE, min.chars = 2, max.chars = 50)
+  checkmate::assert_character(server_instance , any.missing = FALSE, min.chars = 2, max.chars = 50)
+  checkmate::assert_character(username        , any.missing = TRUE , min.chars = 2, max.chars = 50)
+
+  # This line avoids a warning from the package check.
+  projects <- project_id <- instance <- tag <- NULL
+
+  if (!requireNamespace("yaml", quietly = TRUE)) {
+    stop(
+      "Package `yaml` must be installed to use this function.",
+      call. = FALSE
+    )
+  }
+  d_map <-
+    system.file("misc/project-redirection.yml", package = "REDCapR") |>
+    yaml::yaml.load_file(
+      handlers = list(map = \(x) tibble::as_tibble(x))
+    ) |>
+    dplyr::bind_rows() |>
+    tidyr::unnest(projects) |>
+    tidyr::pivot_longer(
+      cols      = -c("instance", "credential_file"),
+      names_to  = "tag",
+      values_to = "project_id"
+    ) |>
+    tidyr::drop_na(project_id) |>
+    dplyr::filter(instance == server_instance) |>
+    dplyr::filter(tag      == project_tag)
+
+  if (nrow(d_map) == 0L) {
+    stop("A credential mapping entry does not exist for the desired arguments.")
+  }
+
+  path_credential <- system.file(d_map$credential_file, package = "REDCapR")
+  if (!base::file.exists(path_credential)) {
+    stop(
+      "The credential file `",
+      d_map$credential_file,
+      "` associated with the `",
+      server_instance,
+      "` does not exist on this machine."
+    )
+  }
+
+  retrieve_credential_local(
+    path_credential = path_credential, # "misc/dev-2.credentials"
+    project_id      = d_map$project_id,
     username        = username
   )
 }

R/kernel-api.R

@@ -37,8 +37,8 @@
 #'
 #' @examples
 #' config_options <- NULL
-#' uri            <- "https://bbmc.ouhsc.edu/redcap/api/"
-#' token          <- "9A81268476645C4E5F03428B8AC3AA7B"
+#' uri            <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
+#' token          <- "9A068C425B1341D69E83064A2D273A70"
 #' post_body      <- list(
 #'   token    = token,
 #'   content  = "project",

R/metadata-utilities.R

@@ -68,16 +68,16 @@
 #' REDCapR::checkbox_choices(select_choices=choices_1)
 #'
 #' \dontrun{
-#' uri         <- "https://bbmc.ouhsc.edu/redcap/api/"
-#' token       <- "9A81268476645C4E5F03428B8AC3AA7B"
+#' uri         <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
+#' token       <- "9A068C425B1341D69E83064A2D273A70"
 #'
 #' ds_metadata <- redcap_metadata_read(uri, token)$data
 #' choices_2   <- ds_metadata[ds_metadata$field_name == "race", ]$select_choices_or_calculations
 #'
 #' REDCapR::regex_named_captures(pattern = pattern_boxes, text = choices_2)
 #' }
 #'
-#' path_3     <- system.file(package = "REDCapR", "test-data/project-simple/metadata.csv")
+#' path_3     <- system.file(package = "REDCapR", "test-data/projects/simple/metadata.csv")
 #' ds_metadata_3  <- read.csv(path_3)
 #' choices_3  <- ds_metadata_3[ds_metadata_3$field_name=="race", "select_choices_or_calculations"]
 #' REDCapR::regex_named_captures(pattern = pattern_boxes, text = choices_3)

R/project-dag-write.R

@@ -12,14 +12,14 @@ populate_project_dag_write <- function(batch = FALSE, verbose = FALSE) {
     # nocov end
   }
 
-  credential  <- retrieve_credential_testing(2545L, "admin")
+  credential  <- retrieve_credential_testing("dag-write", username = "admin")
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,
     token         = credential$token
   )
   path_in_dag <- system.file(
-    "test-data/project-dag/data.csv",
+    "test-data/projects/dag/data.csv",
     package = "REDCapR"
   )
 
@@ -95,7 +95,7 @@ clear_project_dag_write <- function(verbose = FALSE) {
     # nocov end
   }
   path_delete_test_record <-
-    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_dag_write.php"
+    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_dag_write.php"
 
   # Returns a boolean value if successful
   was_successful <- !httr::http_error(path_delete_test_record)

R/project-delete-multiple-arm.R

@@ -10,7 +10,7 @@ populate_project_delete_multiple_arm <- function(verbose = FALSE) {
     # nocov end
   }
 
-  credential  <- retrieve_credential_testing(2627L)
+  credential  <- retrieve_credential_testing("arm-multiple-delete")
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,
@@ -64,7 +64,7 @@ clear_project_delete_multiple_arm <- function(verbose = TRUE) {
     # nocov end
   }
   path_delete_test_record <-
-    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
+    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
 
   # Returns a boolean value if successful
   was_successful <- !httr::http_error(path_delete_test_record)

R/project-delete-single-arm.R

@@ -10,7 +10,7 @@ populate_project_delete_single_arm <- function(verbose = FALSE) {
     # nocov end
   }
 
-  credential  <- retrieve_credential_testing(2626L)
+  credential  <- retrieve_credential_testing("arm-single-delete")
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,
@@ -64,7 +64,7 @@ clear_project_delete_single_arm <- function(verbose = FALSE) {
     # nocov end
   }
   path_delete_test_record <-
-    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
+    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
 
   # Returns a boolean value if successful
   was_successful <- !httr::http_error(path_delete_test_record)

R/project-simple.R

@@ -12,31 +12,31 @@ populate_project_simple <- function(batch = FALSE, verbose = TRUE) {
     # nocov end
   }
 
-  credential  <- retrieve_credential_testing(213L)
+  credential  <- retrieve_credential_testing("simple-write")
 
   project <- REDCapR::redcap_project$new(
     redcap_uri    = credential$redcap_uri,
     token         = credential$token,
     verbose       = verbose
   )
   path_in_simple <- system.file(
-    "test-data/project-simple/data.csv",
+    "test-data/projects/simple/data.csv",
     package = "REDCapR"
   )
 
   # Write the file to disk (necessary only when you wanted to change the data).  Don't uncomment; just run manually.
   # returned_object <- redcap_read_oneshot(redcap_uri=uri, token=token, raw_or_label="raw")
-  # utils::write.csv(returned_object$data, file="./inst/test-data/project-simple/simple-data.csv", row.names=FALSE)
+  # utils::write.csv(returned_object$data, file="./inst/test-data/projects/simple/simple-data.csv", row.names=FALSE)
   # returned_object_metadata <- redcap_metadata_read(redcap_uri=uri, token=token)
-  # utils::write.csv(returned_object_metadata$data, file="./inst/test-data/project-simple/simple-metadata.csv", row.names=FALSE)
+  # utils::write.csv(returned_object_metadata$data, file="./inst/test-data/projects/simple/simple-metadata.csv", row.names=FALSE)
 
   # Read in the data in R's memory from a csv file.
   ds_to_write <-
     readr::read_csv(
       path_in_simple,
       show_col_types = FALSE
     )
-  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-simple/simple-data.csv")
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/projects/simple/simple-data.csv")
 
   # Remove the calculated variables.
   ds_to_write$age <- NULL
@@ -90,7 +90,7 @@ clear_project_simple <- function(verbose = TRUE) {
     # nocov end
   }
   path_delete_test_record <-
-    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_simple.php"
+    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_simple.php"
 
   # Returns a boolean value if successful
   was_successful <- !httr::http_error(path_delete_test_record)

R/redcap-arm-export.R

@@ -54,16 +54,16 @@
 #'
 #' @examples
 #' \dontrun{
-#' uri            <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' uri            <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
 #'
 #' # Query a classic project with 3 arms
-#' token_1  <- "CDF9F3767E413FDBAA31D92E9F36730A"
+#' token_1  <- "14817611F9EA1A6E149BBDC37134E8EA" # arm-multiple-delete
 #' result_1 <- REDCapR::redcap_arm_export(redcap_uri=uri, token=token_1)
 #' result_1$has_arms
 #' result_1$data
 #'
 #' # Query a classic project without arms
-#' token_2  <- "D70F9ACD1EDD6F151C6EA78683944E98"
+#' token_2  <- "F9CBFFF78C3D78F641BAE9623F6B7E6A" # simple-write
 #' result_2 <- REDCapR::redcap_arm_export(redcap_uri=uri, token=token_2)
 #' result_2$has_arms
 #' result_2$data

R/redcap-dag-read.R

@@ -55,8 +55,8 @@
 #'
 #' @examples
 #' \dontrun{
-#' uri     <- "https://bbmc.ouhsc.edu/redcap/api/"
-#' token   <- "9A81268476645C4E5F03428B8AC3AA7B"
+#' uri     <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
+#' token   <- "9A068C425B1341D69E83064A2D273A70"
 #' REDCapR::redcap_dag_read(redcap_uri=uri, token=token)$data
 #' }
 

R/redcap-event-instruments.R

@@ -59,22 +59,22 @@
 #'
 #' @examples
 #' \dontrun{
-#' uri                 <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' uri                 <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
 #'
 #' # Longitudinal project with one arm
-#' token_1  <- "786334BEB4A87D572DD0E99C4BFCE144" # pid 2629
+#' token_1  <- "76B4A71A0158BD34C98F10DA72D5F27C" # "arm-single-longitudinal" test project
 #' REDCapR::redcap_arm_export(redcap_uri=uri, token=token_1)$data
 #' REDCapR::redcap_event_instruments(redcap_uri=uri, token=token_1)$data
 #'
 #' # Project with two arms
-#' token_2  <- "0434F0E9CF53ED0587847AB6E51DE762" # pid 212
+#' token_2  <- "DA6F2BB23146BD5A7EA3408C1A44A556" # "longitudinal" test project
 #' REDCapR::redcap_arm_export(redcap_uri=uri, token=token_2)$data
 #' REDCapR::redcap_event_instruments(redcap_uri=uri, token=token_2)$data
 #' REDCapR::redcap_event_instruments(redcap_uri=uri, token=token_2, arms = c("1", "2"))$data
 #' REDCapR::redcap_event_instruments(redcap_uri=uri, token=token_2, arms = "2")$data
 #'
 #' # Classic project (without arms) throws an error
-#' token_3  <- "9A81268476645C4E5F03428B8AC3AA7B" # pid 153
+#' token_3  <- "9A068C425B1341D69E83064A2D273A70" # "simple" test project
 #' REDCapR::redcap_arm_export(redcap_uri=uri, token=token_3)$data
 #' # REDCapR::redcap_event_instruments(redcap_uri=uri, token=token_3)$data
 #' }

R/redcap-event-read.R

@@ -53,20 +53,20 @@
 #'
 #' @examples
 #' \dontrun{
-#' uri            <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' uri            <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
 #'
 #' # Query a longitudinal project with a single arm and 3 events
-#' token_1  <- "786334BEB4A87D572DD0E99C4BFCE144"
+#' token_1  <- "76B4A71A0158BD34C98F10DA72D5F27C" # arm-single-longitudinal
 #' result_1 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_1)
 #' result_1$data
 #'
 #' # Query a longitudinal project with 2 arms and complex arm-event mappings
-#' token_2  <- "0434F0E9CF53ED0587847AB6E51DE762"
+#' token_2  <- "DA6F2BB23146BD5A7EA3408C1A44A556" # longitudinal
 #' result_2 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_2)
 #' result_2$data
 #'
 #' # Query a classic project without events
-#' token_3  <- "D70F9ACD1EDD6F151C6EA78683944E98"
+#' token_3  <- "F9CBFFF78C3D78F641BAE9623F6B7E6A" # simple-write
 #' result_3 <- REDCapR::redcap_event_read(redcap_uri=uri, token=token_3)
 #' result_3$data
 #' }

R/redcap-file-download-oneshot.R

@@ -78,8 +78,8 @@
 #'
 #' @examples
 #' \dontrun{
-#' uri     <- "https://bbmc.ouhsc.edu/redcap/api/"
-#' token   <- "D70F9ACD1EDD6F151C6EA78683944E98" # pid=213
+#' uri     <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
+#' token   <- "F9CBFFF78C3D78F641BAE9623F6B7E6A" # simple-write
 #' record  <- 1
 #' field   <- "mugshot"
 #' # event <- "" # only for longitudinal projects

R/redcap-file-upload-oneshot.R

@@ -69,8 +69,8 @@
 #' @examples
 #' \dontrun{
 #' # Define some constants
-#' uri    <- "https://bbmc.ouhsc.edu/redcap/api/"
-#' token  <- "D70F9ACD1EDD6F151C6EA78683944E98" # The simple project -pid 213
+#' uri    <- "https://redcap-dev-2.ouhsc.edu/redcap/api/"
+#' token  <- "F9CBFFF78C3D78F641BAE9623F6B7E6A" # simple-write
 #' field  <- "mugshot"
 #' event  <- "" # only for longitudinal events
 #'
@@ -82,7 +82,7 @@
 #'   file_name  = file_path,
 #'   record     = record,
 #'   field      = field,
-#'   redcap_uri = redcap_uri,
+#'   redcap_uri = uri,
 #'   token      = token
 #' )
 #'
@@ -100,7 +100,7 @@
 #'     file_name  = file_path,
 #'     record     = record,
 #'     field      = field,
-#'     redcap_uri = redcap_uri,
+#'     redcap_uri = uri,
 #'     token      = token
 #'   )
 #' }