|
| 1 | +#' Retrieve REDCap Credentials Based on Specified Parameters |
| 2 | +#' |
| 3 | +#' Fetches REDCap credentials from the CREDENTIALS_DB, allowing filtering based on |
| 4 | +#' project ID, server short name, project short name, and username. At least one filtering |
| 5 | +#' criterion must be provided. |
| 6 | +#' |
| 7 | +#' @param project_pid Optional project ID for filtering. |
| 8 | +#' @param server_short_name Optional server short name for filtering. |
| 9 | +#' @param project_short_name Optional project short name for filtering. |
| 10 | +#' @param username Optional username for filtering. |
| 11 | +#' |
| 12 | +#' @return A dataframe of filtered REDCap credentials, including a 'url' column added for convenience. |
| 13 | +#' |
| 14 | +#' @examples |
| 15 | +#' \dontrun{ |
| 16 | +#' source_credentials <- get_redcap_credentials(project_pid = "123") |
| 17 | +#' prod_credentials <- get_redcap_credentials(server_short_name = "prod") |
| 18 | +#' target_credentials <- prod_credentials |> |
| 19 | +#' filter(str_detect(project_name, "biospecimens")) |
| 20 | +#' } |
| 21 | +#' |
| 22 | +#' @export |
| 23 | +#' |
| 24 | +get_redcap_credentials <- function(project_pid = NA, |
| 25 | + server_short_name = NA, |
| 26 | + project_short_name = NA, |
| 27 | + username = NA) { |
| 28 | + |
| 29 | + # Verify that there is at least one parameter |
| 30 | + if ( |
| 31 | + all(is.na( |
| 32 | + c( |
| 33 | + server_short_name, |
| 34 | + username, |
| 35 | + project_pid, |
| 36 | + project_short_name |
| 37 | + ) |
| 38 | + )) |
| 39 | + ) { |
| 40 | + stop("At least one parameter must be defined") |
| 41 | + } |
| 42 | + |
| 43 | + credentials_conn <- DBI::dbConnect(RSQLite::SQLite(), Sys.getenv("CREDENTIALS_DB")) |
| 44 | + |
| 45 | + redcap_credentials <- dplyr::tbl(credentials_conn, "credentials") |> |
| 46 | + # Filter on any non-NA parameter |
| 47 | + # Parameters have to be localized so that will not be seen as columns in the data frame |
| 48 | + dplyr::filter(is.na(!!project_pid) | .data$project_id == !!project_pid) |> |
| 49 | + dplyr::filter(is.na(!!server_short_name) | .data$server_short_name == !!server_short_name) |> |
| 50 | + dplyr::filter(is.na(!!project_short_name) | .data$project_short_name == !!project_short_name) |> |
| 51 | + dplyr::filter(is.na(!!username) | .data$username == !!username) |> |
| 52 | + dplyr::collect() |> |
| 53 | + # Make a copy of redcap_uri to make redcapAPI coding a tiny bit simpler |
| 54 | + dplyr::mutate(url = .data$redcap_uri) |
| 55 | + |
| 56 | + DBI::dbDisconnect(credentials_conn) |
| 57 | + |
| 58 | + return(redcap_credentials) |
| 59 | +} |
| 60 | + |
0 commit comments