provide redirection for plug urls

ref #542
OuhscBbmc · Oct 17, 2024 · 4e01ff5 · 4e01ff5
1 parent 49450da
commit 4e01ff5
Show file tree

Hide file tree

Showing 7 changed files with 63 additions and 9 deletions.
diff --git a/R/helpers-testing.R b/R/helpers-testing.R
@@ -49,7 +49,42 @@ retrieve_credential_testing <- function(project_tag = "simple", server_instance
     username        = username
   )
 }
+retrieve_plugins <- function(plugin_name, server_instance = "dev-2") {
+  checkmate::assert_character(plugin_name     , any.missing = FALSE, min.chars = 2, max.chars = 50)
+  checkmate::assert_character(server_instance , any.missing = FALSE, min.chars = 2, max.chars = 50)
+
+  # This line avoids a warning from the package check.
+  plugins <- instance <- tag <- project_tag <- NULL
+
+  if (!requireNamespace("yaml", quietly = TRUE)) {
+    stop(
+      "Package `yaml` must be installed to use this function.",
+      call. = FALSE
+    )
+  }
+  d_map <-
+    system.file("misc/plugin-redirection.yml", package = "REDCapR") |>
+    yaml::yaml.load_file(
+      handlers = list(map = \(x) tibble::as_tibble(x))
+    ) |>
+    dplyr::bind_rows() |>
+    tidyr::unnest(plugins) |>
+    tidyr::pivot_longer(
+      cols      = -c("instance"),
+      names_to  = "tag",
+      values_to = "url"
+    ) |>
+    tidyr::drop_na(url) |>
+    dplyr::filter(instance == server_instance) |>
+    dplyr::filter(tag      == plugin_name)
+
+  if (nrow(d_map) == 0L) {
+    stop("A plugin mapping entry does not exist for the desired arguments.")
+  }
 
+  d_map |>
+    dplyr::pull(url)
+}
 # This function isn't used during testing itself.  Just to create the expected file.
 save_expected <- function(o, path) {
   # nocov start
@@ -60,7 +95,6 @@ save_expected <- function(o, path) {
   dput(o, path)
   # nocov end
 }
-
 retrieve_expected <- function(path) {
   full_path   <- system.file(path, package = "REDCapR")
   if (!file.exists(full_path))

diff --git a/R/project-dag-write.R b/R/project-dag-write.R
@@ -94,8 +94,9 @@ clear_project_dag_write <- function(verbose = FALSE) {
     )
     # nocov end
   }
-  path_delete_test_record <-
-    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_dag_write.php"
+
+  path_delete_test_record <- retrieve_plugins("delete_dag")
+  # "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)

diff --git a/R/project-delete-multiple-arm.R b/R/project-delete-multiple-arm.R
@@ -64,8 +64,8 @@ clear_project_delete_multiple_arm <- function(verbose = TRUE) {
     )
     # nocov end
   }
-  path_delete_test_record <-
-    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
+  path_delete_test_record <- retrieve_plugins("delete_arm_multiple")
+  # "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)

diff --git a/R/project-delete-single-arm.R b/R/project-delete-single-arm.R
@@ -64,8 +64,8 @@ clear_project_delete_single_arm <- function(verbose = FALSE) {
     )
     # nocov end
   }
-  path_delete_test_record <-
-    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
+  path_delete_test_record <- retrieve_plugins("delete_arm_single")
+  # "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)

diff --git a/R/project-simple.R b/R/project-simple.R
@@ -89,8 +89,8 @@ clear_project_simple <- function(verbose = TRUE) {
     )
     # nocov end
   }
-  path_delete_test_record <-
-    "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_simple.php"
+  path_delete_test_record <- retrieve_plugins("delete_simple")
+  # "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)

diff --git a/inst/misc/plugin-redirection.yml b/inst/misc/plugin-redirection.yml
@@ -0,0 +1,15 @@
+-
+  instance: bbmc
+  plugins:
+    - delete_simple       : "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_simple.php"
+    - delete_arm_single   : "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
+    - delete_arm_multiple : "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
+    - delete_dag          : "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_dag_write.php"
+
+-
+  instance: dev-2
+  plugins:
+    - delete_simple       : "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_simple.php"
+    - delete_arm_single   : "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_single_arm.php"
+    - delete_arm_multiple : "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
+    - delete_dag          : "https://redcap-dev-2.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_dag_write.php"
diff --git a/tests/test-all.R b/tests/test-all.R
@@ -2,5 +2,9 @@
 library(testthat)
 library(REDCapR)
 
+Sys.setenv("redcapr_test_server" = "dev-2")
+
+message("Using test server '", Sys.getenv("redcapr_test_server"), "'.")
+
 # source("R/helpers-testing.R")
 testthat::test_check("REDCapR")