initial draft of project info read

ref #410

NAMESPACE

@@ -21,6 +21,7 @@ export(redcap_metadata_read)
 export(redcap_metadata_write)
 export(redcap_next_free_record_name)
 export(redcap_project)
+export(redcap_project_info_read)
 export(redcap_read)
 export(redcap_read_oneshot)
 export(redcap_report)

R/redcap-project-info-read.R

@@ -0,0 +1,207 @@
+#' @title Export project information.
+#'
+#' @description This function exports some of the basic attributes of a given
+#' REDCap project, such as the project's title, if it is longitudinal,
+#' if surveys are enabled, the time the project was created and moved to
+#' production.  Returns a [tibble::tibble()].
+#'
+#' @param redcap_uri The
+#' [uri](https://en.wikipedia.org/wiki/Uniform_Resource_Identifier)/url
+#' of the REDCap server
+#' typically formatted as "https://server.org/apps/redcap/api/".
+#' Required.
+#' @param token The user-specific string that serves as the password for a
+#' project.  Required.
+#' @param http_response_encoding  The encoding value passed to
+#' [httr::content()].  Defaults to 'UTF-8'.
+#' @param locale a [readr::locale()] object to specify preferences like
+#' number, date, and time formats.  This object is passed to
+#' [`readr::read_csv()`].  Defaults to [readr::default_locale()].
+#' @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
+#' be visible somewhere public. Optional.
+#' @param config_options  A list of options to pass to `POST` method in the
+#' `httr` package.
+#'
+#' @return Currently, a list is returned with the following elements:
+#' * `data`: An R [tibble::tibble()] of all data access groups of the project.
+#' * `success`: A boolean value indicating if the operation was apparently
+#' successful.
+#' * `status_codes`: A collection of
+#' [http status codes](https://en.wikipedia.org/wiki/List_of_HTTP_status_codes),
+#' separated by semicolons.  There is one code for each batch attempted.
+#' * `outcome_messages`: A collection of human readable strings indicating the
+#' operations' semicolons.  There is one code for each batch attempted.  In an
+#' unsuccessful operation, it should contain diagnostic information.
+#' * `elapsed_seconds`: The duration of the function.
+#'
+#' @author Will Beasley, Stephan Kadauke
+#' @references The official documentation can be found on the 'API Help Page'
+#' and 'API Examples' pages on the REDCap wiki (*i.e.*,
+#' https://community.projectredcap.org/articles/456/api-documentation.html
+#' and
+#' https://community.projectredcap.org/articles/462/api-examples.html).
+#' If you do not have an account for the wiki, please ask your campus REDCap
+#' administrator to send you the static material.
+#'
+#' @examples
+#' \dontrun{
+#' uri                  <- "https://bbmc.ouhsc.edu/redcap/api/"
+#' token_simple         <- "9A81268476645C4E5F03428B8AC3AA7B"
+#' token_longitudinal   <- "0434F0E9CF53ED0587847AB6E51DE762"
+#'
+#' d1 <- REDCapR::redcap_project_info_read(uri, token_simple      )$data
+#' View(d1)
+#'
+#' d2 <- REDCapR::redcap_project_info_read(uri, token_longitudinal)$data
+#' View(d2)
+#'
+#'
+#' # Stack all the projects on top of each other in a (nested) tibble
+#' #   (starting from a csv of REDCapR test projects).
+#' d_all <-
+#'   system.file("misc/example.credentials", package = "REDCapR") |>
+#'   readr::read_csv(
+#'     comment     = "#",
+#'     col_select  = c(redcap_uri, token),
+#'     col_types   = readr::cols(.default = readr::col_character())
+#'   ) |>
+#'   dplyr::filter(32L == nchar(token)) |>
+#'   purrr::pmap_dfr(REDCapR::redcap_project_info_read)
+#'
+#' # Inspect values stored on the server.
+#' View(d_all$data)
+#'
+#' # Inspect everything returned, including values like the http status code.
+#' View(d_all)
+#' }
+
+#' @export
+redcap_project_info_read <- function(
+  redcap_uri,
+  token,
+  http_response_encoding        = "UTF-8",
+  locale                        = readr::default_locale(),
+  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_character(http_response_encoding    , any.missing=FALSE,   len = 1)
+  checkmate::assert_class(    locale, classes = "locale", null.ok = FALSE)
+  checkmate::assert_logical(  verbose                   , any.missing=FALSE,   len = 1, null.ok = TRUE)
+  checkmate::assert_list(     config_options            , any.missing=TRUE ,            null.ok = TRUE)
+
+  token               <- sanitize_token(token)
+  verbose             <- verbose_prepare(verbose)
+
+  post_body <- list(
+    token                   = token,
+    content                 = "project",
+    format                  = "csv"
+  )
+
+  # This is the important line that communicates with the REDCap server.
+  kernel <- kernel_api(
+    redcap_uri      = redcap_uri,
+    post_body       = post_body,
+    config_options  = config_options,
+    encoding        = http_response_encoding
+  )
+
+  col_types <- readr::cols(
+    project_id                              = readr::col_integer(),
+    project_title                           = readr::col_character(),
+    creation_time                           = readr::col_datetime(format = ""),
+    production_time                         = readr::col_datetime(format = ""),
+    in_production                           = readr::col_logical(),
+    project_language                        = readr::col_character(),
+    purpose                                 = readr::col_integer(),
+    purpose_other                           = readr::col_character(),
+    project_notes                           = readr::col_character(),
+    custom_record_label                     = readr::col_logical(),
+    secondary_unique_field                  = readr::col_logical(),
+    is_longitudinal                         = readr::col_logical(),
+    has_repeating_instruments_or_events     = readr::col_logical(),
+    surveys_enabled                         = readr::col_logical(),
+    scheduling_enabled                      = readr::col_logical(),
+    record_autonumbering_enabled            = readr::col_logical(),
+    randomization_enabled                   = readr::col_logical(),
+    ddp_enabled                             = readr::col_logical(),
+    project_irb_number                      = readr::col_logical(),
+    project_grant_number                    = readr::col_logical(),
+    project_pi_firstname                    = readr::col_logical(),
+    project_pi_lastname                     = readr::col_logical(),
+    display_today_now_button                = readr::col_logical(),
+    missing_data_codes                      = readr::col_logical(),
+    external_modules                        = readr::col_character(),
+    bypass_branching_erase_field_prompt     = readr::col_logical()
+  )
+
+  if (kernel$success) {
+    try(
+      # Convert the raw text to a dataset.
+      ds <-
+        readr::read_csv(
+          file            = I(kernel$raw_text),
+          locale          = locale,
+          col_types       = col_types,
+          show_col_types  = FALSE
+        ),
+
+      # Don't print the warning in the try block.  Print it below,
+      #   where it's under the control of the caller.
+      silent = TRUE
+    )
+
+    if (exists("ds") & inherits(ds, "data.frame")) {
+      outcome_message <- sprintf(
+        "%s rows were read from REDCap in %0.1f seconds.  The http status code was %i.",
+        format(  nrow(ds), big.mark = ",", scientific = FALSE, trim = TRUE),
+        kernel$elapsed_seconds,
+        kernel$status_code
+      )
+
+      # If an operation is successful, the `raw_text` is no longer returned to
+      #   save RAM.  The content is not really necessary with httr's status
+      #   message exposed.
+      kernel$raw_text   <- ""
+    } else { # ds doesn't exist as a tibble.
+      # nocov start
+      # Override the 'success' determination from the http status code.
+      #   and return an empty tibble
+      kernel$success   <- FALSE
+      ds               <- tibble::tibble()
+      outcome_message  <- sprintf(
+        "The REDCap log export failed.  The http status code was %i.  The 'raw_text' returned was '%s'.",
+        kernel$status_code,
+        kernel$raw_text
+      )
+      # nocov end
+    }
+  } else { # kernel fails
+    ds              <- tibble::tibble() #Return an empty tibble
+    outcome_message <- if (any(grepl(kernel$regex_empty, kernel$raw_text))) {
+      "The REDCapR log export operation was not successful.  The returned dataset was empty."  # nocov
+    } else {
+      sprintf(
+        "The REDCapR log export operation was not successful.  The error message was:\n%s",
+        kernel$raw_text
+      )
+    }
+  }
+
+  if (verbose)
+    message(outcome_message)
+
+  list(
+    data               = ds,
+    success            = kernel$success,
+    status_code        = kernel$status_code,
+    outcome_message    = outcome_message,
+    elapsed_seconds    = kernel$elapsed_seconds,
+    raw_text           = kernel$raw_text
+  )
+}

inst/WORDLIST

@@ -22,6 +22,7 @@ Hatem
 Hofer
 Hosny
 IALSA
+Kadauke
 LDAP
 MCHB
 MIECHV

inst/test-data/specific-redcapr/project-info-read/simple.R

@@ -0,0 +1,42 @@
+structure(list(project_id = 153L, project_title = "REDCapR Target Simple Static -see https://github.com/OuhscBbmc/REDCapR", 
+    creation_time = structure(1385740700, class = c("POSIXct", 
+    "POSIXt"), tzone = "UTC"), production_time = structure(NA_real_, class = c("POSIXct", 
+    "POSIXt"), tzone = "UTC"), in_production = FALSE, project_language = "English", 
+    purpose = 0L, purpose_other = NA_character_, project_notes = NA_character_, 
+    custom_record_label = NA, secondary_unique_field = NA, is_longitudinal = FALSE, 
+    has_repeating_instruments_or_events = FALSE, surveys_enabled = FALSE, 
+    scheduling_enabled = FALSE, record_autonumbering_enabled = TRUE, 
+    randomization_enabled = FALSE, ddp_enabled = FALSE, project_irb_number = NA, 
+    project_grant_number = NA, project_pi_firstname = NA, project_pi_lastname = NA, 
+    display_today_now_button = TRUE, missing_data_codes = NA, 
+    external_modules = "cross_project_piping,date_validation_action_tags,form_status_tweaks", 
+    bypass_branching_erase_field_prompt = FALSE), row.names = c(NA, 
+-1L), spec = structure(list(cols = list(project_id = structure(list(), class = c("collector_integer", 
+"collector")), project_title = structure(list(), class = c("collector_character", 
+"collector")), creation_time = structure(list(format = ""), class = c("collector_datetime", 
+"collector")), production_time = structure(list(format = ""), class = c("collector_datetime", 
+"collector")), in_production = structure(list(), class = c("collector_logical", 
+"collector")), project_language = structure(list(), class = c("collector_character", 
+"collector")), purpose = structure(list(), class = c("collector_integer", 
+"collector")), purpose_other = structure(list(), class = c("collector_character", 
+"collector")), project_notes = structure(list(), class = c("collector_character", 
+"collector")), custom_record_label = structure(list(), class = c("collector_logical", 
+"collector")), secondary_unique_field = structure(list(), class = c("collector_logical", 
+"collector")), is_longitudinal = structure(list(), class = c("collector_logical", 
+"collector")), has_repeating_instruments_or_events = structure(list(), class = c("collector_logical", 
+"collector")), surveys_enabled = structure(list(), class = c("collector_logical", 
+"collector")), scheduling_enabled = structure(list(), class = c("collector_logical", 
+"collector")), record_autonumbering_enabled = structure(list(), class = c("collector_logical", 
+"collector")), randomization_enabled = structure(list(), class = c("collector_logical", 
+"collector")), ddp_enabled = structure(list(), class = c("collector_logical", 
+"collector")), project_irb_number = structure(list(), class = c("collector_logical", 
+"collector")), project_grant_number = structure(list(), class = c("collector_logical", 
+"collector")), project_pi_firstname = structure(list(), class = c("collector_logical", 
+"collector")), project_pi_lastname = structure(list(), class = c("collector_logical", 
+"collector")), display_today_now_button = structure(list(), class = c("collector_logical", 
+"collector")), missing_data_codes = structure(list(), class = c("collector_logical", 
+"collector")), external_modules = structure(list(), class = c("collector_character", 
+"collector")), bypass_branching_erase_field_prompt = structure(list(), class = c("collector_logical", 
+"collector"))), default = structure(list(), class = c("collector_guess", 
+"collector")), delim = ","), class = "col_spec"), class = c("spec_tbl_df", 
+"tbl_df", "tbl", "data.frame"))