Skip to content

Commit 337c522

Browse files
authored
Merge pull request #479 from vubiostat/new_form_rights_463
Updated user role definitions #463
2 parents 6aacc17 + 5821d8e commit 337c522

File tree

3 files changed

+198
-168
lines changed

3 files changed

+198
-168
lines changed

NEWS.md

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -10,6 +10,7 @@ A future release of version 3.0.0 will introduce several breaking changes!
1010
## 2.11.5
1111

1212
* Deleted functions `prepUserImportData_validateAllFormsPresent` and `prepUserImportData_extractFormName`.
13+
* Updated user role permissions to use new number based on version
1314
* Adds trailing slash when calling unlockREDCap to url if not present.
1415

1516
## 2.11.4

R/exportUsers.R

Lines changed: 87 additions & 80 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22
#' @order 1
33
#' @export
44

5-
exportUsers <- function(rcon,
5+
exportUsers <- function(rcon,
66
...){
77
UseMethod("exportUsers")
88
}
@@ -11,120 +11,120 @@ exportUsers <- function(rcon,
1111
#' @order 4
1212
#' @export
1313

14-
exportUsers.redcapApiConnection <- function(rcon,
15-
dates = TRUE,
16-
labels = TRUE,
17-
form_rights = TRUE,
14+
exportUsers.redcapApiConnection <- function(rcon,
15+
dates = TRUE,
16+
labels = TRUE,
17+
form_rights = TRUE,
1818
...)
1919
{
2020
##################################################################
2121
# Argument Validation
22-
22+
2323
coll <- checkmate::makeAssertCollection()
24-
25-
checkmate::assert_class(x = rcon,
26-
classes = "redcapApiConnection",
24+
25+
checkmate::assert_class(x = rcon,
26+
classes = "redcapApiConnection",
2727
add = coll)
28-
29-
checkmate::assert_logical(x = dates,
30-
len = 1,
28+
29+
checkmate::assert_logical(x = dates,
30+
len = 1,
3131
add = coll)
32-
33-
checkmate::assert_logical(x = labels,
34-
len = 1,
32+
33+
checkmate::assert_logical(x = labels,
34+
len = 1,
3535
add = coll)
36-
37-
checkmate::assert_logical(x = form_rights,
38-
len = 1,
36+
37+
checkmate::assert_logical(x = form_rights,
38+
len = 1,
3939
add = coll)
4040

4141
checkmate::reportAssertions(coll)
42-
42+
4343
##################################################################
44-
# Build the Body List
45-
46-
body <- list(content = 'user',
47-
format = 'csv',
44+
# Build the Body List
45+
46+
body <- list(content = 'user',
47+
format = 'csv',
4848
returnFormat = 'csv')
4949

5050
##################################################################
51-
# API Call
51+
# API Call
5252
Users <- as.data.frame(makeApiCall(rcon, body, ...))
5353

54-
Users$forms_export <-
54+
Users$forms_export <-
5555
sub(",registration[:]\\d{1}.+$", "", Users$forms_export)
56-
56+
5757
##################################################################
58-
# convert expiration date to POSIXct class
58+
# convert expiration date to POSIXct class
5959
if (dates){
6060
Users$expiration <- as.POSIXct(Users$expiration, format="%Y-%m-%d")
61-
}
62-
61+
}
62+
6363
##################################################################
64-
# Convert user privileges to labels
65-
64+
# Convert user privileges to labels
65+
6666
if (labels){
6767
access_var <- REDCAP_USER_TABLE_ACCESS_VARIABLES # defined in redcapDataStructures.R
6868
# Just in case the variable names ever change
6969
access_var <- access_var[access_var %in% names(Users)]
70-
71-
Users[access_var] <-
72-
lapply(Users[access_var],
73-
.exportUsers_labels,
70+
71+
Users[access_var] <-
72+
lapply(Users[access_var],
73+
.exportUsers_labels,
7474
type = "project")
7575
}
76-
76+
7777
##################################################################
78-
# Establish columns for the form rights
78+
# Establish columns for the form rights
7979
if (form_rights){
80-
FormAccess <- .exportUsers_separateFormAccess(rcon = rcon,
81-
Users$forms,
80+
FormAccess <- .exportUsers_separateFormAccess(rcon = rcon,
81+
Users$forms,
8282
nrow = nrow(Users),
8383
export = FALSE)
84-
ExportAccess <- .exportUsers_separateFormAccess(rcon = rcon,
85-
form_access = Users$forms_export,
86-
nrow = nrow(Users),
84+
ExportAccess <- .exportUsers_separateFormAccess(rcon = rcon,
85+
form_access = Users$forms_export,
86+
nrow = nrow(Users),
8787
export = TRUE)
88-
Users <-
89-
cbind(Users,
90-
FormAccess,
88+
Users <-
89+
cbind(Users,
90+
FormAccess,
9191
ExportAccess)
92-
92+
9393
if (labels){
94-
Users[names(FormAccess)] <-
95-
lapply(Users[names(FormAccess)],
96-
.exportUsers_labels,
94+
Users[names(FormAccess)] <-
95+
lapply(Users[names(FormAccess)],
96+
.exportUsers_labels,
9797
type = "form")
98-
99-
Users[names(ExportAccess)] <-
100-
lapply(Users[names(ExportAccess)],
101-
.exportUsers_labels,
98+
99+
Users[names(ExportAccess)] <-
100+
lapply(Users[names(ExportAccess)],
101+
.exportUsers_labels,
102102
type = "form_export")
103103
}
104-
104+
105105
}
106-
106+
107107
Users
108108
}
109109

110110

111111
#####################################################################
112-
# Unexported
112+
# Unexported
113113

114114
.exportUsers_separateFormAccess <- function(rcon, form_access, nrow, export = FALSE){
115115
forms <- unique(rcon$metadata()$form_name)
116-
117-
FormAccess <- replicate(rep(NA_character_, nrow),
118-
n = length(forms),
116+
117+
FormAccess <- replicate(rep(NA_character_, nrow),
118+
n = length(forms),
119119
simplify = FALSE)
120120
FormAccess <- as.data.frame(FormAccess)
121-
names(FormAccess) <- sprintf("%s_%s_access",
121+
names(FormAccess) <- sprintf("%s_%s_access",
122122
forms,
123123
if (export) "export" else "form")
124-
124+
125125
for (i in seq_along(forms)){
126126
this_form <- forms[i]
127-
regex <- sprintf("^(|.+)(%s[:]\\d{1})(|.+)$",
127+
regex <- sprintf("^(|.+)(%s[:]\\d{1})(|.+)$",
128128
this_form)
129129
this_access <- sub(regex, "\\2", form_access)
130130
this_access[!grepl(this_form, this_access)] <- NA_character_
@@ -133,27 +133,34 @@ exportUsers.redcapApiConnection <- function(rcon,
133133
this_access <- trimws(this_access)
134134
FormAccess[[i]] <- as.numeric(this_access)
135135
}
136-
137-
FormAccess
136+
137+
FormAccess
138138
}
139139

140140
.exportUsers_labels <- function(x, type = c("project", "form", "form_export")){
141-
switch(type,
142-
"project" = factor(x,
143-
levels = 0:1,
144-
labels = c("No Access",
145-
"Access")),
146-
"form" = factor(x,
147-
levels = c(0, 2, 1, 3),
148-
labels = c("No Access",
149-
"Read Only",
150-
"View records/responses and edit records (survey responses are read-only)",
151-
"Edit survey responses")),
152-
"form_export" = factor(x,
153-
levels = c(0, 2, 3, 1),
154-
labels = c("No Access",
155-
"De-Identified",
156-
"Remove Identifier Fields",
141+
switch(type,
142+
"project" = factor(x,
143+
levels = 0:1,
144+
labels = c("No Access",
145+
"Access")),
146+
"form" = factor(x,
147+
levels = c(0, 128, 2, 129, 1, 130, 3, 138, 146, 154),
148+
labels = c("No Access",
149+
"No Access",
150+
"Read Only",
151+
"Read Only",
152+
"View survey responses and Edit records",
153+
"View survey responses and Edit records",
154+
"Edit survey responses and records",
155+
"Edit survey responses and records",
156+
"View survey responses and Edit or Delete records",
157+
"Edit or Delete Survey responses and records"
158+
)),
159+
"form_export" = factor(x,
160+
levels = c(0, 2, 3, 1),
161+
labels = c("No Access",
162+
"De-Identified",
163+
"Remove Identifier Fields",
157164
"Full Data Set")),
158165
identity())
159166
}

0 commit comments

Comments
 (0)