diff --git a/R/helpers-testing.R b/R/helpers-testing.R index 60500745..5eafc1f1 100644 --- 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 index 0bb46177..7cb8a7a5 100644 --- 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 index 24e55927..9ae31587 100644 --- 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 index 59ba691a..0efa2685 100644 --- 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 index f055869c..ca56c9da 100644 --- 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 new file mode 100644 index 00000000..0aeb5d5a --- /dev/null +++ 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 index 0e17353a..6cff8edb 100644 --- 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")