diff --git a/R/autoReport.R b/R/autoReport.R index d4d3a9b2..3174456d 100644 --- a/R/autoReport.R +++ b/R/autoReport.R @@ -514,6 +514,7 @@ getRegs <- function(config) { #' sent. Default is FALSE #' @param dato Date-class date when report will be run first time. Default value #' is set to \code{Sys.Date()} +#' @inheritParams makeAutoReportTab #' #' @return Emails with corresponding file attachment. If dryRun == TRUE just a #' message @@ -528,12 +529,27 @@ getRegs <- function(config) { runAutoReport <- function(dayNumber = as.POSIXlt(Sys.Date())$yday + 1, dato = Sys.Date(), + group = NULL, type = c("subscription", "dispatchment"), target = "file", dryRun = FALSE) { # get report candidates reps <- readAutoReportData(target = target) %>% filterAutoRep(by = "type", pass = type, target = target) + if (!is.null(group)) { + reps <- reps %>% + filterAutoRep(by = "package", pass = group, target = target) + } + if (target == "db") { + reps <- reps %>% + # nolint start: object_usage_linter + dplyr::summarise( + email = list(unique(email)), + .by = c(owner, ownerName, package, organization, type, fun, + params, startDate, terminateDate, interval) + ) + # nolint end + } # standard text for email body stdTxt <- readr::read_file( @@ -549,7 +565,8 @@ runAutoReport <- function(dayNumber = as.POSIXlt(Sys.Date())$yday + 1, tryCatch( { if (target == "db") { - rep <- reps[i, ] + rep <- reps[i, ] %>% as.list() + rep$email <- unlist(rep$email) params <- jsonlite::fromJSON(rep$params) } else { rep <- reps[[i]] @@ -678,6 +695,7 @@ makeRunDayOfYearSequence <- function(startDay = Sys.Date(), interval) { #' \code{\link[base]{strptime}} in the current locale. Defaults to #' "\%A \%d. \%B \%Y" that will provide something like #' 'Mandag 20. januar 2019' in a Norwegian locale +#' @inheritParams createAutoReport #' @return String date for printing #' @examples #' # Will return Jan 30 in the current year and locale with default formatting @@ -687,55 +705,86 @@ makeRunDayOfYearSequence <- function(startDay = Sys.Date(), interval) { findNextRunDate <- function(runDayOfYear, baseDayNum = as.POSIXlt(Sys.Date())$yday + 1, startDate = NULL, - returnFormat = "%A %e. %B %Y") { - year <- as.POSIXlt(Sys.Date())$year + 1900 - - if (!is.null(startDate)) { - if (as.Date(startDate) > as.Date(strptime( - paste(year, baseDayNum), - "%Y %j" - ))) { - # since we pull the NEXT run day set new base day on day BEFORE star date - baseDayNum <- as.POSIXlt(startDate)$yday + terminateDate = NULL, + interval = NULL, + returnFormat = "%A %e. %B %Y", + target = "file") { + + if (target == "db") { + if (Sys.Date() < startDate) { + nextDate <- as.Date(startDate) + } + if (Sys.Date() >= startDate && Sys.Date() <= terminateDate) { + dateseq <- timeplyr::time_seq( + as.Date(startDate), + as.Date(terminateDate), + time_by = interval + ) + tidsdiff <- difftime(dateseq, Sys.Date(), units = "days") + tidsdiff[tidsdiff <= 0] <- NA + if (length(tidsdiff) == sum(is.na(tidsdiff))) { + nextDate <- as.Date(terminateDate) + 1 + } else { + nextDate <- dateseq[which(tidsdiff == min(tidsdiff, na.rm = TRUE))] + } + } + if (Sys.Date() > terminateDate) { + nextDate <- as.Date(terminateDate) + 1 } - } - # special case if out of max range and only one run day defined (yearly) - if (baseDayNum >= max(runDayOfYear) || length(runDayOfYear) == 1) { - # next run will be first run in day num vector - nextDayNum <- min(runDayOfYear) + return(format(nextDate, format = returnFormat)) } else { - # find year transition, if any - nDay <- length(runDayOfYear) - deltaDay <- runDayOfYear[2:nDay] - runDayOfYear[1:(nDay - 1)] - trans <- deltaDay < 0 - if (any(trans)) { - indTrans <- match(TRUE, trans) - # vector head - dHead <- runDayOfYear[1:indTrans] - # vector tail - dTail <- runDayOfYear[(indTrans + 1):nDay] - - if (baseDayNum >= max(dTail)) { - ## next run day to be found in vector head - runDayOfYearSubset <- dHead - } else { - ## next run day to be found in vector tail - runDayOfYearSubset <- dTail + + year <- as.POSIXlt(Sys.Date())$year + 1900 + + if (!is.null(startDate)) { + if (as.Date(startDate) > as.Date(strptime( + paste(year, baseDayNum), + "%Y %j" + ))) { + # since we pull the NEXT run day set new base day + # on day BEFORE start date + baseDayNum <- as.POSIXlt(startDate)$yday } + } + + # special case if out of max range and only one run day defined (yearly) + if (baseDayNum >= max(runDayOfYear) || length(runDayOfYear) == 1) { + # next run will be first run in day num vector + nextDayNum <- min(runDayOfYear) } else { - runDayOfYearSubset <- runDayOfYear + # find year transition, if any + nDay <- length(runDayOfYear) + deltaDay <- runDayOfYear[2:nDay] - runDayOfYear[1:(nDay - 1)] + trans <- deltaDay < 0 + if (any(trans)) { + indTrans <- match(TRUE, trans) + # vector head + dHead <- runDayOfYear[1:indTrans] + # vector tail + dTail <- runDayOfYear[(indTrans + 1):nDay] + + if (baseDayNum >= max(dTail)) { + ## next run day to be found in vector head + runDayOfYearSubset <- dHead + } else { + ## next run day to be found in vector tail + runDayOfYearSubset <- dTail + } + } else { + runDayOfYearSubset <- runDayOfYear + } + + nextDayNum <- min(runDayOfYearSubset[runDayOfYearSubset > baseDayNum]) } - nextDayNum <- min(runDayOfYearSubset[runDayOfYearSubset > baseDayNum]) - } + # if current day num larger than nextDayNum report will be run next year + if (as.numeric(format(Sys.Date(), "%j")) > nextDayNum) { + year <- year + 1 + } - # if current day num larger than nextDayNum report will be run next year - if (as.numeric(format(Sys.Date(), "%j")) > nextDayNum) { - year <- year + 1 + format(strptime(paste(year, nextDayNum), "%Y %j"), format = returnFormat) } - - format(strptime(paste(year, nextDayNum), "%Y %j"), format = returnFormat) } # nolint start @@ -828,13 +877,13 @@ makeAutoReportTab <- function(session, l <- list() for (i in seq_len(nrow(autoRep))) { - runDayOfYear <- as.vector( - as.integer(strsplit(autoRep[i, ]$runDayOfYear, ",")[[1]]) - ) nextDate <- findNextRunDate( - runDayOfYear = runDayOfYear, + runDayOfYear = NULL, startDate = autoRep[i, ]$startDate, - returnFormat = dateFormat + terminateDate = autoRep[i, ]$terminateDate, + interval = autoRep[i, ]$interval, + returnFormat = dateFormat, + target = target ) if (as.Date(nextDate, format = dateFormat) > autoRep[i, ]$terminateDate) { nextDate <- "Utl\u00F8pt" diff --git a/man/findNextRunDate.Rd b/man/findNextRunDate.Rd index cafa2306..205134e9 100644 --- a/man/findNextRunDate.Rd +++ b/man/findNextRunDate.Rd @@ -8,7 +8,10 @@ findNextRunDate( runDayOfYear, baseDayNum = as.POSIXlt(Sys.Date())$yday + 1, startDate = NULL, - returnFormat = "\%A \%e. \%B \%Y" + terminateDate = NULL, + interval = NULL, + returnFormat = "\%A \%e. \%B \%Y", + target = "file" ) } \arguments{ @@ -21,10 +24,20 @@ the very first run. If set to NULL (default) or a none future date (compared to the date represented by \code{baseDayNum} for the current year) it will be disregarded.} +\item{terminateDate}{Date-class date after which report is no longer run. +Default value set to \code{NULL} in which case the function will provide an +expiry date adding 3 years to the current date if in a PRODUCTION context +and 1 month if not} + +\item{interval}{String defining a time interval as defined in +\code{\link[base:seq.POSIXt]{seq.POSIXt}}. Default value is an empty string} + \item{returnFormat}{String providing return format as described in \code{\link[base]{strptime}} in the current locale. Defaults to "\%A \%d. \%B \%Y" that will provide something like 'Mandag 20. januar 2019' in a Norwegian locale} + +\item{target}{List of autoreports in file or database} } \value{ String date for printing diff --git a/man/runAutoReport.Rd b/man/runAutoReport.Rd index 4587e59b..5ba2f6cf 100644 --- a/man/runAutoReport.Rd +++ b/man/runAutoReport.Rd @@ -7,6 +7,7 @@ runAutoReport( dayNumber = as.POSIXlt(Sys.Date())$yday + 1, dato = Sys.Date(), + group = NULL, type = c("subscription", "dispatchment"), target = "file", dryRun = FALSE @@ -20,6 +21,12 @@ yday is base 0)} \item{dato}{Date-class date when report will be run first time. Default value is set to \code{Sys.Date()}} +\item{group}{Character string defining the registry, normally corresponding +to the R package name and the value stemming from the SHINYPROXY_GROUPS +environment variable. Introduced as a new argument when running apps inside +containers. Default value is set to \code{rapbase::getUserGroups(session)} +to allow backward compatibility.} + \item{type}{Character vector defining the type of reports to be processed. May contain one or more of \code{c("subscription", "dispatchment", "bulletin")}. Defaults value set to diff --git a/tests/testthat/test-auto-report-functions.R b/tests/testthat/test-auto-report-functions.R index c730e52e..0d132a4f 100644 --- a/tests/testthat/test-auto-report-functions.R +++ b/tests/testthat/test-auto-report-functions.R @@ -132,6 +132,98 @@ test_that("a start date is enforced when given", { ), days[4]) }) +###################################### +# Test findNextRunDate with db-setup # +###################################### + +test_that("The next run day is a monday", { + expect_equal( + findNextRunDate( + startDate = "2025-01-06", # Monday + terminateDate = Sys.Date() + 365, + interval = "weeks", + returnFormat = "%A", + target = "db" + ) + , "Monday") +}) + +test_that("The next run day is day 6 of month ", { + expect_equal( + findNextRunDate( + startDate = "2025-01-06", + terminateDate = Sys.Date() + 365, + interval = "months", + returnFormat = "%d", + target = "db" + ) + , "06") +}) + +test_that("Terminate date is before today, and will return terminateDate + 1", { + expect_equal( + findNextRunDate( + startDate = "2023-01-06", + terminateDate = Sys.Date() - 10, + interval = "months", + target = "db" + ), format(Sys.Date() - 9, format = "%A %e. %B %Y")) + + expect_equal(findNextRunDate( + startDate = "2025-01-06", + terminateDate = "2025-01-06", + target = "db" + ), "Tuesday 7. January 2025") +}) + +test_that("Terminate date is after today but before next in range, and will return terminateDate + 1", { + expect_equal( + findNextRunDate( + startDate = seq(as.Date(Sys.Date()), length = 2, by = "-24 months")[2], # 24 months back in time + terminateDate = Sys.Date() + 14, + interval = "months", + target = "db" + ), format(Sys.Date() + 15, format = "%A %e. %B %Y")) +}) + + +test_that("Start date is after today, and will return start date", { + expect_equal( + findNextRunDate( + startDate = Sys.Date() + 10, + terminateDate = Sys.Date() + 20, + interval = "months", + target = "db" + ), format(Sys.Date() + 10, format = "%A %e. %B %Y")) +}) + +test_that("findNextRunDate throw errors", { + expect_error(findNextRunDate()) + expect_error(findNextRunDate(target = "db")) + expect_error(findNextRunDate(startDate = "2025-01-06", target = "db")) + expect_error(findNextRunDate(terminateDate = "2025-01-06", target = "db")) + # Wrong date format + expect_error(findNextRunDate( + startDate = "202501-06", + terminateDate = "2025-01-06", + interval = "days", + target = "db" + )) + expect_error(findNextRunDate( + startDate = "2025-01-06", + terminateDate = "243467853443-212", + interval = "days", + target = "db" + )) + # missing interval + expect_error(findNextRunDate( + startDate = "2025-01-06", + terminateDate = Sys.Date() + 10, + target = "db" + )) +}) + + shinySession <- list(user = "tester") shinySession$groups <- "rapbase" attr(shinySession, "class") <- "ShinySession"