Skip to content

Commit 2299a56

Browse files
wibeasleywibeasley
committed
add redcap_users_export()
closes #163
1 parent f546c0e commit 2299a56

File tree

8 files changed

+299
-3
lines changed

8 files changed

+299
-3
lines changed

‎NAMESPACE

+1
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,7 @@ export(redcap_project)
1111
export(redcap_read)
1212
export(redcap_read_oneshot)
1313
export(redcap_upload_file_oneshot)
14+
export(redcap_users_export)
1415
export(redcap_variables)
1516
export(redcap_version)
1617
export(redcap_write)

‎NEWS

+2-1
Original file line numberDiff line numberDiff line change
@@ -16,6 +16,7 @@ Minor New Features:
1616
* `read_metadata()` always returns `character` vectors for all variables. With readr 1.2.0, some column were returned differently than before. (#193)
1717
* 'raw_or_label_headers' now supported (Thanks Hatem Hosny - hatemhosny, #183 & #203)
1818
* 'export_checkbox_labels' now supported (#186)
19+
* `redcap_users_export()` now included (#163)
1920
* 'forms' now supported for `redcap_read()`, `redcap_read_oneshot()`, & `redcap_read_oneshot_eav()`(#206). It was already implemented for `redcap_metadata_read()`.
2021
* If no records are affected, a zero-length *character* vector is returned (instead of sometimes a zero-length *numeric* vector) (#212)
2122
* New function (called `constants()`) easily exposes REDCap-specific constants. (#217)
@@ -28,7 +29,7 @@ Minor New Features:
2829
Modified Internals:
2930
* All interaction with the REDCap server goes through the new `kernal_api()` function, which uses the 'httr' and 'curl' packages underneath. Until now, each function called those packages directly. (#213)
3031
* When converting REDCap's CSV to R's data.frame, `readr::read_csv()` is used instead of `utils::read.csv()` (Issue #127).
31-
* updated to readr 1.2.0 (#200). This changed how some data variables were assigned a data types
32+
* updated to readr 1.2.0 (#200). This changed how some data variables were assigned a data types.
3233
* uses `odbc` package to retrieve credentials from the token server. Remove RODBC and RODBCext (#188). Thanks to @krlmlr for error checking advice in https://stackoverflow.com/a/50419403/1082435.
3334
* `data.table::rbindlist()` replaced by `dplyr::bind_rows()`
3435
* the checkmate package inspects most function parameters now (instead of `testit::assert()` and `base:stop()` ) (#190 & #208).

‎R/redcap-users-export.R

+139
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,139 @@
1+
#' @name redcap_users_export
2+
#' @export
3+
#' @title List authorized users.
4+
#'
5+
#' @description List users authorized for a project.
6+
#'
7+
#' @param redcap_uri The URI (uniform resource identifier) of the REDCap project. Required.
8+
#' @param token The user-specific string that serves as the password for a project. Required.
9+
#' @param verbose A boolean value indicating if `message`s should be printed to the R console during the operation. The verbose output might contain sensitive information (*e.g.* PHI), so turn this off if the output might be visible somewhere public. Optional.
10+
#' @param config_options A list of options to pass to `POST` method in the `httr` package. See the details below. Optional.
11+
#'
12+
#' @note
13+
#' *From the REDCap 8.4.0 Documentation*:
14+
#' This method allows you to export the list of users for a project,
15+
#' including their user privileges and also email address, first name, and last name.
16+
#' Note: If the user has been assigned to a user role, it will return the user with
17+
#' the role's defined privileges.
18+
#'
19+
#' @return a \code{\link[utils:packageDescription]{utils::packageVersion}}.
20+
#' @examples
21+
#' uri <- "https://bbmc.ouhsc.edu/redcap/api/"
22+
#' token <- "06DEFB601F9B46847DAA9DF0CFA951B4"
23+
#' result <- REDCapR::redcap_users_export(redcap_uri=uri, token=token)
24+
#' result$data_user
25+
#' result$data_user_form
26+
27+
redcap_users_export <- function( redcap_uri, token, verbose=TRUE, config_options=NULL ) {
28+
# version_error <- base::package_version("0.0.0")
29+
30+
checkmate::assert_character(redcap_uri , any.missing=F, len=1, pattern="^.{1,}$")
31+
checkmate::assert_character(token , any.missing=F, len=1, pattern="^.{1,}$")
32+
33+
token <- sanitize_token(token)
34+
verbose <- verbose_prepare(verbose)
35+
36+
post_body <- list(
37+
token = token,
38+
content = 'user',
39+
format = 'csv'
40+
)
41+
42+
col_types <- readr::cols(
43+
username = readr::col_character(),
44+
email = readr::col_character(),
45+
firstname = readr::col_character(),
46+
lastname = readr::col_character(),
47+
expiration = readr::col_date(),
48+
data_access_group = readr::col_character(),
49+
data_access_group_id = readr::col_character(),
50+
design = readr::col_logical(),
51+
user_rights = readr::col_logical(),
52+
data_access_groups = readr::col_logical(),
53+
data_export = readr::col_character(),
54+
reports = readr::col_logical(),
55+
stats_and_charts = readr::col_logical(),
56+
manage_survey_participants = readr::col_logical(),
57+
calendar = readr::col_logical(),
58+
data_import_tool = readr::col_logical(),
59+
data_comparison_tool = readr::col_logical(),
60+
logging = readr::col_logical(),
61+
file_repository = readr::col_logical(),
62+
data_quality_create = readr::col_logical(),
63+
data_quality_execute = readr::col_logical(),
64+
api_export = readr::col_logical(),
65+
api_import = readr::col_logical(),
66+
mobile_app = readr::col_logical(),
67+
mobile_app_download_data = readr::col_logical(),
68+
record_create = readr::col_logical(),
69+
record_rename = readr::col_logical(),
70+
record_delete = readr::col_logical(),
71+
lock_records_all_forms = readr::col_logical(),
72+
lock_records = readr::col_logical(),
73+
lock_records_customization = readr::col_logical(),
74+
forms = readr::col_character()
75+
)
76+
77+
# This is the important line that communicates with the REDCap server.
78+
kernel <- kernel_api(redcap_uri, post_body, config_options)
79+
80+
if( kernel$success ) {
81+
try (
82+
{
83+
# readr::spec_csv(kernel$raw_text)
84+
ds_combined <- readr::read_csv(file=kernel$raw_text, col_types=col_types)
85+
86+
# Remove the readr's `spec` attribute about the column names & types.
87+
attr(ds_combined, "spec") <- NULL
88+
89+
ds_user <- ds_combined %>%
90+
dplyr::select_("-forms")
91+
92+
ds_user_form <- ds_combined %>%
93+
dplyr::select_("username", "forms") %>%
94+
tidyr::separate_rows(.data$forms, sep=",") %>%
95+
tidyr::separate_(
96+
col = "forms",
97+
into = c("form_name", "permission"),
98+
sep = ":",
99+
convert = FALSE
100+
) %>%
101+
dplyr::mutate(
102+
permission = as.logical(as.integer(.data$permission))
103+
)
104+
},
105+
silent = TRUE #Don't print the warning in the try block. Print it below, where it's under the control of the caller.
106+
)
107+
108+
if( exists("ds_user") & inherits(ds_user, "data.frame") ) {
109+
outcome_message <- paste0(
110+
"The REDCap users were successfully exported in ",
111+
round(kernel$elapsed_seconds, 1), " seconds. The http status code was ",
112+
kernel$status_code, "."
113+
)
114+
kernel$raw_text <- "" # If an operation is successful, the `raw_text` is no longer returned to save RAM. The content is not really necessary with httr's status message exposed.
115+
} else {
116+
kernel$success <- FALSE #Override the 'success' determination from the http status code.
117+
ds_user <- data.frame() #Return an empty data.frame
118+
ds_user_form <- data.frame() #Return an empty data.frame
119+
outcome_message <- paste0("The REDCap user export failed. The http status code was ", kernel$status_code, ". The 'raw_text' returned was '", kernel$raw_text, "'.")
120+
}
121+
} else {
122+
ds_user <- data.frame() #Return an empty data.frame
123+
ds_user_form <- data.frame() #Return an empty data.frame
124+
outcome_message <- paste0("The REDCap user export failed. The error message was:\n", kernel$raw_text)
125+
}
126+
127+
if( verbose )
128+
message(outcome_message)
129+
130+
return( list(
131+
data_user = ds_user,
132+
data_user_form = ds_user_form,
133+
success = kernel$success,
134+
status_code = kernel$status_code,
135+
outcome_message = outcome_message,
136+
elapsed_seconds = kernel$elapsed_seconds,
137+
raw_text = kernel$raw_text
138+
) )
139+
}

‎_pkgdown.yml

+1
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,7 @@ reference:
4848
contents:
4949
- redcap_next_free_record_name
5050
- redcap_metadata_read
51+
- redcap_users_export
5152
- redcap_variables
5253
- redcap_version
5354

‎inst/misc/example.credentials

+1-1
Original file line numberDiff line numberDiff line change
@@ -15,4 +15,4 @@ redcap_uri,username,project_id,token,comment
1515
"https://bbmc.ouhsc.edu/redcap/api/","myusername","977","F304DEC3793FECC3B6DEEFF66302CAD3","Clinical Trial (Fake) --Read-only, contributed by @higgi13425"
1616
"https://bbmc.ouhsc.edu/redcap/api/","myusername","0","---","Clinical Trial (Fake) --read & write, contributed by @higgi13425"
1717
"https://bbmc.ouhsc.edu/redcap/api/","myusername","998","124CA60A870CAA85394FE9E00EB8EFE7","nonnumeric record_id"
18-
"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","nonnumeric record_id"
18+
"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","DAG"

‎man/redcap_users_export.Rd

+38
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-users-export.R

+114
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,114 @@
1+
library(testthat)
2+
context("Users Export")
3+
4+
credential_1 <- REDCapR::retrieve_credential_local(
5+
path_credential = system.file("misc/example.credentials", package="REDCapR"),
6+
project_id = 999
7+
)
8+
9+
credential_2 <- REDCapR::retrieve_credential_local(
10+
path_credential = system.file("misc/example.credentials", package="REDCapR"),
11+
project_id = 153
12+
)
13+
14+
test_that("smoke test", {
15+
testthat::skip_on_cran()
16+
expect_message({
17+
returned_object_1 <- redcap_users_export(redcap_uri=credential_1$redcap_uri, token=credential_1$token, verbose=T)
18+
returned_object_2 <- redcap_users_export(redcap_uri=credential_2$redcap_uri, token=credential_2$token, verbose=T)
19+
})
20+
})
21+
22+
test_that("with DAGs", {
23+
testthat::skip_on_cran()
24+
expected_outcome_message <- "The REDCap users were successfully exported in \\d+(\\.\\d+\\W|\\W)seconds\\. The http status code was 200\\."
25+
expected_data_user <- structure(
26+
list(username = c("dwells", "unittestphifree", "wbeasleya"
27+
), email = c("[email protected]", "[email protected]",
28+
"[email protected]"), firstname = c("Donna", "Unit Test",
29+
"Will"), lastname = c("Wells", "PHI Free", "Beasley_A"), expiration = structure(c(20334,
30+
NA, NA), class = "Date"), data_access_group = c("dagb", "daga",
31+
NA), data_access_group_id = c("332", "331", NA), design = c(FALSE,
32+
FALSE, TRUE), user_rights = c(FALSE, FALSE, TRUE), data_access_groups = c(FALSE,
33+
FALSE, TRUE), data_export = c("2", "1", "1"), reports = c(FALSE,
34+
FALSE, TRUE), stats_and_charts = c(FALSE, FALSE, TRUE), manage_survey_participants = c(TRUE,
35+
TRUE, TRUE), calendar = c(FALSE, FALSE, TRUE), data_import_tool = c(FALSE,
36+
FALSE, TRUE), data_comparison_tool = c(FALSE, FALSE, TRUE), logging = c(FALSE,
37+
FALSE, TRUE), file_repository = c(FALSE, FALSE, TRUE), data_quality_create = c(FALSE,
38+
FALSE, TRUE), data_quality_execute = c(FALSE, FALSE, TRUE), api_export = c(FALSE,
39+
TRUE, TRUE), api_import = c(FALSE, FALSE, TRUE), mobile_app = c(FALSE,
40+
FALSE, TRUE), mobile_app_download_data = c(FALSE, FALSE, TRUE
41+
), record_create = c(FALSE, FALSE, TRUE), record_rename = c(FALSE,
42+
FALSE, FALSE), record_delete = c(FALSE, FALSE, FALSE), lock_records_all_forms = c(FALSE,
43+
FALSE, FALSE), lock_records = c(FALSE, FALSE, FALSE), lock_records_customization = c(FALSE,
44+
FALSE, FALSE)), row.names = c(NA, -3L), class = c("tbl_df", "tbl",
45+
"data.frame")
46+
)
47+
expected_data_user_form <- structure(
48+
list(username = c("dwells", "unittestphifree", "wbeasleya"
49+
), form_name = c("demographics", "demographics", "demographics"
50+
), permission = c(TRUE, TRUE, TRUE)), class = c("tbl_df", "tbl",
51+
"data.frame"), row.names = c(NA, -3L)
52+
)
53+
54+
expect_message(
55+
regexp = expected_outcome_message,
56+
returned_object <- redcap_users_export(redcap_uri=credential_1$redcap_uri, token=credential_1$token, verbose=T)
57+
)
58+
59+
expect_equivalent(returned_object$data_user , expected=expected_data_user , label="The returned data.frame should be correct") # dput(returned_object$data_user);
60+
expect_equivalent(returned_object$data_user_form, expected=expected_data_user_form, label="The returned data.frame should be correct") # dput(returned_object$data_user_form)
61+
expect_equal(returned_object$status_code, expected=200L)
62+
expect_equivalent(returned_object$raw_text, expected="") # dput(returned_object$raw_text)
63+
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
64+
expect_true(returned_object$success)
65+
# system.file("misc/example.credentials", package="REDCapR")
66+
67+
# expect_equal_to_reference(returned_object$data, file=system.file("test-data/project-simple/variations/default.rds", package="REDCapR"))
68+
# expect_equal_to_reference(returned_object$data, file="./test-data/project-simple/variations/default.rds")
69+
})
70+
test_that("with DAGs", {
71+
testthat::skip_on_cran()
72+
expected_outcome_message <- "The REDCap users were successfully exported in \\d+(\\.\\d+\\W|\\W)seconds\\. The http status code was 200\\."
73+
expected_data_user <- structure(
74+
list(username = c("unittestphifree", "wbeasleya"),
75+
email = c("[email protected]", "[email protected]"
76+
), firstname = c("Unit Test", "Will"), lastname = c("PHI Free",
77+
"Beasley_A"), expiration = structure(c(NA_real_, NA_real_
78+
), class = "Date"), data_access_group = c(NA_character_,
79+
NA_character_), data_access_group_id = c(NA_character_, NA_character_
80+
), design = c(FALSE, TRUE), user_rights = c(FALSE, TRUE),
81+
data_access_groups = c(FALSE, TRUE), data_export = c("1",
82+
"1"), reports = c(TRUE, TRUE), stats_and_charts = c(TRUE,
83+
TRUE), manage_survey_participants = c(TRUE, TRUE), calendar = c(TRUE,
84+
TRUE), data_import_tool = c(FALSE, TRUE), data_comparison_tool = c(FALSE,
85+
TRUE), logging = c(FALSE, TRUE), file_repository = c(TRUE,
86+
TRUE), data_quality_create = c(FALSE, TRUE), data_quality_execute = c(FALSE,
87+
TRUE), api_export = c(TRUE, FALSE), api_import = c(FALSE,
88+
FALSE), mobile_app = c(FALSE, FALSE), mobile_app_download_data = c(FALSE,
89+
FALSE), record_create = c(TRUE, TRUE), record_rename = c(FALSE,
90+
FALSE), record_delete = c(FALSE, FALSE), lock_records_all_forms = c(FALSE,
91+
FALSE), lock_records = c(FALSE, FALSE), lock_records_customization = c(FALSE,
92+
FALSE)), row.names = c(NA, -2L), class = c("tbl_df", "tbl",
93+
"data.frame")
94+
)
95+
expected_data_user_form <- structure(
96+
list(username = c("unittestphifree", "unittestphifree",
97+
"unittestphifree", "wbeasleya", "wbeasleya", "wbeasleya"), form_name = c("demographics",
98+
"health", "race_and_ethnicity", "demographics", "health", "race_and_ethnicity"
99+
), permission = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE)), class = c("tbl_df",
100+
"tbl", "data.frame"), row.names = c(NA, -6L)
101+
)
102+
103+
expect_message(
104+
regexp = expected_outcome_message,
105+
returned_object <- redcap_users_export(redcap_uri=credential_2$redcap_uri, token=credential_2$token, verbose=T)
106+
)
107+
108+
expect_equivalent(returned_object$data_user , expected=expected_data_user , label="The returned data.frame should be correct") # dput(returned_object$data_user);
109+
expect_equivalent(returned_object$data_user_form, expected=expected_data_user_form, label="The returned data.frame should be correct") # dput(returned_object$data_user_form)
110+
expect_equal(returned_object$status_code, expected=200L)
111+
expect_equivalent(returned_object$raw_text, expected="") # dput(returned_object$raw_text)
112+
expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
113+
expect_true(returned_object$success)
114+
})

‎utility/refresh.R

+3-1
Original file line numberDiff line numberDiff line change
@@ -14,11 +14,13 @@ devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
1414
# devtools::run_examples(, "redcap_read.Rd")
1515
test_results_checked <- devtools::test()
1616
test_results_checked <- devtools::test(filter = "read-oneshot-eav")
17-
test_results_checked <- devtools::test(filter = "next-free.*$")
17+
test_results_checked <- devtools::test(filter = "users.*$")
1818
# testthat::test_dir("./tests/")
1919
test_results_not_checked <- testthat::test_dir("./tests/manual/")
2020

2121
# devtools::check(force_suggests = FALSE)
22+
devtools::check(cran=T)
23+
# devtools::check_rhub(email="[email protected]")
2224
# devtools::build_win(version="R-devel") #CRAN submission policies encourage the development version
2325
# devtools::revdep_check(pkg="REDCapR", recursive=TRUE)
2426
# devtools::release(check=FALSE) #Careful, the last question ultimately uploads it to CRAN, where you can't delete/reverse your decision.

0 commit comments

Comments
 (0)