# Utility functions to write checks with
#' Check for the presence of an element
#'
#' This function checks for the presence of an element in a metadata file.
#' Specifically, this function returns a SUCCESS status if one or more elements
#' are present and a FAILURE status if no elements are present.
#'
#' Note: Modifies the global environment.
#'
#' @param x (any) Metadata element to check.
#'
#' @return This function is invoked for its side-effect.
#'
#' @export
check_presence <- function(x) {
name <- paste(substitute(x), collapse = "")
if (length(x) == 0) {
status <- "FAILURE"
message <- paste0("'", name, "' is not present.")
} else {
status <- "SUCCESS"
message <- paste0("'", name, "' is present.")
}
if (any(grepl("mdq_result", ls(envir = .GlobalEnv)))) {
local_result <- get("mdq_result", envir = .GlobalEnv)
if (!class(local_result) == "list") stop("Name 'mdq_result' copied from global environment is not a list.")
# Toggle status to FAILURE if it is currently SUCCESS and status == "FAILURE"
if ("status" %in% names(mdq_result) &&
local_result[["status"]] != "FAILURE" &&
status == "FAILURE") {
local_result[["status"]] <- "FAILURE"
}
# Append output to any existing outputs
if ("output" %in% names(local_result)) {
local_result[["output"]][[length(local_result[["output"]]) + 1]] <- list(value = message)
} else {
local_result[["output"]] <- list(list(value = message))
}
} else {
local_result <- list(status = status,
output = list(list(value = message)))
}
assign("mdq_result", local_result, envir = .GlobalEnv)
}
#' Check if an element is defined
#'
#' This function checks the value returned from an mdqe
#' xpath selector.
#'
#' This check can be used to test values from a selector that
#' uses a subSelector. The value returned from this type of selector
#' is a list that could possibly contain elements that have no defined value, i.e.
#' the subSelector will return `NA` if the xpath it is trying to select is
#' not present. The 'pos' argument can be used to check a specific value
#' of such a list.
#'
#' @param variableName The name of the variable that contains selected values.
#' @param variable The variable that contains selected values.
#' @param pos The list element to check.
#'
#' @return logical
#'
#' @export
isDefined <- function(variableName, variable = NA, pos = as.integer(1)) {
# Check if the variable has been defined at all.
if (!exists(variableName) || all(is.na(variable))) return(FALSE)
# Check if the variable is defined for the specified position, i.e. list element
if (pos > length(variable)) {
retVal <- FALSE
} else {
if (is.na(variable[[pos]]) || is.null(variable[[pos]])) {
retVal <- FALSE
} else {
retVal <- TRUE
}
}
return(retVal)
}
#' Check if an element contains a TRUE value
#'
#' This function checks the value returned from an mdqe
#' xpath selector.
#'
#' If the variable is not defined or the value is `NA`, then `FALSE`
#' is returned. `TRUE` is only returned if the value is present and is `TRUE`.
#'
#' @param variableName The name of the variable that contains selected values.
#' @param variable The variable that contains selected values.
#' @param pos The list element to check.
#'
#' @return logical
#'
#' @export
isTrueVal <- function(variableName, variable, pos = as.integer(1)) {
pos <- as.integer(pos)
# Check if any entities have size defined
# but are only present if size is
if (!isDefined(variableName, variable, pos)) {
return(FALSE)
}
return(isTRUE(variable[[pos]]))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.