Merge pull request #139 from ljwoodley/create_delete_project

add delete_project

NAMESPACE

@@ -11,6 +11,7 @@ export(create_test_table)
 export(create_test_tables)
 export(dataframe_to_redcap_dictionary)
 export(dataset_diff)
+export(delete_project)
 export(disable_non_interactive_quit)
 export(enable_randomization_on_a_preconfigured_project_in_production)
 export(expire_user_project_rights)

R/delete_project.R

@@ -0,0 +1,105 @@
+#' Delete a Project from REDCap
+#'
+#' Deletes specified projects from the REDCap system by setting the `date_deleted` field.
+#' It will also log the event in the appropriate `log_event_table` for each project.
+#'
+#' @param project_id A project ID or vector of project IDs to be deleted.
+#' @param conn A DBI connection object to the database that holds the `redcap_projects`
+#'             and `redcap_log_event*` tables.
+#'
+#'
+#' @return A list containing:
+#' \itemize{
+#'   \item n: the number of projects deleted
+#'   \item number_rows_logged: the number of rows logged for the deletion event
+#'   \item project_ids_deleted: a vector of project IDs that were deleted
+#'   \item data: a data frame with each input project_id and its status after trying to delete it
+#' }
+#'
+#' @examples
+#' \dontrun{
+#' conn <- DBI::dbConnect(...)
+#' delete_project(c(1,2,3), conn)
+#' }
+#' @export
+
+delete_project <- function(project_id, conn) {
+
+  redcap_projects <- DBI::dbGetQuery(
+    conn,
+    sprintf(
+      "select
+        project_id,
+        date_deleted,
+        log_event_table
+     from redcap_projects
+     where project_id in (%s)",
+     paste0(project_id, collapse = ",")
+    )
+  )
+
+  # select projects for deletion
+  projects_to_delete <- redcap_projects[is.na(redcap_projects$date_deleted), ]
+  redcap_project_ids <- projects_to_delete$project_id
+  redcap_log_tables <- projects_to_delete$log_event_table
+
+  if (nrow(projects_to_delete) > 0) {
+    tryCatch({
+      deleted_projects <- DBI::dbExecute(
+        conn,
+        sprintf(
+          "update redcap_projects set date_deleted = now() where project_id in (%s)",
+          paste0(redcap_project_ids, collapse = ",")
+        )
+      )
+    }, error = function(error_message) {
+      print(error_message)
+      return(FALSE)
+    })
+
+    # log the event
+    tryCatch({
+      inserted_rows <- purrr::map2(
+        redcap_log_tables,
+        redcap_project_ids,
+        ~ DBI::dbExecute(
+          conn,
+          sprintf(
+            "insert into %s (object_type, event, project_id, description)
+             values ('redcap_projects', 'MANAGE', %d, 'delete project')",
+        .x,
+        .y)
+        )
+      )
+    }, error = function(error_message) {
+      print(error_message)
+      return(FALSE)
+    })
+  } else {
+    deleted_projects <- NULL
+    inserted_rows <- NULL
+    redcap_project_ids <- NULL
+  }
+
+  status_df <- data.frame(project_id = project_id)
+
+  # Assign status based on conditions
+  status_df$status <- ifelse(
+    !status_df$project_id %in% redcap_projects$project_id,
+    "does not exist",
+    ifelse(
+      status_df$project_id %in% projects_to_delete$project_id,
+      "deleted",
+      "previously deleted"
+    )
+  )
+
+  result <- list(
+    n = deleted_projects,
+    number_rows_logged = length(inserted_rows),
+    project_ids_deleted = redcap_project_ids,
+    data = status_df
+  )
+
+  return(result)
+}

tests/testthat/test-delete_project.R

@@ -0,0 +1,86 @@
+# create SQL tables
+redcap_projects <- data.frame(
+  project_id = 1:6,
+  date_deleted = c(rep(NA, 5), format(Sys.time() - 86400, "%Y-%m-%d %H:%M:%S")),
+  log_event_table = c(rep('redcap_log_event1', 3), rep('redcap_log_event2', 3))
+)
+
+redcap_log_event1 <- data.frame(
+  object_type = NA_character_,
+  event = NA_character_,
+  project_id = NA_integer_,
+  description = NA_character_
+)
+
+redcap_log_event2 <- data.frame(
+  object_type = NA_character_,
+  event = NA_character_,
+  project_id = NA_integer_,
+  description = NA_character_
+)
+
+# write SQL tables
+conn <- DBI::dbConnect(duckdb::duckdb(), dbname = ":memory:")
+DBI::dbWriteTable(conn, "redcap_projects", redcap_projects)
+DBI::dbWriteTable(conn, "redcap_log_event1", redcap_log_event1)
+DBI::dbWriteTable(conn, "redcap_log_event2", redcap_log_event2)
+
+# create comparison dfs
+expected_redcap_projects <- data.frame(
+  project_id = 1:6,
+  # convert to UTC to prevent test from failing due to timezone differences
+  date_deleted = c(rep(as.Date(lubridate::with_tz(Sys.time(), "UTC")), 5), Sys.Date() - 1),
+  log_event_table = c(rep('redcap_log_event1', 3), rep('redcap_log_event2', 3))
+)
+
+expected_redcap_log_event1 <- data.frame(
+  object_type = c(NA, rep("redcap_projects", 3)),
+  event = c(NA, rep("MANAGE", 3)),
+  project_id = c(NA, 1:3),
+  description =  c(NA, rep("delete project", 3))
+)
+
+expected_redcap_log_event2 <- data.frame(
+  object_type = c(NA, rep("redcap_projects", 2)),
+  event = c(NA, rep("MANAGE", 2)),
+  project_id =  c(NA, 4:5),
+  description = c(NA, rep("delete project", 2))
+)
+
+expected_result <- data.frame(
+  project_id = 1:8,
+  status = c(rep("deleted", 5), "previously deleted", rep("does not exist", 2))
+)
+
+# test function
+project_ids <- 1:8
+deleted_projects <- delete_project(project_ids, conn)
+
+testthat::test_that("delete_project deletes, updates and returns the correct project IDs", {
+  expect_equal(
+    DBI::dbGetQuery(conn, "select * from redcap_projects") |>
+      # convert date_deleted to yyyy-mm-dd to allow comparison with expected_redcap_projects
+      dplyr::mutate(date_deleted = as.Date(date_deleted)),
+    expected_redcap_projects
+  )
+
+  testthat::expect_equal(
+    DBI::dbGetQuery(conn, "select * from redcap_log_event1"),
+    expected_redcap_log_event1
+  )
+  testthat::expect_equal(
+    DBI::dbGetQuery(conn, "select * from redcap_log_event2"),
+    expected_redcap_log_event2
+  )
+
+  testthat::expect_equal(deleted_projects$n, 5)
+
+  testthat::expect_equal(deleted_projects$number_rows_logged, 5)
+
+  testthat::expect_equal(deleted_projects$project_ids_deleted, 1:5)
+
+  testthat::expect_equal(deleted_projects$data, expected_result)
+
+})
+
+DBI::dbDisconnect(conn)