starting scaffolding for DAG tests

ref #353

R/project-dag-write.R

@@ -0,0 +1,167 @@
+# These functions are not exported.
+
+populate_project_dag_write <- function(batch = FALSE) {
+  checkmate::assert_logical(batch, any.missing = FALSE, len = 1)
+
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_dag_write() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+
+  credential  <- retrieve_credential_testing(2545L)
+
+  project <- REDCapR::redcap_project$new(
+    redcap_uri    = credential$redcap_uri,
+    token         = credential$token
+  )
+  path_in_dag <- system.file(
+    "test-data/project-dag/dag-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-dag/dag-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-dag/dag-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_dag,
+      show_col_types = FALSE
+    )
+  # ds_to_write <- utils::read.csv(file="./inst/test-data/project-dag/dag-data.csv", stringsAsFactors=FALSE)
+
+  # Remove the calculated variables.
+  ds_to_write$last_name <- NULL
+  # ds_to_write$bmi <- NULL
+
+  # Import the data into the REDCap project
+  testthat::expect_message(
+    returned_object <- if (batch) {
+      REDCapR::redcap_write(
+        ds          = ds_to_write,
+        redcap_uri  = project$redcap_uri,
+        token       = project$token,
+        verbose     = TRUE,
+        convert_logical_to_integer = TRUE
+      )
+    } else {
+      REDCapR::redcap_write_oneshot(
+        ds          = ds_to_write,
+        redcap_uri  = project$redcap_uri,
+        token       = project$token,
+        verbose     = TRUE,
+        convert_logical_to_integer = TRUE
+      )
+    }
+  )
+
+  # If uploading the data was successful, then upload the image files.
+  if (returned_object$success) {
+    upload_file_dag(
+      redcap_uri    = project$redcap_uri,
+      token         = project$token
+    )
+  }
+
+  # Print a message and return a boolean value
+  base::message(base::sprintf(
+    "populate_project_dag_write success: %s.",
+    returned_object$success
+  ))
+  list(is_success = returned_object$success, redcap_project = project)
+}
+clear_project_dag_write <- function(verbose = TRUE) {
+  if (!requireNamespace("testthat")) {
+    # nocov start
+    stop(
+      "The function REDCapR:::populate_project_dag_write() 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_dag_write.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_dag_write success: %s.",
+      was_successful
+    ))
+  }
+
+  was_successful
+}
+
+clean_start_dag_write <- function(batch = FALSE, delay_in_seconds = 1) {
+  checkmate::assert_logical(batch           , any.missing=FALSE, len=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_dag_write() cannot run if the ",
+      "`testthat` package is not installed.  Please install it and try again."
+    )
+    # nocov end
+  }
+  testthat::expect_message(
+    clear_result <- clear_project_dag_write(),
+    regexp = "clear_project_dag_write success: TRUE."
+  )
+  testthat::expect_true(clear_result, "Clearing the results from the dag_write project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after deleting records.
+
+  testthat::expect_message(
+    populate_result <- populate_project_dag_write(batch = batch),
+    regexp = "populate_project_dag_write success: TRUE."
+  )
+  testthat::expect_true(populate_result$is_success, "Population of the dag_write project should be successful.")
+  base::Sys.sleep(delay_in_seconds) #Pause after writing records.
+
+  populate_result
+}
+
+upload_file_dag_write <- function(redcap_uri, token = token) {
+  checkmate::assert_character(redcap_uri, any.missing=FALSE, len=1, min.chars = 5)
+  checkmate::assert_character(token     , any.missing=FALSE, len=1, pattern="^\\w{32}$")
+
+  records <- 1:5
+  file_paths <- system.file(
+    paste0("test-data/mugshot-", records, ".jpg"),
+    package = "REDCapR"
+  )
+
+  field <- "mugshot"
+  # event <- "" # only for longitudinal events
+
+  token <- sanitize_token(token)
+
+  for (i in seq_along(records)) {
+    record    <- records[i]
+    file_path <- file_paths[i]
+    redcap_upload_file_oneshot(
+      file_name   = file_path,
+      record      = record,
+      field       = field,
+      redcap_uri  = redcap_uri,
+      token       = token
+    )
+  }
+}
+
+# populate_project_dag_write()
+# populate_project_dag_write(batch = TRUE)
+# clear_project_dag_write()
+# clean_start_dag_write()
+# clean_start_dag_write(batch = TRUE)

R/project-simple.R

@@ -126,7 +126,7 @@ clean_start_simple <- function(batch = FALSE, delay_in_seconds = 1) {
     populate_result <- populate_project_simple(batch = batch),
     regexp = "populate_project_simple success: TRUE."
   )
-  testthat::expect_true(populate_result$is_success, "Population the the simple project should be successful.")
+  testthat::expect_true(populate_result$is_success, "Population of the simple project should be successful.")
   base::Sys.sleep(delay_in_seconds) #Pause after writing records.
 
   populate_result

inst/misc/example.credentials

@@ -15,8 +15,9 @@ redcap_uri,username,project_id,token,comment
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","977","F304DEC3793FECC3B6DEEFF66302CAD3","Clinical Trial (Fake) --Read-only, contributed by @higgi13425"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","0","---","Clinical Trial (Fake) --read & write, contributed by @higgi13425"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","998","124CA60A870CAA85394FE9E00EB8EFE7","nonnumeric record_id"
-"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","DAG"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","999","06DEFB601F9B46847DAA9DF0CFA951B4","DAG Read"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1396","14A41597332864D74460CBBF52EE49A6","potentially problematic values"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1400","F187271FC6FD72C3BFCE37990A6BF6A7","Repeating Instruments"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1425","221E86DABFEEA233067C6889991B7FBB","Potentially problematic dictionary"
 "https://bbmc.ouhsc.edu/redcap/api/","myusername","1490","457C24AB91B7FCF5B1A7DA67E70E24C7","simple write metadata"
+"https://bbmc.ouhsc.edu/redcap/api/","myusername","2545","0BF11B9CB01F0B8F8EE203B7E07DEFD9","DAG Write"

tests/testthat/test-read-dag.R

@@ -0,0 +1,41 @@
+library(testthat)
+
+credential  <- retrieve_credential_testing(999L)
+update_expectation  <- FALSE
+
+test_that("smoke test", {
+  testthat::skip_on_cran()
+  expect_message(
+    returned_object <- redcap_read_oneshot(redcap_uri=credential$redcap_uri, token=credential$token)
+  )
+})
+test_that("default", {
+  testthat::skip_on_cran()
+  path_expected <- "test-data/specific-redcapr/read-clinical-trial/default.R"
+  expected_outcome_message <- "500 records and 13 columns were read from REDCap in \\d+(\\.\\d+\\W|\\W)seconds\\."
+
+  expect_message(
+    regexp           = expected_outcome_message,
+    returned_object <-
+      redcap_read_oneshot(
+        redcap_uri                = credential$redcap_uri,
+        token                     = credential$token,
+        guess_type                = FALSE,
+        export_data_access_groups = TRUE
+      )
+  )
+
+  if (update_expectation) save_expected(returned_object$data, path_expected)
+  expected_data_frame <- retrieve_expected(path_expected)
+
+  expect_equal(returned_object$data, expected=expected_data_frame, label="The returned data.frame should be correct", ignore_attr = TRUE) # dput(returned_object$data)
+  expect_equal(returned_object$status_code, expected=200L)
+  expect_equal(returned_object$raw_text, expected="", ignore_attr = TRUE) # dput(returned_object$raw_text)
+  expect_true(returned_object$records_collapsed=="", "A subset of records was not requested.")
+  expect_true(returned_object$fields_collapsed=="", "A subset of fields was not requested.")
+  expect_true(returned_object$filter_logic=="", "A filter was not specified.")
+  expect_match(returned_object$outcome_message, regexp=expected_outcome_message, perl=TRUE)
+  expect_true(returned_object$success)
+})
+
+rm(credential)

utility/plugins/wipe-project-dag.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 DAG-write 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(); 
+?>