[review] Guard against problematic characters in dataset names

Author: ml-ebs-ext

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: dv.listings
 Type: Package
 Title: Data listings module
-Version: 4.3.4-9002
+Version: 4.3.4-9003
 Authors@R: 
     c(
       person("Boehringer-Ingelheim Pharma GmbH & Co.KG", role = c("cph", "fnd")),

NEWS.md

@@ -1,3 +1,7 @@
+# dv.listings 4.3.4-9003
+- Review functionality:
+  - Guard against problematic characters in dataset names
+
 # dv.listings 4.3.4-9002
 - Review functionality:
   - Cope with initially empty datasets

R/mod_listings.R

@@ -993,7 +993,7 @@ check_mod_listings <- function(afmm, datasets, module_id, dataset_names,
     )
   )
 
-  check_review_parameter(datasets, dataset_names, review, err)
+  check_review_parameter(afmm, datasets, dataset_names, review, err)
 
   res <- list(errors = err[["messages"]])
   return(res)

R/review.R

@@ -1290,6 +1290,10 @@ REV_report_changes <- function(h0, h1, verbose = FALSE) {
 
 #' Early error feedback function for the optional review parameter
 #'
+#' @param afmm
+#' 
+#' Pass-through of the server afmm parameter.
+#' 
 #' @param datasets `[list(data.frame)]`
 #'
 #' Available datasets for review.
@@ -1307,7 +1311,7 @@ REV_report_changes <- function(h0, h1, verbose = FALSE) {
 #' the configuration of the review parameter will be placed here.
 #' 
 #' @export
-check_review_parameter <- function(datasets, dataset_names, review, err) {
+check_review_parameter <- function(afmm, datasets, dataset_names, review, err) {
   if (is.null(review)) return(NULL)
   ok <- CM$assert(
     container = err,
@@ -1443,4 +1447,48 @@ check_review_parameter <- function(datasets, dataset_names, review, err) {
       )
     }
   }
+  if (!ok) return(NULL)
+ 
+  # https://en.wikipedia.org/wiki/Filename#Problematic_characters 
+  problematic_chars <- c("/", "\\\\", "?", "%", "*", ":", "|", '"', "<", ">", ".", ",", ";", "=")
+  problematic_chars_regexp <- paste("([", paste(problematic_chars, collapse = ""), "])")
+  
+  report_problematic_names <- function(message_template, v) {
+    res <- character(0)
+    for (e in v){
+      matches <- character(0)
+      for (pc in problematic_chars) if (grepl(pc, e, fixed = TRUE)) {
+        single_char <- substr(pc, 1, 1) # deals with backslash
+        matches <- c(matches, single_char)
+      }
+      if (length(matches)) {
+        res <- c(res, sprintf(message_template, e, paste(sprintf("'<b>%s</b>'", matches), collapse = ", ")))
+      }
+    }
+    res <- paste(res, collapse = "<br>")
+    return(res)
+  }
+  
+  dataset_list_names <- names(afmm[["data"]])
+  CM$assert(
+    container = err,
+    cond = !any(grepl(problematic_chars_regexp, dataset_list_names)),
+    msg = report_problematic_names(
+      paste('The dataset list name "<b>%s</b>" contains characters (%s) incompatible with the review functionality.',
+            "That string would be used as part of review-related folder names and those characters could cause problems",
+            '<a href="https://en.wikipedia.org/wiki/Filename#Problematic_characters" target="_blank">(details)<a>.',
+            "Please, exclude them."),
+      dataset_list_names)
+  ) 
+  dataset_names <- names(review[["datasets"]])
+  CM$assert(
+    container = err,
+    cond = !any(grepl(problematic_chars_regexp, dataset_names)),
+    msg = report_problematic_names(
+      paste('The dataset name "<b>%s</b>" contains characters (%s) incompatible with the review functionality.',
+            "That string would be used as part of review-related file names and those characters could cause problems",
+            '<a href="https://en.wikipedia.org/wiki/Filename#Problematic_characters" target="_blank">(details)<a>.',
+            "Please, exclude them."),
+      dataset_names)
+  )
 }

man/check_review_parameter.Rd

@@ -237,3 +237,23 @@ test_that("REV_compute_status preserves expected behavior", {
   expect_equal(res, factor(c("Conflict", "Pending", "Pending"), levels = res_levels))
 })
 
+test_that("check_review_parameter warns against problematic characters in dataset names", {
+  mock_afmm = list(data = list(`dataset_list/not_allowed` = NULL))
+  review <- list(
+    datasets = list("not/allowed" = list(id_vars = c("USUBJID", "AESEQ"), 
+                                         tracked_vars = c("TRACKED_1", "TRACKED_2", "TRACKED_3"))),
+    choices = c("choiceA", "choiceB"), roles = c("roleA", "roleB")
+  )
+  
+  err <- CM$container()
+  check_review_parameter(
+    afmm = mock_afmm, 
+    datasets = list(), 
+    dataset_names = c("not/allowed"), 
+    review = review, 
+    err = err
+  )
+  
+  expect_true(any(grepl("Problematic_characters", err[["messages"]])))
+})
+