add parameter for arms

I'll add guard rails in a sec.

ref #372

R/project-delete-multiple-arm.R

@@ -0,0 +1,112 @@
+# These functions are not exported.
+
+populate_project_delete_multiple_arm <- function() {
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_multiple_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+
+  credential  <- retrieve_credential_testing(2627L)
+
+  project <- REDCapR::redcap_project$new(
+    redcap_uri    = credential$redcap_uri,
+    token         = credential$token
+  )
+  path_in <- system.file(
+    "test-data/delete-multiple-arm/delete-multiple-arm-data.csv",
+    package = "REDCapR"
+  )
+
+  # Write the file to disk (necessary only when you wanted to change the data).  Don't uncomment; just run manually.
+  # returned_object <- redcap_read_oneshot(redcap_uri=uri, token=token, raw_or_label="raw")
+  # utils::write.csv(returned_object$data, file="./inst/test-data/project-delete_multiple_arm/delete_multiple_arm-data.csv", row.names=FALSE)
+  # returned_object_metadata <- redcap_metadata_read(redcap_uri=uri, token=token)
+  # utils::write.csv(returned_object_metadata$data, file="./inst/test-data/project-delete_multiple_arm/delete_multiple_arm-metadata.csv", row.names=FALSE)
+
+  # Read in the data in R's memory from a csv file.
+  ds_to_write <-
+    readr::read_csv(
+      path_in,
+      show_col_types = FALSE
+    )
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/delete-multiple-arm/delete-multiple-arm-data.csv")
+
+  # Import the data into the REDCap project
+  testthat::expect_message(
+    returned_object <- REDCapR::redcap_write(
+      ds          = ds_to_write,
+      redcap_uri  = project$redcap_uri,
+      token       = project$token,
+      verbose     = TRUE
+    )
+  )
+
+  # Print a message and return a boolean value
+  base::message(base::sprintf(
+    "populate_project_delete_multiple_arm success: %s.",
+    returned_object$success
+  ))
+  list(is_success = returned_object$success, redcap_project = project)
+}
+clear_project_delete_multiple_arm <- function(verbose = TRUE) {
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_multiple_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+  path_delete_test_record <-
+    "https://bbmc.ouhsc.edu/redcap/plugins/redcapr/delete_redcapr_delete_multiple_arm.php"
+
+  # Returns a boolean value if successful
+  was_successful <- !httr::http_error(path_delete_test_record)
+
+  # Print a message and return a boolean value
+  if (verbose) {
+    base::message(base::sprintf(
+      "clear_project_delete_multiple_arm success: %s.",
+      was_successful
+    ))
+  }
+
+  was_successful
+}
+
+clean_start_delete_multiple_arm <- function(delay_in_seconds = 1) {
+  checkmate::assert_numeric(delay_in_seconds, any.missing=FALSE, len=1, lower=0)
+
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_delete_multiple_arm() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+  testthat::expect_message(
+    clear_result <- clear_project_delete_multiple_arm(),
+    regexp = "clear_project_delete_multiple_arm success: TRUE."
+  )
+  testthat::expect_true(clear_result, "Clearing the results from the delete_multiple_arm project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after deleting records.
+
+  testthat::expect_message(
+    populate_result <- populate_project_delete_multiple_arm(),
+    regexp = "populate_project_delete_multiple_arm success: TRUE."
+  )
+  testthat::expect_true(populate_result$is_success, "Population of the delete_multiple_arm project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after writing records.
+
+  populate_result
+}
+
+# populate_project_delete_multiple_arm()
+# clear_project_delete_multiple_arm()
+# clean_start_delete_multiple_arm()
+# clean_start_delete_multiple_arm(batch = TRUE)

R/redcap-delete.R

@@ -8,6 +8,11 @@
 #' project.  Required.
 #' @param records_to_delete A character vector of the project's `record_id`
 #' values to delete.  Required.
+#' @param arm_of_records_to_delete A single integer reflecting the arm
+#' containing the records to be deleted.  If the REDCap project has multiple
+#' arms and no value is passed, then all arms are cleared of the
+#' specified `record_id`s.  Leave it as NULL if the project has no arms and
+#' is not longitudinal.
 #' @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
@@ -60,13 +65,15 @@ redcap_delete <- function(
   redcap_uri,
   token,
   records_to_delete,
+  arm_of_records_to_delete = NULL,
   verbose         = TRUE,
   config_options  = NULL
 ) {
 
   checkmate::assert_character(redcap_uri, any.missing=FALSE, len=1, pattern="^.{1,}$")
   checkmate::assert_character(token     , any.missing=FALSE, len=1, pattern="^.{1,}$")
   checkmate::assert_vector(records_to_delete, any.missing = FALSE, min.len = 1)
+  checkmate::assert_integer(arm_of_records_to_delete, any.missing=FALSE, null.ok = TRUE, len=1, lower = 1)
 
   token   <- sanitize_token(token)
   verbose <- verbose_prepare(verbose)
@@ -86,12 +93,21 @@ redcap_delete <- function(
       sprintf("records[%i]", seq_along(records_to_delete) - 1)
     )
 
+  arm_list <-
+    if (is.null(arm_of_records_to_delete)) {
+      NULL # A null object here is essentially ignored when constructing `post_body` below.
+    } else {
+      list(arm = arm_of_records_to_delete)
+    }
+
+
   post_body <- c(
     list(
       token     = token,
       content   = "record",
       action    = "delete"
     ),
+    arm_list,
     records_to_delete
   )
 

inst/test-data/delete-multiple-arm/delete-multiple-arm-data.csv

@@ -0,0 +1,61 @@
+record_id,redcap_event_name,birth_date,position,demographics_complete
+101,event_1_arm_1,2020-05-01,pg,2
+102,event_1_arm_1,2020-06-01,sg,2
+103,event_1_arm_1,2020-07-01,sf,2
+104,event_1_arm_1,2020-08-01,pf,2
+105,event_1_arm_1,2020-09-01,c,2
+106,event_1_arm_1,2020-10-01,pg,2
+107,event_1_arm_1,2020-11-01,sg,2
+108,event_1_arm_1,2020-12-01,sf,2
+109,event_1_arm_1,2021-01-01,pf,2
+110,event_1_arm_1,2021-02-01,c,2
+111,event_1_arm_1,2021-03-01,pg,2
+112,event_1_arm_1,2021-04-01,sg,2
+113,event_1_arm_1,2021-05-01,sf,2
+114,event_1_arm_1,2021-06-01,pf,2
+115,event_1_arm_1,2021-07-01,c,2
+116,event_1_arm_1,2021-08-01,pg,2
+117,event_1_arm_1,2021-09-01,sg,2
+118,event_1_arm_1,2021-10-01,sf,2
+119,event_1_arm_1,2021-11-01,pf,2
+120,event_1_arm_1,2021-12-01,c,2
+101,event_1_arm_2,2020-05-01,pg,2
+102,event_1_arm_2,2020-06-01,sg,2
+103,event_1_arm_2,2020-07-01,sf,2
+104,event_1_arm_2,2020-08-01,pf,2
+105,event_1_arm_2,2020-09-01,c,2
+106,event_1_arm_2,2020-10-01,pg,2
+107,event_1_arm_2,2020-11-01,sg,2
+108,event_1_arm_2,2020-12-01,sf,2
+109,event_1_arm_2,2021-01-01,pf,2
+110,event_1_arm_2,2021-02-01,c,2
+111,event_1_arm_2,2021-03-01,pg,2
+112,event_1_arm_2,2021-04-01,sg,2
+113,event_1_arm_2,2021-05-01,sf,2
+114,event_1_arm_2,2021-06-01,pf,2
+115,event_1_arm_2,2021-07-01,c,2
+116,event_1_arm_2,2021-08-01,pg,2
+117,event_1_arm_2,2021-09-01,sg,2
+118,event_1_arm_2,2021-10-01,sf,2
+119,event_1_arm_2,2021-11-01,pf,2
+120,event_1_arm_2,2021-12-01,c,2
+101,event_1_arm_3,2020-05-01,pg,2
+102,event_1_arm_3,2020-06-01,sg,2
+103,event_1_arm_3,2020-07-01,sf,2
+104,event_1_arm_3,2020-08-01,pf,2
+105,event_1_arm_3,2020-09-01,c,2
+106,event_1_arm_3,2020-10-01,pg,2
+107,event_1_arm_3,2020-11-01,sg,2
+108,event_1_arm_3,2020-12-01,sf,2
+109,event_1_arm_3,2021-01-01,pf,2
+110,event_1_arm_3,2021-02-01,c,2
+111,event_1_arm_3,2021-03-01,pg,2
+112,event_1_arm_3,2021-04-01,sg,2
+113,event_1_arm_3,2021-05-01,sf,2
+114,event_1_arm_3,2021-06-01,pf,2
+115,event_1_arm_3,2021-07-01,c,2
+116,event_1_arm_3,2021-08-01,pg,2
+117,event_1_arm_3,2021-09-01,sg,2
+118,event_1_arm_3,2021-10-01,sf,2
+119,event_1_arm_3,2021-11-01,pf,2
+120,event_1_arm_3,2021-12-01,c,2

inst/test-data/specific-redcapr/delete/multiple-arm-four-records.R

@@ -0,0 +1,35 @@
+structure(list(record_id = c(101, 101, 101, 102, 102, 103, 103, 
+104, 104, 104, 105, 105, 106, 106, 106, 107, 107, 107, 108, 108, 
+108, 109, 109, 109, 110, 110, 110, 111, 111, 111, 112, 112, 112, 
+113, 113, 113, 114, 114, 114, 115, 115, 115, 116, 116, 116, 117, 
+117, 117, 118, 118, 118, 119, 119, 119, 120, 120), redcap_event_name = c("event_1_arm_1", 
+"event_1_arm_2", "event_1_arm_3", "event_1_arm_1", "event_1_arm_3", 
+"event_1_arm_1", "event_1_arm_3", "event_1_arm_1", "event_1_arm_2", 
+"event_1_arm_3", "event_1_arm_1", "event_1_arm_3", "event_1_arm_1", 
+"event_1_arm_2", "event_1_arm_3", "event_1_arm_1", "event_1_arm_2", 
+"event_1_arm_3", "event_1_arm_1", "event_1_arm_2", "event_1_arm_3", 
+"event_1_arm_1", "event_1_arm_2", "event_1_arm_3", "event_1_arm_1", 
+"event_1_arm_2", "event_1_arm_3", "event_1_arm_1", "event_1_arm_2", 
+"event_1_arm_3", "event_1_arm_1", "event_1_arm_2", "event_1_arm_3", 
+"event_1_arm_1", "event_1_arm_2", "event_1_arm_3", "event_1_arm_1", 
+"event_1_arm_2", "event_1_arm_3", "event_1_arm_1", "event_1_arm_2", 
+"event_1_arm_3", "event_1_arm_1", "event_1_arm_2", "event_1_arm_3", 
+"event_1_arm_1", "event_1_arm_2", "event_1_arm_3", "event_1_arm_1", 
+"event_1_arm_2", "event_1_arm_3", "event_1_arm_1", "event_1_arm_2", 
+"event_1_arm_3", "event_1_arm_1", "event_1_arm_3"), birth_date = structure(c(18383, 
+18383, 18383, 18414, 18414, 18444, 18444, 18475, 18475, 18475, 
+18506, 18506, 18536, 18536, 18536, 18567, 18567, 18567, 18597, 
+18597, 18597, 18628, 18628, 18628, 18659, 18659, 18659, 18687, 
+18687, 18687, 18718, 18718, 18718, 18748, 18748, 18748, 18779, 
+18779, 18779, 18809, 18809, 18809, 18840, 18840, 18840, 18871, 
+18871, 18871, 18901, 18901, 18901, 18932, 18932, 18932, 18962, 
+18962), class = "Date"), position = c("pg", "pg", "pg", "sg", 
+"sg", "sf", "sf", "pf", "pf", "pf", "c", "c", "pg", "pg", "pg", 
+"sg", "sg", "sg", "sf", "sf", "sf", "pf", "pf", "pf", "c", "c", 
+"c", "pg", "pg", "pg", "sg", "sg", "sg", "sf", "sf", "sf", "pf", 
+"pf", "pf", "c", "c", "c", "pg", "pg", "pg", "sg", "sg", "sg", 
+"sf", "sf", "sf", "pf", "pf", "pf", "c", "c"), demographics_complete = c(2, 
+2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 
+2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 
+2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)), row.names = c(NA, -56L
+), class = "data.frame")

tests/testthat/test-delete.R

@@ -46,6 +46,53 @@ test_that("single-arm-four-records", {
   expect_true(returned_object2$success)
 })
 
+test_that("multiple-arm-four-records", {
+  testthat::skip_on_cran()
+  skip_if_onlyread()
+
+  path_expected <- "test-data/specific-redcapr/delete/multiple-arm-four-records.R"
+  start_clean_result <- REDCapR:::clean_start_delete_multiple_arm()
+  project <- start_clean_result$redcap_project
+
+  arm <- 2L
+  records_to_delete <- c(102, 103, 105, 120)
+
+  expected_outcome_message <- "\\d+ records were deleted from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+  expect_message(
+    returned_object1 <-
+      redcap_delete(
+        redcap_uri        = project$redcap_uri,
+        token             = project$token,
+        records_to_delete = records_to_delete,
+        arm_of_records_to_delete = arm
+      ),
+    regexp = expected_outcome_message
+  )
+
+  expect_equal(returned_object1$status_code, expected=200L)
+  expect_equal(returned_object1$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+  expect_match(returned_object1$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_equal(returned_object1$records_affected_count, length(records_to_delete))
+  expect_true( returned_object1$success)
+
+  expected_outcome_message <- "\\d+ records and \\d+ columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+  expect_message(
+    returned_object2 <- redcap_read_oneshot(redcap_uri=project$redcap_uri, token=project$token),
+    regexp = expected_outcome_message
+  )
+
+  if (update_expectation) save_expected(returned_object2$data, path_expected)
+  expected_data_frame <- retrieve_expected(path_expected)
+
+  expect_equal(returned_object2$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) #returned_object2$data$bmi<-NULL; returned_object2$data$age<-NULL;dput(returned_object2$data)
+  expect_equal(returned_object2$status_code, expected=200L)
+  expect_equal(returned_object2$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object2$raw_text)
+  expect_true(returned_object2$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object2$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_match(returned_object2$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object2$success)
+})
+
 test_that("no-delete-permissions", {
   testthat::skip_on_cran()
   skip_if_onlyread()

utility/plugins/wipe-project-delete-multiple-arm.php

@@ -0,0 +1,45 @@
+<?php
+
+/** 
+* PLUGIN NAME: Insert Unit Test Cleanup 
+* DESCRIPTION: delete redcap record inserted by a REDCapR unit test 
+* VERSION: 1.0 
+* AUTHOR: Will Beasley, OUHSC, BBMC 
+*/ 
+
+// Prevent caching; this code is copied from /redcap/api/index.php 
+header("Expires: 0"); 
+header("cache-control: no-store, no-cache, must-revalidate"); 
+header("Pragma: no-cache"); 
+
+// Disable REDCap's authentication 
+define("NOAUTH", true); 
+
+// Call the REDCap Connect file in the main "redcap" directory 
+require_once "../../redcap_connect.php"; 
+
+// OPTIONAL: Your custom PHP code goes here. You may use any constants/variables listed in redcap_info(). 
+
+// OPTIONAL: Display the header 
+$HtmlPage = new HtmlPage(); 
+$HtmlPage->PrintHeaderExt(); 
+
+// Your HTML page content goes here 
+?> 
+
+<h3 style="color:#800000;"> 
+       DELETE Records from multiple-arm for deleting REDCapR Test Project 
+</h3> 
+<p> 
+       This is an example plugin page that has REDCap's <b>authentication disabled</b>. 
+       So no one will be forced to login to this page because it is fully public and available to the web (supposing this 
+       web server isn't locked down behind a firewall). 
+</p> 
+<?php 
+
+// Change '-666' to the project you want to wipe out.
+db_query("DELETE FROM redcapv3.redcap_data WHERE project_id=-666;"); 
+
+// OPTIONAL: Display the footer 
+$HtmlPage->PrintFooterExt(); 
+?>

utility/refresh.R

@@ -35,7 +35,7 @@ devtools::run_examples(); #dev.off() #This overwrites the NAMESPACE file too
 # pkgload::load_all()
 test_results_checked <- devtools::test()
 test_results_checked <- devtools::test(filter = "column")
-test_results_checked <- devtools::test(filter = "write-dag")
+test_results_checked <- devtools::test(filter = "delete")
 withr::local_envvar(ONLYREADTESTS = "true")
 test_results_checked <- devtools::test(filter = "write-batch")