Skip to content

Commit 697aaae

Browse files
wibeasleywibeasley
committed
tighten up checks
tidy too
1 parent 857a48a commit 697aaae

File tree

3 files changed

+48
-53
lines changed

3 files changed

+48
-53
lines changed

‎R/redcap-read-oneshot-eav.R

+20-20
Original file line numberDiff line numberDiff line change
@@ -115,8 +115,10 @@ redcap_read_oneshot_eav <- function(
115115
# fields
116116
# forms
117117
# events
118-
checkmate::assert_subset( raw_or_label , c("raw", "label"))
119-
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
118+
checkmate::assert_character(raw_or_label , any.missing=F, len=1)
119+
checkmate::assert_subset( raw_or_label , c("raw", "label"))
120+
checkmate::assert_character(raw_or_label_headers , any.missing=F, len=1)
121+
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
120122
# exportCheckboxLabel
121123
# returnFormat
122124
# export_survey_fields
@@ -169,18 +171,17 @@ redcap_read_oneshot_eav <- function(
169171
config = config_options
170172
)
171173

172-
status_code <- result$status
173-
success <- (status_code==200L)
174-
175-
raw_text <- httr::content(result, "text")
176-
raw_text <- gsub("\r\n", "\n", raw_text)
177-
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
174+
status_code <- result$status
175+
success <- (status_code==200L)
176+
raw_text <- httr::content(result, "text")
177+
raw_text <- gsub("\r\n", "\n", raw_text)
178+
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
178179

179180
# raw_text <- "The hostname (redcap-db.hsc.net.ou.edu) / username (redcapsql) / password (XXXXXX) combination could not connect to the MySQL server. \r\n\t\tPlease check their values."
180-
regex_cannot_connect <- "^The hostname \\((.+)\\) / username \\((.+)\\) / password \\((.+)\\) combination could not connect.+"
181-
regex_empty <- "^\\s+$"
181+
regex_cannot_connect <- "^The hostname \\((.+)\\) / username \\((.+)\\) / password \\((.+)\\) combination could not connect.+"
182+
regex_empty <- "^\\s+$"
182183

183-
success <- (success & !any(grepl(regex_cannot_connect, raw_text)) & !any(grepl(regex_empty, raw_text)))
184+
success <- (success & !any(grepl(regex_cannot_connect, raw_text)) & !any(grepl(regex_empty, raw_text)))
184185

185186
ds_metadata <- REDCapR::redcap_metadata_read(redcap_uri, token)$data
186187
ds_variable <- REDCapR::redcap_variables(redcap_uri, token)$data
@@ -193,10 +194,10 @@ redcap_read_oneshot_eav <- function(
193194
ds_metadata_expanded <- ds_metadata %>%
194195
dplyr::select_("field_name", "select_choices_or_calculations", "field_type") %>%
195196
dplyr::mutate(
196-
is_checkbox = (.data$field_type=="checkbox"),
197-
ids = dplyr::if_else(.data$is_checkbox, .data$select_choices_or_calculations, "1"),
198-
ids = gsub("(\\d+),.+?(\\||$)", "\\1", .data$ids),
199-
ids = strsplit(.data$ids, " ")
197+
is_checkbox = (.data$field_type=="checkbox"),
198+
ids = dplyr::if_else(.data$is_checkbox, .data$select_choices_or_calculations, "1"),
199+
ids = gsub("(\\d+),.+?(\\||$)", "\\1", .data$ids),
200+
ids = strsplit(.data$ids, " ")
200201
) %>%
201202
dplyr::select_("-select_choices_or_calculations", "-field_type") %>%
202203
tidyr::unnest_("ids") %>%
@@ -266,13 +267,12 @@ redcap_read_oneshot_eav <- function(
266267
status_code, "."
267268
)
268269

269-
270-
#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.
270+
# 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.
271271
raw_text <- ""
272272
} else {
273-
success <- FALSE #Override the 'success' determination from the http status code.
274-
ds_2 <- tibble::tibble() #Return an empty data.frame
275-
outcome_message <- paste0("The REDCap read failed. The http status code was ", status_code, ". The 'raw_text' returned was '", raw_text, "'.")
273+
success <- FALSE #Override the 'success' determination from the http status code.
274+
ds_2 <- tibble::tibble() #Return an empty data.frame
275+
outcome_message <- paste0("The REDCap read failed. The http status code was ", status_code, ". The 'raw_text' returned was '", raw_text, "'.")
276276
}
277277
}
278278
else {

‎R/redcap-read-oneshot.R

+14-19
Original file line numberDiff line numberDiff line change
@@ -103,11 +103,13 @@ redcap_read_oneshot <- function(
103103
# fields
104104
# forms
105105
# events
106-
checkmate::assert_subset( raw_or_label , c("raw", "label"))
107-
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
106+
checkmate::assert_character(raw_or_label , any.missing=F, len=1)
107+
checkmate::assert_subset( raw_or_label , c("raw", "label"))
108+
checkmate::assert_character(raw_or_label_headers , any.missing=F, len=1)
109+
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
108110
# exportCheckboxLabel
109111
# returnFormat
110-
checkmate::assert_logical(export_survey_fields, any.missing=F, len=1)
112+
checkmate::assert_logical( export_survey_fields , any.missing=F, len=1)
111113
checkmate::assert_logical( export_data_access_groups , any.missing=F, len=1)
112114
checkmate::assert_character(filter_logic , any.missing=F, len=1, pattern="^.{0,}$")
113115
#
@@ -159,24 +161,17 @@ redcap_read_oneshot <- function(
159161
config = config_options
160162
)
161163

162-
status_code <- result$status
163-
success <- (status_code==200L)
164-
165-
raw_text <- httr::content(result, "text")
166-
raw_text <- gsub("\r\n", "\n", raw_text)
167-
168-
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
164+
status_code <- result$status
165+
success <- (status_code==200L)
166+
raw_text <- httr::content(result, "text")
167+
raw_text <- gsub("\r\n", "\n", raw_text)
168+
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
169169

170170
# raw_text <- "The hostname (redcap-db.hsc.net.ou.edu) / username (redcapsql) / password (XXXXXX) combination could not connect to the MySQL server. \r\n\t\tPlease check their values."
171-
regex_cannot_connect <- "^The hostname \\((.+)\\) / username \\((.+)\\) / password \\((.+)\\) combination could not connect.+"
172-
regex_empty <- "^\\s+$"
173-
174-
if(
175-
any(grepl(regex_cannot_connect, raw_text)) |
176-
any(grepl(regex_empty, raw_text))
177-
) {
178-
success <- FALSE
179-
}
171+
regex_cannot_connect <- "^The hostname \\((.+)\\) / username \\((.+)\\) / password \\((.+)\\) combination could not connect.+"
172+
regex_empty <- "^\\s+$"
173+
174+
success <- (success & !any(grepl(regex_cannot_connect, raw_text)) & !any(grepl(regex_empty, raw_text)))
180175

181176
if( success ) {
182177
col_types <- if( guess_type ) NULL else readr::cols(.default=readr::col_character())

‎R/redcap-read.R

+14-14
Original file line numberDiff line numberDiff line change
@@ -95,21 +95,22 @@ redcap_read <- function(
9595
id_position = 1L
9696
) {
9797

98-
checkmate::assert_character(redcap_uri, any.missing=F, len=1, pattern="^.{1,}$")
99-
checkmate::assert_character(token, any.missing=F, len=1, pattern="^.{1,}$")
98+
checkmate::assert_character(redcap_uri , any.missing=F, len=1, pattern="^.{1,}$")
99+
checkmate::assert_character(token , any.missing=F, len=1, pattern="^.{1,}$")
100100
# records
101101
# fields
102102
# forms
103103
# events
104-
checkmate::assert_subset( raw_or_label , c("raw", "label"))
105-
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
104+
checkmate::assert_character(raw_or_label , any.missing=F, len=1)
105+
checkmate::assert_subset( raw_or_label , c("raw", "label"))
106+
checkmate::assert_character(raw_or_label_headers , any.missing=F, len=1)
107+
checkmate::assert_subset( raw_or_label_headers , c("raw", "label"))
106108
# exportCheckboxLabel
107109
# returnFormat
108110
# export_survey_fields
109111
checkmate::assert_logical( export_data_access_groups , any.missing=F, len=1)
110-
checkmate::assert_character(filter_logic , any.missing=F, len=1, pattern="^.{0,}$")
111112
#
112-
checkmate::assert_logical( guess_type , any.missing=F, len=1)
113+
checkmate::assert_logical( guess_type , any.missing=F, len=1)
113114
# verbose
114115
# config_options
115116
# id_position
@@ -149,8 +150,8 @@ redcap_read <- function(
149150

150151
# Stop and return to the caller if the initial query failed. --------------
151152
if( !initial_call$success ) {
152-
outcome_messages <- paste0("The initial call failed with the code: ", initial_call$status_code, ".")
153-
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
153+
outcome_messages <- paste0("The initial call failed with the code: ", initial_call$status_code, ".")
154+
elapsed_seconds <- as.numeric(difftime(Sys.time(), start_time, units="secs"))
154155
return( list(
155156
data = data.frame(),
156157
records_collapsed = "failed in initial batch call",
@@ -179,8 +180,8 @@ redcap_read <- function(
179180

180181
message("Starting to read ", format(length(uniqueIDs), big.mark=",", scientific=F, trim=T), " records at ", Sys.time())
181182
for( i in ds_glossary$id ) {
182-
selected_index <- seq(from=ds_glossary[i, "start_index"], to=ds_glossary[i, "stop_index"])
183-
selected_ids <- uniqueIDs[selected_index]
183+
selected_index <- seq(from=ds_glossary[i, "start_index"], to=ds_glossary[i, "stop_index"])
184+
selected_ids <- uniqueIDs[selected_index]
184185

185186
if( i > 0 ) Sys.sleep(time = interbatch_delay)
186187
if( verbose ) {
@@ -205,9 +206,8 @@ redcap_read <- function(
205206
config_options = config_options
206207
)
207208

208-
lst_status_code[[i]] <- read_result$status_code
209-
# lst_status_message[[i]] <- read_result$status_message
210-
lst_outcome_message[[i]] <- read_result$outcome_message
209+
lst_status_code[[i]] <- read_result$status_code
210+
lst_outcome_message[[i]] <- read_result$outcome_message
211211

212212
if( !read_result$success ) {
213213
error_message <- paste0("The `redcap_read()` call failed on iteration ", i, ".")
@@ -222,7 +222,7 @@ redcap_read <- function(
222222

223223
rm(read_result) #Admittedly overkill defensiveness.
224224
}
225-
# browser()
225+
226226
# ds_stacked <- as.data.frame(data.table::rbindlist(lst_batch))
227227
ds_stacked <- as.data.frame(dplyr::bind_rows(lst_batch))
228228

0 commit comments

Comments
 (0)