#' Suspend All Logging
#'
#' Completely disable logging for all loggers. This is for example useful for
#' automated test code. `suspend_logging()` globally disables all logging with
#' lgr until `unsuspend_logging()` is invoked, while `without_logging()` and
#' `with_logging()` temporarily disable/enable logging.
#'
#' @return
#' `suspend_logging()` and `unsuspend_logging()` return `NULL` (invisibly),
#' `without_logging()` and `with_logging()` returns whatever `code` returns.
#' @export
#' @examples
#' lg <- get_logger("test")
#'
#' # temporarily disable logging
#' lg$fatal("foo")
#' without_logging({
#' lg$info("everything in this codeblock will be suppressed")
#' lg$fatal("bar")
#' })
#'
#' # globally disable logging
#' suspend_logging()
#' lg$fatal("bar")
#' with_logging(lg$fatal("foo")) # log anyways
#'
#' # globally enable logging again
#' unsuspend_logging()
#' lg$fatal("foo")
suspend_logging <- function(){
options("lgr.logging_suspended" = TRUE)
invisible()
}
#' @rdname suspend_logging
#' @export
unsuspend_logging <- function(){
options("lgr.logging_suspended" = FALSE)
invisible()
}
#' @rdname suspend_logging
#' @param code Any \R code
#' @export
without_logging <- function(code){
old <- getOption("lgr.logging_suspended")
on.exit(options(lgr.logging_suspended = old))
suspend_logging()
force(code)
}
#' @rdname suspend_logging
#' @export
with_logging <- function(code){
old <- getOption("lgr.logging_suspended")
on.exit(options(lgr.logging_suspended = old))
unsuspend_logging()
force(code)
}
#' Inject Values into Logging Calls
#'
#' `with_log_level` temporarily overrides the log level of all [LogEvents]
#' created by target [Logger].
#'
#' These functions abuses lgr's filter mechanic to modify LogEvents in-place
#' before they passed on the Appenders. Use with care as they can
#' produce hard to reason about code.
#'
#' @param level `integer` or `character` scalar: the desired log level
#' @param code Any \R code
#' @param logger a [Logger] or the name of one (see [get_logger()]). Defaults
#' to the root logger (`lgr::lgr`).
#'
#' @return whatever `code` would return
#' @export
#' @examples
#' with_log_level("warn", {
#' lgr$info("More important than it seems")
#' lgr$fatal("Really not so bad")
#' })
with_log_level <- function(
level,
code,
logger = lgr::lgr
){
if (is_scalar_character(logger)){
logger <- get_logger(logger)
}
assert(is_Logger(logger))
level <- standardize_log_level(level)
force(level)
set_level <- function(event){
event[["level"]] <- level
TRUE
}
# to make it unlikely something goes wrong if people do funky stuff with
# filters inside with_log_level calls
tn <- paste0("...WITH_LOG_LEVEL_TEMP_FILTER", sample.int(1e9, size = 1))
logger$add_filter(set_level, name = tn)
on.exit(logger$remove_filter(tn))
force(code)
}
#' `with_log_value()` injects arbitrary values into all [LogEvents] (overriding
#' existing ones). This is especially powerful in combination with Appenders
#' that support arbitrary log fields, like [AppenderJson].
#'
#' @param values a named `list` of values to be injected into the logging calls
#' @rdname with_log_level
#' @export
#' @examples
#' with_log_value(
#' list(msg = "overriden msg"), {
#' lgr$info("bar")
#' lgr$fatal("FOO")
#' })
with_log_value <- function(
values,
code,
logger = lgr::lgr
){
if (is_scalar_character(logger)){
logger <- get_logger(logger)
}
assert(is_Logger(logger))
assert(is_equal_length(names(values), values))
set_level <- function(event){
for (i in seq_along(values)){
event[[names(values)[[i]] ]] <- values[[i]]
}
TRUE
}
tn <- paste0("...WITH_LOG_VALUE_TEMP_FILTER", sample.int(1e9, size = 1))
logger$add_filter(set_level, name = tn)
on.exit(logger$remove_filter(tn))
force(code)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.