Merge pull request #475 from vubiostat/issue-474-forms

clean up user import form validation

Author: spgarbet

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: redcapAPI
 Type: Package
 Title: Interface to 'REDCap'
-Version: 2.11.4
+Version: 2.11.5
 Authors@R: c(
     person("Benjamin", "Nutter", email = "benjamin.nutter@gmail.com", 
            role = c("ctb", "aut")),

NEWS.md

@@ -7,6 +7,10 @@ A future release of version 3.0.0 will introduce several breaking changes!
 * The `redcapFactor` class is being discontinued with all its supporting methods (including `redcapFactorFlip`). Please use `recastRecords` instead.
 * The `recodeCheck` function is being discontinued. Please use `recastRecords` instead.
 
+## 2.11.5
+
+* Deleted functions `prepUserImportData_validateAllFormsPresent` and `prepUserImportData_extractFormName`.
+
 ## 2.11.4
 
 * Updated to allow for `project_pi_email` as an allowed field of project info.

R/prepUserImportData.R

@@ -80,29 +80,27 @@ prepUserImportData <- function(data,
 
   checkmate::reportAssertions(coll)
 
-  primary_fields <- names(data)
-  primary_fields <- primary_fields[!grepl("(_export_access|_form_access)$", 
-                                          primary_fields)]
-  
+  all_fields <- names(data)
+  form_access_field <- grep('_form_access$', all_fields, value = TRUE)
+  export_access_field <- grep('_export_access$', all_fields, value = TRUE)
+  primary_fields <- setdiff(all_fields, c(form_access_field, export_access_field))
+
   checkmate::assert_subset(x = primary_fields, 
                            choices = c(if (user_role) names(redcapUserRoleStructure(rcon$version())) else names(redcapUserStructure(rcon$version())), 
                                        "data_export"), 
                            add = coll)
 
   checkmate::reportAssertions(coll)
-  
-  form_access_field <- names(data)[grepl("_form_access$", names(data))]
-  export_access_field <- names(data)[grepl("_export_access$", names(data))]
-  instrument <- rcon$instruments()$instrument_name
-  
-  prepUserImportData_validateAllFormsPresent(data = data, 
-                                             form_access_field = form_access_field, 
-                                             export_access_field = export_access_field, 
-                                             instrument = instrument,
-                                             consolidate = consolidate, 
-                                             coll = coll)
-  
-  checkmate::reportAssertions(coll)
+
+  # Prior to redcapAPI version 2.11.5, functionality surrounding form validation
+  # did not work properly. See GH issue #474.
+  # Specifically user permissions for forms and forms export were checked against
+  # the list of all instruments. The prior design was to generate an error
+  # if one of the instruments was not present.
+  # The current design is to let REDCap API handle the missing instruments,
+  # which will set the permissions to "No Access".
+  # The functions "prepUserImportData_validateAllFormsPresent" and
+  # "prepUserImportData_extractFormName" were removed with this change.
 
   ###################################################################
   # Functional Code                                              ####
@@ -119,7 +117,7 @@ prepUserImportData <- function(data,
   fields_to_remove <- c("email", "lastname", "firstname", 
                         "data_access_group_id")
   data <- data[!names(data) %in% fields_to_remove]
-  
+
   # Convert values to numeric
 
   for (nm in names(data)){
@@ -200,55 +198,3 @@ prepUserImportData_consolidateAccess <- function(d, suffix){
 
   apply(d, MARGIN = 1, FUN = paste0, collapse = ",")
 }
-
-prepUserImportData_extractFormName <- function(x, instrument){
-  forms <- strsplit(x, ",")
-  forms <- lapply(forms, 
-                  function(f) sub("[:].+$", "", f))
-  
-  instrument_present <- logical(length(instrument))
-  
-  for (i in seq_along(instrument_present)){
-    instrument_present[i] <- 
-      all(vapply(forms, function(f) instrument[i] %in% forms[[i]], logical(1)))
-  }
-  
-  instrument[instrument_present]
-}
-
-prepUserImportData_validateAllFormsPresent <- function(data, 
-                                                       form_access_field, 
-                                                       export_access_field, 
-                                                       instrument,
-                                                       consolidate, 
-                                                       coll){
-  # If consolidating, we need to make sure that all of the forms are present
-  # in both form access and data export access.
-  if (consolidate){
-    form_access_forms <- sub("_form_access$", "", form_access_field)
-    export_access_forms <- sub("_export_access$", "", export_access_field)
-  }
-  
-  # if not consolidating forms, we need to make sure all of the forms are 
-  # represented in the standard format
-  
-  if (!consolidate){
-    form_access_forms <- prepUserImportData_extractFormName(data$forms, instrument)
-    export_access_forms <- prepUserImportData_extractFormName(data$forms_export, instrument)
-  }
-  
-  all_form_access <- all(form_access_forms %in% instrument)
-  all_export_access <- all(export_access_forms %in% instrument)
-  
-  if (!all_form_access){
-    msg <- sprintf("At least one user is missing an entry for the form(s): %s", 
-                   paste0(setdiff(instrument, all_form_access), collapse = ", "))
-    coll$push(msg)
-  }
-  
-  if (!all_export_access){
-    msg <- sprintf("At least one user is missing an export entry for the form(s): %s", 
-                   paste0(setdiff(instrument, all_export_access), collapse = ", "))
-    coll$push(msg)
-  }
-}

tests/testthat/test-101-userMethods-Functionality.R

@@ -82,12 +82,14 @@ test_that(
                 data = data.frame(username = EXPENDABLE_USER,
                                   data_export = 1,
                                   forms = c("record_id:0"),
-                                  forms_export = "record_id:0"),
+	# leaving an instrument off implicitly sets permission to 0
+                                  forms_export = ""),
                 consolidate = FALSE)
 
     Users <- exportUsers(rcon)
     Users <- Users[Users$username %in% EXPENDABLE_USER, ]
     expect_true(grepl("record_id:0",Users$forms))
+    expect_true(grepl("record_id:0",Users$forms_export))
   }
 )