diff --git a/NEWS.md b/NEWS.md index 49ade1e7..ffd29178 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ * `redcapUserRoleStructure` allows new `alerts`, `api_modules`, and `data_quality_resolution` attributes. * `exportUsers` properly handles the columns random_setup, random_dashboard and random_perform. * `importUsers` and `exportUsers` weren't handling data_access_group assignment properly. +* Avoid errors when user role access columns are missing from export responses. ## DEPRECATION NOTICES diff --git a/R/exportUserRoles.R b/R/exportUserRoles.R index 11e8d495..6b9dc314 100644 --- a/R/exportUserRoles.R +++ b/R/exportUserRoles.R @@ -61,8 +61,9 @@ exportUserRoles.redcapApiConnection <- function(rcon, # Format UserRole properties #### if (labels){ - UserRole[REDCAP_USER_ROLE_TABLE_ACCESS_VARIABLES] <- - lapply(UserRole[REDCAP_USER_ROLE_TABLE_ACCESS_VARIABLES], + existing_vars <- intersect(REDCAP_USER_ROLE_TABLE_ACCESS_VARIABLES, names(UserRole)) + UserRole[existing_vars] <- + lapply(UserRole[existing_vars], factor, levels = 0:1, labels = c("No Access", "Access")) diff --git a/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R b/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R index 0f5be8c4..c1e4b15b 100644 --- a/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R +++ b/tests/testthat/test-102-userRoleMethods-ArgumentValidation.R @@ -148,3 +148,26 @@ test_that( } ) +test_that( + "exportUserRoles handles missing access columns", + { + mock_roles <- data.frame(unique_role_name = "role_1", + role_label = "Role 1", + user_rights = 1, + forms_export = "form_1:0", + stringsAsFactors = FALSE) + + mockery::stub(exportUserRoles.redcapApiConnection, + "makeApiCall", + function(...) mock_roles) + + UserRoles <- exportUserRoles(rcon, + labels = TRUE, + form_rights = FALSE) + + expect_equal(UserRoles$user_rights, + factor("Access", levels = c("No Access", "Access"))) + expect_false("design" %in% names(UserRoles)) + } +) +