OuhscBbmc / REDCapR

@@ -71,7 +71,7 @@
Loading
71 71
      filter_logic                  = "",
72 72
73 73
      guess_type                    = TRUE,
74 -
      guess_max                     = 1000L,
74 +
      guess_max                     = 1000,
75 75
      verbose                       = TRUE,
76 76
      config_options                = NULL
77 77
    ) {

@@ -34,7 +34,6 @@
Loading
34 34
#' unsuccessful operation, it should contain diagnostic information.
35 35
#' * `elapsed_seconds`: The duration of the function.
36 36
#'
37 -
#'
38 37
#' @author Jonathan M. Mang
39 38
#' @references The official documentation can be found on the 'API Help Page'
40 39
#' and 'API Examples' pages on the REDCap wiki (*i.e.*,
@@ -110,25 +109,6 @@
Loading
110 109
        kernel$status_code
111 110
      )
112 111
113 -
      # ds <- dplyr::mutate_if(
114 -
      #   ds,
115 -
      #   is.character,
116 -
      #   function(x) dplyr::coalesce(x, "") #Replace NAs with blanks
117 -
      # )
118 -
      #
119 -
      # ds <- dplyr::mutate_if(
120 -
      #   ds,
121 -
      #   is.character,
122 -
      #   function( x ) gsub("\r\n", "\n", x, perl=TRUE)
123 -
      # )
124 -
      # ds <- dplyr::mutate_if(
125 -
      #   ds,
126 -
      #   function( x) inherits(x, "Date"),
127 -
      #   as.character
128 -
      # )
129 -
      #
130 -
      # ds <- base::as.data.frame(ds)
131 -
132 112
      # If an operation is successful, the `raw_text` is no longer returned to
133 113
      #   save RAM.  The content is not really necessary with httr's status
134 114
      #   message exposed.

@@ -28,7 +28,8 @@
Loading
28 28
#' @param guess_type A boolean value indicating if all columns should be
29 29
#' returned as character.  If false, [readr::read_csv()] guesses the intended
30 30
#' data type for each column.  Ignored if `col_types` is not null.
31 -
#' @param guess_max A positive integer passed to [readr::read_csv()] that
31 +
#' @param guess_max A positive [base::numeric] value
32 +
#' passed to [readr::read_csv()] that
32 33
#' specifies the maximum number of records to use for guessing column types.
33 34
#' @param verbose A boolean value indicating if `message`s should be printed
34 35
#' to the R console during the operation.  The verbose output might contain
@@ -127,7 +128,7 @@
Loading
127 128
128 129
  col_types                     = NULL,
129 130
  guess_type                    = TRUE,
130 -
  guess_max                     = 1000L,
131 +
  guess_max                     = 1000,
131 132
  verbose                       = TRUE,
132 133
  config_options                = NULL
133 134
) {
@@ -142,7 +143,7 @@
Loading
142 143
  checkmate::assert_logical(  export_checkbox_label     , any.missing=FALSE, len=1)
143 144
144 145
  checkmate::assert_logical(  guess_type                , any.missing=FALSE, len=1)
145 -
  checkmate::assert_integerish(guess_max                , any.missing=FALSE, len=1, lower=1)
146 +
  checkmate::assert_numeric(   guess_max                , any.missing=FALSE, len=1, lower=1)
146 147
  checkmate::assert_logical(  verbose                   , any.missing=FALSE, len=1, null.ok=TRUE)
147 148
  checkmate::assert_list(     config_options            , any.missing=TRUE ,        null.ok=TRUE)
148 149

@@ -193,7 +193,7 @@
Loading
193 193
  checkmate::assert_logical( blank_for_gray_form_status , any.missing=FALSE, len=1)
194 194
195 195
  # placeholder: checkmate::assert_logical(  guess_type                , any.missing=FALSE, len=1)
196 -
  # placeholder: checkmate::assert_integerish(guess_max                , any.missing=FALSE, len=1, lower=1)
196 +
  # placeholder: checkmate::assert_numeric(  guess_max                , any.missing=FALSE, len=1, lower=1)
197 197
  checkmate::assert_logical(  verbose                   , any.missing=FALSE, len=1, null.ok=TRUE)
198 198
  checkmate::assert_list(     config_options            , any.missing=TRUE ,        null.ok=TRUE)
199 199

@@ -70,7 +70,8 @@
Loading
70 70
#' @param guess_type A boolean value indicating if all columns should be
71 71
#' returned as character.  If false, [readr::read_csv()] guesses the intended
72 72
#' data type for each column.  Ignored if `col_types` is not null.
73 -
#' @param guess_max A positive integer passed to [readr::read_csv()] that
73 +
#' @param guess_max A positive [base::numeric] value
74 +
#' passed to [readr::read_csv()] that
74 75
#' specifies the maximum number of records to use for guessing column types.
75 76
#' @param http_response_encoding  The encoding value passed to
76 77
#' [httr::content()].  Defaults to 'UTF-8'.
@@ -192,7 +193,7 @@
Loading
192 193
193 194
  col_types                     = NULL,
194 195
  guess_type                    = TRUE,
195 -
  guess_max                     = 1000L,
196 +
  guess_max                     = 1000,
196 197
  http_response_encoding        = "UTF-8",
197 198
  locale                        = readr::default_locale(),
198 199
  verbose                       = TRUE,
@@ -223,7 +224,7 @@
Loading
223 224
  checkmate::assert_logical( blank_for_gray_form_status , any.missing=FALSE, len=1)
224 225
225 226
  checkmate::assert_logical(  guess_type                , any.missing=FALSE, len=1)
226 -
  checkmate::assert_integerish(guess_max                , any.missing=FALSE, len=1, lower=1)
227 +
  checkmate::assert_numeric(   guess_max                , any.missing=FALSE, len=1, lower=1)
227 228
  checkmate::assert_character(http_response_encoding    , any.missing=FALSE,     len=1)
228 229
229 230
  checkmate::assert_class(    locale, "locale"          , null.ok = FALSE)

@@ -4,7 +4,27 @@
Loading
4 4
#' pattern of a 32-character hexadecimal value.
5 5
#' Each character must be an (a) digit 0-9, (b) uppercase letter A-F, or
6 6
#' (c) lowercase letter a-f.
7 -
#' #' Trailing line endings are removed.
7 +
#' Trailing line endings are removed.
8 +
#'
9 +
#' A typical user does not call this function directly.  However functions like
10 +
#' [`redcap_read()`](redcap_read) call it to provide a more informative
11 +
#' error message to the user.
12 +
#'
13 +
#' Some institutions create their own tokens not the standard
14 +
#' 32-character hexadecimal value.  The pattern that validates their tokens
15 +
#' can be specified with the system environmental variable
16 +
#' `REDCAP_TOKEN_PATTERN` using
17 +
#' [`base::Sys.setenv()`](base::Sys.setenv).
18 +
#'
19 +
#' For example, the following regex pattern captures a
20 +
#' [base64 encoded value]() with 40 characters:
21 +
#' `^([A-Za-z\\d+/\\+=]{40})$`.
22 +
#' See <https://regexland.com/base64/> for alternative approaches to validate
23 +
#' base64 values.
24 +
#'
25 +
#' If no pattern is specified, the default is 32-character hex token:
26 +
#' `^([0-9A-Fa-f]{32})(?:\\n)?$`.  The important segment is contained in the
27 +
#' first (and only) capturing group.  Any trailing newline character is removed.
8 28
#'
9 29
#' @param token The REDCap token. Required.
10 30
#'
@@ -22,23 +42,41 @@
Loading
22 42
#' REDCapR::sanitize_token(secret_token_1)
23 43
#' REDCapR::sanitize_token(secret_token_2)
24 44
#' REDCapR::sanitize_token(secret_token_3)
45 +
#'
46 +
#' # Some institutions use a token system that follows a different pattern
47 +
#' Sys.setenv("REDCAP_TOKEN_PATTERN" = "^([A-Za-z\\d+/\\+=]{10})$")
48 +
#'
49 +
#' secret_token_4 <- "abcde1234="
50 +
#' REDCapR::sanitize_token(secret_token_4)
51 +
#' Sys.getenv("REDCAP_TOKEN_PATTERN")
52 +
#' Sys.unsetenv("REDCAP_TOKEN_PATTERN")
25 53
26 54
#' @export
27 55
sanitize_token <- function(token) {
28 -
  pattern <- "^([0-9A-Fa-f]{32})(?:\\n)?$"
56 +
  checkmate::assert_character(token, any.missing = TRUE, len = 1)
57 +
58 +
  pattern_env <- Sys.getenv("REDCAP_TOKEN_PATTERN")
59 +
  pattern <-
60 +
    if (pattern_env != "") {
61 +
      checkmate::assert_character(pattern_env, any.missing = FALSE, len = 1)
62 +
      pattern_env
63 +
    } else {
64 +
      "^([0-9A-Fa-f]{32})(?:\\n)?$"
65 +
    }
29 66
30 67
  if (is.na(token)) {
31 68
    stop(
32 -
      "The token is `NA`, not a valid 32-character hexademical value."
69 +
      "The token is `NA`, which is not allowed."
33 70
    )
34 71
  } else if (nchar(token) == 0L) {
35 72
    stop(
36 -
      "The token is an empty string, ",
37 -
      "not a valid 32-character hexademical value."
73 +
      "The token is an empty string, which is not allowed."
38 74
    )
39 75
  } else if (!grepl(pattern, token, perl = TRUE)) {
40 76
    stop(
41 -
      "The token is not a valid 32-character hexademical value."
77 +
      "The token does not conform with the regex `",
78 +
      pattern,
79 +
      "`."
42 80
    )
43 81
  }
44 82
Files Coverage
R 95.80%
Project Totals (38 files) 95.80%
1
comment: false
2

3
coverage:
4
  status:
5
    project:
6
      default:
7
        target: auto
8
        threshold: 3%
9
    patch:
10
      default:
11
        target: auto
12
        threshold: 3%
Sunburst
The inner-most circle is the entire project, moving away from the center are folders then, finally, a single file. The size and color of each slice is representing the number of statements and the coverage, respectively.
Icicle
The top section represents the entire project. Proceeding with folders and finally individual files. The size and color of each slice is representing the number of statements and the coverage, respectively.
Grid
Each block represents a single file in the project. The size and color of each block is represented by the number of statements and the coverage, respectively.
Loading