Nothing
is_pure_BackupQueueIndex <- function(
file,
dir = dirname(file)
){
identical(BackupQueueDateTime$new(file, dir = dir)$n, 0L)
}
is_pure_BackupQueueDateTime <- function(
file,
dir = dirname(file)
){
bi <- BackupQueueIndex$new(file, dir = dir)
identical(bi$n, 0L) || min(bi$files$index) > 1L
}
is_pure_BackupQueue <- function(
file,
dir = dirname(file)
){
bi <- BackupQueueIndex$new(file, dir = dir)
if (bi$n < 1){
TRUE
} else if (identical(min(bi$files$index), 1L)){
# check if min index is 1 to filter out BackupQueueIndex that are truely
# BackupQueueDate but only have integer like timestamps
identical(
try(BackupQueueDateTime$new(file, dir = dir)$n, silent = TRUE),
0L
)
} else {
TRUE
}
}
assert_pure_BackupQueue <- function(
file,
dir = dirname(file),
warn_only = FALSE
){
if (is_pure_BackupQueue(file, dir = dir))
return(TRUE)
msg <- paste0(
"Indexed as well as timestamped backups exist for '", file, "'.\n",
paste("*", list_backups(file), collapse = "\n")
)
if (warn_only){
warning(msg, call. = FALSE)
FALSE
} else {
stop("Operation not possible: ", msg, call. = FALSE)
}
}
is_parsable_rotation_interval <- function(x){
is_scalar(x) && (
is.infinite(x) ||
is_integerish(x) ||
grepl("\\d+\\syear|quarter|month|week|day", x)
)
}
is_valid_date_format <- function(x){
is_scalar_character(x) &&
x %in% c(
"%Y-%m-%d",
"%Y-%m",
"%Y%m%d",
"%Y%m",
"%Y"
)
}
assert_valid_date_format <- function(x){
xdep <- deparse(substitute(x))
if (!is_valid_datetime_format(x)){
stop(
"`", xdep, "` is not a valid date format but ", preview_object(x),
". See ?rotate for details."
)
}
TRUE
}
is_valid_date_format <- function(
x
){
if (!is_scalar_character(x))
return(FALSE)
x <- standardize_datetime_stamp(x)
if (nchar(x) > 6)
return(FALSE)
is_valid_datetime_format(x)
}
assert_valid_datetime_format <- function(x){
xdep <- deparse(substitute(x))
if (!is_valid_datetime_format(x))
stop(
"`", xdep, "` is not a valid datetime format but ", preview_object(x),
". See ?rotate for details."
)
else
TRUE
}
is_valid_datetime_format <- function(
x
){
if (!is_scalar_character(x))
return(FALSE)
standardize_datetime_stamp(x) %in% c(
"%Y%m%d%H%M%S",
"%Y%m%d%H%M",
"%Y%m%d%H",
"%Y%m%d",
"%Y%m",
"%Y"
)
}
is_parsable_datetime <- function(x){
is_scalar(x) && (
is_Date(x) ||
is_POSIXct(x) ||
grepl("^\\d{4,14}$", standardize_datetime_stamp(x))
)
}
is_parsable_date <- function(x){
is_scalar(x) && (
is_Date(x) ||
is_scalar(x) && grepl("^\\d{4,8}$", standardize_datetime_stamp(x))
)
}
is_backup_older_than_datetime <- function(
backup_date,
datetime,
verbose = FALSE
){
if (is_Date(backup_date))
backup_date <- as.POSIXct(format(backup_date))
assert(is_scalar_POSIXct(backup_date))
assert(is_parsable_datetime(datetime))
parsed_td <- parse_datetime(datetime)
res <- backup_date < parsed_td
if (verbose && !res){
message(sprintf(
"Not rotating: last backup (%s) is newer than %s" ,
format(backup_date), format(parsed_td)
))
}
res
}
is_backup_older_than_interval <- function(
backup_date,
interval,
now,
verbose = FALSE
){
if (is_POSIXct(backup_date))
backup_date <- as.Date(format(backup_date))
if (is_POSIXct(now)){
now <- as.Date(format(now))
} else if (is.character(now)){
now <- as.Date(parse_datetime(now))
}
assert(is_scalar_Date(backup_date))
assert(is_scalar_Date(now))
iv <- parse_rotation_interval(interval)
as_period <- switch(
iv$unit,
day = identity,
week = dint::as_date_yw,
month = dint::as_date_ym,
quarter = dint::as_date_yq,
year = dint::get_year
)
res <- as_period(backup_date) + 1L * iv$value <= as_period(now)
if (verbose && !res){
message(sprintf(
"Not rotating: last backup (%s) is younger than '%s'" ,
format(backup_date), paste(interval, collapse = " ")
))
}
res
}
assert_valid_compression <- function(compression){
assert(
is_scalar_atomic(compression) && (
compression %in% c("utils::zip", "zip::zipr") ||
compression %in% 1:9 ||
is_bool(compression)
),
'`compression` must be `TRUE`, `FALSE`, or an integer between 1 and 9',
'or the character scalers "utils::zip" or "zip::zipr" not: ',
preview_object(compression)
)
}
is_zipcmd_available <- function(cmd = Sys.getenv("R_ZIPCMD", "zip")){
if (is_blank(cmd)){
return(FALSE)
}
if (.Platform$OS.type == "windows"){
suppressWarnings(res <- system2("where", cmd, stderr = NULL, stdout = NULL))
} else {
res <- tryCatch(
system2("command", paste("-v", cmd), stderr = NULL, stdout = NULL),
warning = function(w) {99}
)
}
assert(is_scalar(res))
res == 0
}
is_dir <- function(
x
){
file.exists(x) && file.info(x)$isdir
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.