├── .Rbuildignore ├── .gitignore ├── .travis.yml ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── BackupQueue.R ├── Cache.R ├── DirectoryQueue.R ├── DryRunMemory.R ├── conditions.R ├── copy_or_compress.R ├── list_backups.R ├── parsers.R ├── rotate.R ├── rotate_date.R ├── rotate_rds.R ├── rotate_time.R ├── rotor-package.R ├── utils-fs.R ├── utils-predicates.R ├── utils-rd.R ├── utils-sfmisc.R └── utils.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── inst ├── WORDLIST └── benchmarks │ ├── benchmarks.R │ └── benchmarks.Rmd ├── man-roxygen ├── datime_formats.R └── r6_api.R ├── man ├── BackupQueue.Rd ├── BackupQueueDate.Rd ├── BackupQueueDateTime.Rd ├── BackupQueueIndex.Rd ├── Cache.Rd ├── DirectoryQueue.Rd ├── backup_info.Rd ├── rotate.Rd ├── rotate_rds.Rd └── rotor-package.Rd ├── revdep ├── .gitignore └── email.yml ├── rotor.Rproj └── tests ├── testthat.R └── testthat ├── test_BackupQueue.R ├── test_Cache.R ├── test_copy_or_compress.R ├── test_list_backups.R ├── test_parsers.R ├── test_rotate.R ├── test_rotate_date.R ├── test_rotate_rds.R ├── test_rotate_time.R ├── test_utils-fs.R ├── test_utils-predicates.R └── test_utils.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^pkgdown$ 2 | ^_pkgdown\.yml$ 3 | ^docs$ 4 | ^\.travis\.yml$ 5 | ^README\.Rmd$ 6 | ^LICENSE\.md$ 7 | ^.*\.Rproj$ 8 | ^\.Rproj\.user$ 9 | ^man-roxygen$ 10 | ^cran-comments\.md$ 11 | ^CRAN-RELEASE$ 12 | ^codecov\.yml$ 13 | ^vignettes/benchmarks\.Rmd$ 14 | ^revdep$ 15 | ^CRAN-SUBMISSION$ 16 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | docs/ 6 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | # R for travis: see documentation at https://docs.travis-ci.com/user/languages/r 2 | 3 | language: R 4 | addons: 5 | apt: 6 | packages: 7 | - libharfbuzz-dev # for pkgdown 8 | - libfribidi-dev 9 | matrix: 10 | include: 11 | - r: devel 12 | - r: release 13 | before_cache: Rscript -e 'remotes::install_cran("pkgdown")' 14 | after_success: 15 | - Rscript -e 'covr::codecov()' 16 | deploy: 17 | provider: script 18 | script: Rscript -e 'pkgdown::deploy_site_github(ssh_id = Sys.getenv("TRAVIS_DEPLOY_KEY", ""))' 19 | skip_cleanup: true 20 | - r: 3.5 21 | - r: 3.4 22 | - r: 3.3 23 | sudo: false 24 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: rotor 3 | Title: Log Rotation and Conditional Backups 4 | Version: 0.3.7 5 | Authors@R: 6 | person(given = "Stefan", 7 | family = "Fleck", 8 | role = c("aut", "cre"), 9 | email = "stefan.b.fleck@gmail.com", 10 | comment = c(ORCID = "0000-0003-3344-9851")) 11 | Maintainer: Stefan Fleck 12 | Description: Conditionally rotate or back-up files based on 13 | their size or the date of the last backup; inspired by the 'Linux' 14 | utility 'logrotate'. 15 | License: MIT + file LICENSE 16 | URL: https://s-fleck.github.io/rotor/ 17 | BugReports: https://github.com/s-fleck/rotor/issues 18 | Imports: 19 | dint, 20 | R6, 21 | tools 22 | Suggests: 23 | covr, 24 | crayon, 25 | data.table, 26 | digest, 27 | rmarkdown, 28 | testthat, 29 | uuid, 30 | ulid, 31 | zip 32 | Encoding: UTF-8 33 | LazyData: true 34 | Roxygen: list(markdown = TRUE) 35 | RoxygenNote: 7.2.1.9000 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2019 2 | COPYRIGHT HOLDER: Stefan Fleck 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2019 Stefan Fleck 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export(BackupQueue) 4 | export(BackupQueueDate) 5 | export(BackupQueueDateTime) 6 | export(BackupQueueIndex) 7 | export(Cache) 8 | export(DirectoryQueue) 9 | export(backup) 10 | export(backup_date) 11 | export(backup_info) 12 | export(backup_time) 13 | export(list_backups) 14 | export(n_backups) 15 | export(newest_backup) 16 | export(oldest_backup) 17 | export(prune_backups) 18 | export(prune_identical_backups) 19 | export(rotate) 20 | export(rotate_date) 21 | export(rotate_rds) 22 | export(rotate_rds_date) 23 | export(rotate_rds_time) 24 | export(rotate_time) 25 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # rotor 0.3.7 2 | 3 | * Some internal changes to date formatting for compatibility with 4 | R-devel revision >= r82904 (2022-09-24 19:32:52). 5 | 6 | 7 | # rotor 0.3.6 8 | 9 | * `rotate()`, `backup()` and co. no longer fail on filenames that 10 | contain special regex characters (such as `*` or `+`) 11 | * `rotate()`, `backup()` and co. now work with hidden files 12 | * `rotate_rds`: the `on_change_only` argument now also accepts a `list()` of 13 | paramters to be passed on to `all.equal.data.table` when comparing `data.tables` 14 | * rebuild docs for R 4.2.0 15 | 16 | 17 | # rotor 0.3.5 18 | 19 | * Backups now retain their original timestamp (created, last modified) where 20 | possible (even when zipped) 21 | * fixed broken behaviour when pruning with max_backups where max_backups is 22 | the maximum number of files 23 | * `parse_size()` now accepts (and rounds down) decimal file sizes, but throws 24 | a warning 25 | 26 | # rotor 0.3.4 27 | 28 | * Hotfix for some tests related to the `Cache` R6 class that fail on systems 29 | with low-precision file system timestamps (such as ext3 and old Windows 30 | file systems) 31 | 32 | # rotor 0.3.2 33 | 34 | * fixes time zone related issue in `Cache$prune()`. 35 | * fixes bug in `rotate_rds(on_change_only = TRUE)` that occurs if a version 36 | of data.table < 1.3.0 is installed and either the source or target object are a 37 | `data.table` (but not both) 38 | * more robust clean up of temporary files in most unit tests 39 | 40 | 41 | # rotor 0.3.0 42 | 43 | * Improved some error messages 44 | * Added `rotate_rds()`, `rotate_rds_time()`, and `rotate_rds_date()` as a 45 | replacement for `base::saveRDS()` that supports creating backups instead of 46 | just overwriting the destination file. 47 | * added `Cache`, an R6 class for managing cache directories. The `Cache` API 48 | is still experimental and might change. 49 | * **breaking** R6 API: renamed some methods and active fields of BackupQueue to 50 | more universal names: 51 | - `$push_backup()` -> `$push()` 52 | - `$backup_dir` -> `dir()` 53 | - `$backups` -> `$files` 54 | - `$file` -> `$origin` 55 | * `BackupQueue$prune_identical()` removes identical backups for a BackupQueue 56 | 57 | 58 | # rotor 0.2.4 59 | 60 | * Fixes unit tests sensitive to year change. 61 | 62 | 63 | # rotor 0.2.3 64 | 65 | * Changed default behavior of `rotate_date()`, `rotate_time()`, etc...: If 66 | no backups exist of target file, use the "created" timestamp 67 | to determine whether rotation should take place or not. 68 | * `verbose == TRUE` now also displays information on why rotation was NOT 69 | triggered. 70 | * added `backup_info()` which is similar to `file.info()` but with additional 71 | backup related infos. 72 | * removed `"dir"` column from `$backups`/`backup_info()` 73 | 74 | 75 | # rotor 0.2.2 76 | 77 | * Reordered the arguments of `rotate_*()` and `backup_*()` for more consistency 78 | * default `size` for all all `rotate_*()` and `backup_*()` functions is now 79 | `1` (Byte). This means empty files are never rotated by default. 80 | * added support for `Inf` `size` and `age` (= never rotate) 81 | * More robust regex for discovering backups of files 82 | * R6 API: BackupQueue subclasses gain a `should_rotate(...)` method that 83 | determines whether rotation/backup should take place. 84 | * R6 API: BackupQueueDate and BackupQueueDateTime now have a caching mechanism 85 | for backups (defaults to `FALSE`). 86 | * R6 API: BackupQueue* now use setters/getters for all fields. 87 | 88 | 89 | # rotor 0.2.1 90 | 91 | * added examples to `rotate()` documentation 92 | * `dry_run` status is now tracked internally instead of a potentially user 93 | modifiable `option()` (it was never designed to be user modifiable anyways). 94 | * Track test coverage with covr 95 | * Added a `NEWS.md` file to track changes to the package. 96 | -------------------------------------------------------------------------------- /R/Cache.R: -------------------------------------------------------------------------------- 1 | # Cache ---------------------------------------------------------------- 2 | 3 | #' An R6 class for managing a persistent file-based cache 4 | #' 5 | #' @description 6 | #' `Cache` provides an [R6][R6::R6Class] API for managing an on-disk key-value 7 | #' store for \R objects. The objects are serialized to a single folder as 8 | #' [.rds][readRDS()] files and the key of the object equals the name of the file. 9 | #' `Cache` supports automatic removal of old files if the cache folder exceeds a 10 | #' predetermined number of files, total size, or if the individual files exceed 11 | #' a certain age. 12 | #' 13 | #' @template r6_api 14 | #' 15 | #' @field dir a `character` scalar. path of the directory in which to store the cache files 16 | #' @field n `integer` scalar: number of files in the cache 17 | #' 18 | #' @export 19 | Cache <- R6::R6Class( 20 | "Cache", 21 | cloneable = FALSE, 22 | inherit = DirectoryQueue, 23 | public = list( 24 | #' 25 | #' @param create_dir `logical` scalar. If `TRUE` `dir` is created if it 26 | #' does not exist. 27 | #' 28 | #' @examples 29 | #' td <- file.path(tempdir(), "cache-test") 30 | #' 31 | #' # When using a real hash function as hashfun, identical objects will only 32 | #' # be added to the cache once 33 | #' cache_hash <- Cache$new(td, hashfun = digest::digest) 34 | #' cache_hash$push(iris) 35 | #' cache_hash$push(iris) 36 | #' cache_hash$files 37 | #' cache_hash$purge() 38 | #' 39 | #' # To override this behaviour use a generator for unique ids, such as uuid 40 | #' if (requireNamespace("uuid")){ 41 | #' cache_uid <- Cache$new(td, hashfun = function(x) uuid::UUIDgenerate()) 42 | #' cache_uid$push(iris) 43 | #' cache_uid$push(iris) 44 | #' cache_uid$files 45 | #' cache_uid$purge() 46 | #' } 47 | #' 48 | #' unlink(td, recursive = TRUE) 49 | initialize = function( 50 | dir = dirname(file), 51 | max_files = Inf, 52 | max_size = Inf, 53 | max_age = Inf, 54 | compression = TRUE, 55 | hashfun = digest::digest, 56 | create_dir = TRUE 57 | ){ 58 | self$set_dir(dir, create = create_dir) 59 | self$set_max_files(max_files) 60 | self$set_max_size(max_size) 61 | self$set_max_age(max_age) 62 | self$set_hashfun(hashfun) 63 | self$set_compression(compression) 64 | self 65 | }, 66 | 67 | #' @description push a new object to the cache 68 | #' 69 | #' @param x any \R object 70 | #' @param key a `character` scalar. Key under which to store the cached 71 | #' object. Must be a valid filename. Defaults to being generated by 72 | #' `$hashfun()` but may also be supplied manually. 73 | #' 74 | #' @return a `character` scalar: the key of the newly added object 75 | push = function( 76 | x, 77 | key = self$hashfun(x) 78 | ){ 79 | assert( 80 | is_scalar(key), 81 | ValueError(paste0( 82 | "`key` must be a scalar, not ", preview_object(key), ". Did you set a", 83 | " custom `$hashfun` that can return vectors of length > 1?" 84 | )) 85 | ) 86 | assert(dir.exists(self$dir), DirDoesNotExistError(dir = self$dir)) 87 | 88 | saveRDS(x, file = file.path(self$dir, key), compress = self$compression) 89 | self$prune() 90 | key 91 | }, 92 | 93 | #' @description read a cached file 94 | #' @param key `character` scalar. key of the cached file to read. 95 | read = function( 96 | key 97 | ){ 98 | path <- file.path(self$dir, key) 99 | assert( 100 | file.exists(path), 101 | "'", key, "' does not exist in ", self$dir 102 | ) 103 | readRDS(file.path(self$dir, key)) 104 | }, 105 | 106 | #' @description remove a single file from the cache 107 | #' @param key `character` scalar. key of the cached file to remove 108 | remove = function( 109 | key 110 | ){ 111 | unlink(file.path(self$dir, key)) 112 | invisible(NULL) 113 | }, 114 | 115 | #' @description Read and remove a single file from the cache 116 | #' @param key `character` scalar. key of the cached file to read/remove 117 | pop = function( 118 | key 119 | ){ 120 | res <- self$read(key) 121 | self$remove(key) 122 | res 123 | }, 124 | 125 | #' @description Prune the cache 126 | #' 127 | #' Delete cached objects that match certain criteria. `max_files` and 128 | #' `max_size` deletes the oldest cached objects first; however, this is 129 | #' dependent on accuracy of the file modification timestamps on your system. 130 | #' For example, ext3 only supports second-accuracy, and some windows 131 | #' version only support timestamps at a resolution of two seconds. 132 | #' 133 | #' If two files have the same timestamp, they are deleted in the lexical 134 | #' sort order of their key. This means that by using a function that 135 | #' generates lexically sortable keys as `hashfun` (such as 136 | #' [ulid::generate()]) you can enforce the correct deletion order. There 137 | #' is no such workaround if you use a real hash function. 138 | #' 139 | #' @param max_files,max_size,max_age see section Active Bindings. 140 | #' @param now a `POSIXct` datetime scalar. The current time (for max_age) 141 | prune = function( 142 | max_files = self$max_files, 143 | max_size = self$max_size, 144 | max_age = self$max_age, 145 | now = Sys.time() 146 | ){ 147 | assert(is.null(max_files) || is.infinite(max_files) || is_n0(max_files)) 148 | files <- self$files 149 | files <- files[order(files$mtime), ] 150 | now <- as.Date(format(now)) 151 | 152 | rem <- list() 153 | 154 | if (!is.null(max_age) && !is.infinite(max_age)){ 155 | rem$age <- list(path = select_prune_files_by_age( 156 | path = files$path, 157 | timestamp = files$mtime, 158 | max_age = max_age, 159 | now = now 160 | )) 161 | } 162 | 163 | if (!is.null(max_size) && !is.infinite(max_size)){ 164 | max_size <- parse_size(max_size) 165 | files$cumsize <- rev(cumsum(rev(files$size))) 166 | rem$size <- files[files$cumsize > max_size, ] 167 | } 168 | 169 | if (!is.null(max_files) && self$n > max_files){ 170 | rem$n <- self$files[1L:(self$n - max_files),] 171 | } 172 | 173 | if (length(rem)){ 174 | to_remove <- unlist(lapply(rem, `[[`, "path"), use.names = FALSE) 175 | file.remove(to_remove) 176 | } 177 | 178 | invisible(self) 179 | }, 180 | 181 | #' @description purge the cache (remove all cached files) 182 | purge = function( 183 | ){ 184 | unlink(self$files$path) 185 | invisible(self) 186 | }, 187 | 188 | 189 | #' @description purge the cache (remove all cached files) 190 | destroy = function( 191 | ){ 192 | files <- list.files(self$dir, recursive = TRUE, all.files = TRUE, no.. = TRUE) 193 | assert(!length(files), DirIsNotEmptyError(dir = self$dir)) 194 | 195 | unlink(self$dir, recursive = TRUE) 196 | invisible(self) 197 | }, 198 | 199 | 200 | print = function(){ 201 | cat(fmt_class(class(self)[[1]]), "\n\n") 202 | 203 | cat(self$dir) 204 | 205 | if (length(self$files)){ 206 | cat(style_subtle("\t[", self$n, " files; ", fmt_bytes(self$size), "]", sep = "")) 207 | } else { 208 | cat(style_subtle("\t[", fmt_bytes(self$size), "]", sep = "")) 209 | } 210 | 211 | 212 | invisible(self) 213 | }, 214 | 215 | 216 | # ... setters ------------------------------------------------------------- 217 | set_max_files = function( 218 | x 219 | ){ 220 | if (is.infinite(x)) 221 | x <- NULL 222 | 223 | assert(is.null(x) || is_n0(x)) 224 | private[[".max_files"]] <- x 225 | invisible(self) 226 | }, 227 | 228 | 229 | set_max_age = function( 230 | x 231 | ){ 232 | if (!is.null(x)) 233 | x <- NULL 234 | 235 | assert(is.null(x) || is_parsable_rotation_interval(x)) 236 | private[[".max_age"]] <- x 237 | invisible(self) 238 | }, 239 | 240 | 241 | set_max_size = function( 242 | x 243 | ){ 244 | if (is.null(x)) 245 | private[[".max_size"]] <- NULL 246 | else 247 | private[[".max_size"]] <- parse_size(x) 248 | 249 | invisible(self) 250 | }, 251 | 252 | 253 | set_compression = function( 254 | x 255 | ){ 256 | private[[".compression"]] <- x 257 | invisible(self) 258 | }, 259 | 260 | set_hashfun = function( 261 | x 262 | ){ 263 | assert(is.function(x) || is.null(x), "`hashfun` must be a function.") 264 | private[[".hashfun"]] <- x 265 | invisible(self) 266 | } 267 | ), 268 | 269 | 270 | # ... getters ------------------------------------------------------------- 271 | active = list( 272 | #' @field max_files see the `compress` argument of [base::saveRDS()]. 273 | #' **Note**: this differs from the `$compress` argument of [rotate()]. 274 | compression = function(x){ 275 | if (missing(x)) return(get(".compression", envir = private)) 276 | self$set_compression(x) 277 | }, 278 | 279 | 280 | #' @field max_files `integer` scalar: maximum number of files to keep in 281 | #' the cache 282 | max_n = function(x){ 283 | if (missing(x)) return(get(".max_files", envir = private)) 284 | self$set_max_files(x) 285 | }, 286 | 287 | #' @field max_size scalar `integer`, `character` or `Inf`. Delete 288 | #' cached files (starting with the oldest) until the total size of the 289 | #' cache is below `max_size`. `Integers` are interpreted as bytes. You 290 | #' can pass `character` vectors that contain a file size suffix like `1k` 291 | #' (kilobytes), `3M` (megabytes), `4G` (gigabytes), `5T` (terabytes). Instead 292 | #' of these short forms you can also be explicit and use the IEC suffixes 293 | #' `KiB`, `MiB`, `GiB`, `TiB`. In Both cases `1` kilobyte is `1024` bytes, 1 294 | #' `megabyte` is `1024` kilobytes, etc... . 295 | max_size = function(x){ 296 | if (missing(x)) return(get(".max_size", envir = private)) 297 | self$set_max_size(x) 298 | }, 299 | 300 | #' @field max_age 301 | #' - a `Date` scalar: Remove all backups before this date 302 | #' - a `character` scalar representing a Date in ISO format (e.g. `"2019-12-31"`) 303 | #' - a `character` scalar representing an Interval in the form `" "` (see [rotate()]) 304 | max_age = function(x){ 305 | if (missing(x)) return(get(".max_age", envir = private)) 306 | self$set_max_age(x) 307 | }, 308 | 309 | 310 | #' @field hashfun `NULL` or a `function` to generate a unique hash from the 311 | #' object to be cached (see example). The hash *must* be a text string 312 | #' that is a valid filename on the target system. If `$hashfun` is `NULL`, 313 | #' a storage key must be supplied manually in `cache$push()`. If a new 314 | #' object is added with the same key as an existing object, the existing 315 | #' object will be overwritten without warning. 316 | hashfun = function(fun){ 317 | if (missing(fun)){ 318 | res <- get(".hashfun", envir = private) 319 | if (is.null(res)) 320 | stop("$hashfun is `NULL`. Please supply the key manually or set an $hashfun.") 321 | return(res) 322 | } 323 | 324 | self$set_hashfun(fun) 325 | }, 326 | 327 | 328 | #' All cached files 329 | #' @return a `data.frame` with a similar structure to what 330 | #' [base::file.info()] returns 331 | files = function(){ 332 | 333 | files <- list.files(self$dir, full.names = TRUE, all.files = TRUE, no.. = TRUE) 334 | 335 | if (!length(files)){ 336 | return(EMPTY_CACHE_INDEX) 337 | } 338 | 339 | finfo <- file.info(files) 340 | 341 | res <- cbind( 342 | data.frame(path = rownames(finfo), stringsAsFactors = FALSE), 343 | data.frame(key = basename(rownames(finfo)), stringsAsFactors = FALSE), 344 | finfo 345 | ) 346 | row.names(res) <- NULL 347 | 348 | assert(!is.null(res$mtime)) 349 | res[order(res$mtime, res$key), ] 350 | }, 351 | 352 | size = function(){ 353 | sum(self$files$size) 354 | } 355 | ), 356 | 357 | private = list( 358 | .file = NULL, 359 | .dir = NULL, 360 | .max_files = NULL, 361 | .max_size = NULL, 362 | .max_age = NULL, 363 | .compression = NULL, 364 | .max_backups = NULL, 365 | .hashfun = NULL 366 | ) 367 | ) 368 | 369 | 370 | 371 | EMPTY_CACHE_INDEX <- 372 | structure( 373 | list( 374 | path = character(0), 375 | key = character(0), 376 | size = numeric(0), 377 | isdir = logical(0), 378 | mode = structure(integer(0), class = "octmode"), 379 | mtime = structure(numeric(0), class = c("POSIXct", "POSIXt")), 380 | ctime = structure(numeric(0), class = c("POSIXct", "POSIXt")), 381 | atime = structure(numeric(0), class = c("POSIXct", "POSIXt")), 382 | uid = integer(0), 383 | gid = integer(0), 384 | uname = character(0), 385 | grname = character(0) 386 | ), 387 | row.names = integer(0), 388 | class = "data.frame" 389 | ) 390 | -------------------------------------------------------------------------------- /R/DirectoryQueue.R: -------------------------------------------------------------------------------- 1 | # DirectoryQueue -------------------------------------------------------------- 2 | 3 | #' An R6 class for managing persistent file-based queues (abstract base class) 4 | #' 5 | #' Abstract class from which all other classes in \pkg{rotor} inherit their 6 | #' basic fields and methods. 7 | #' 8 | #' @template r6_api 9 | #' @export 10 | DirectoryQueue <- R6::R6Class( 11 | "DirectoryQueue", 12 | cloneable = FALSE, 13 | public = list( 14 | 15 | initialize = function( 16 | ... 17 | ){ 18 | NotImplementedError() 19 | }, 20 | 21 | 22 | push = function( 23 | x, 24 | ... 25 | ){ 26 | NotImplementedError() 27 | }, 28 | 29 | 30 | prune = function( 31 | x, 32 | ... 33 | ){ 34 | NotImplementedError() 35 | }, 36 | 37 | 38 | # ... setters ------------------------------------------------------------- 39 | set_dir = function( 40 | x, 41 | create = TRUE 42 | ){ 43 | assert(is_scalar_character(x)) 44 | assert(is_scalar_bool(create)) 45 | x <- path_tidy(x) 46 | 47 | if (!file_exists(x)){ 48 | if (create){ 49 | message("creating directory '", x, "'") 50 | dir.create(x, recursive = TRUE) 51 | } else { 52 | stop(DirDoesNotExistError(dir = x)) 53 | } 54 | } 55 | 56 | assert(is_dir(x), PathIsNotADirError(dir = x)) 57 | private[[".dir"]] <- x 58 | self 59 | } 60 | ), 61 | 62 | 63 | # ... getters ------------------------------------------------------------- 64 | active = list( 65 | #' @field dir a `character` scalar. path of the directory in which to store 66 | #' the cache files 67 | dir = function(dir){ 68 | if (missing(dir)) 69 | return(get(".dir", envir = private)) 70 | 71 | self$set_dir(dir, create = FALSE) 72 | }, 73 | 74 | 75 | n = function(){ 76 | nrow(self$files) 77 | }, 78 | 79 | 80 | files = function(){ 81 | 82 | files <- list.files(self$dir, full.names = TRUE, all.files = TRUE, no.. = TRUE,) 83 | 84 | if (!length(files)){ 85 | return(data.frame()) 86 | } 87 | 88 | finfo <- file.info(files) 89 | 90 | res <- cbind( 91 | data.frame(path = rownames(finfo), stringsAsFactors = FALSE), 92 | data.frame(key = basename(rownames(finfo)), stringsAsFactors = FALSE), 93 | finfo 94 | ) 95 | row.names(res) <- NULL 96 | 97 | res[order(res$mtime), ] 98 | } 99 | ), 100 | 101 | private = list( 102 | .dir = NULL 103 | ) 104 | ) 105 | -------------------------------------------------------------------------------- /R/DryRunMemory.R: -------------------------------------------------------------------------------- 1 | # nocov start 2 | # implicitely tested via utils-fs 3 | DryRunMemory <- R6::R6Class( 4 | "DryRunMemory", 5 | public = list( 6 | initialize = function(){ 7 | self$reset() 8 | self$active <- FALSE 9 | self 10 | }, 11 | 12 | # activate/deactivate 13 | active = NULL, 14 | 15 | activate = function(...){ 16 | self$active <- TRUE 17 | self$reset() 18 | self 19 | }, 20 | 21 | deactivate = function(){ 22 | self$active <- FALSE 23 | self$reset() 24 | self 25 | }, 26 | 27 | 28 | list = function(path){ 29 | x <- path_standardize(list.files(path, full.names = TRUE, all.files = TRUE, no.. = TRUE)) 30 | unique(self$fake(x)) 31 | }, 32 | 33 | 34 | # file operations 35 | exists = function(...){ 36 | files <- c(...) 37 | 38 | if (path_standardize(files) %in% self$memory$file){ 39 | path_standardize(files) %in% self$fake(files) 40 | } else { 41 | file.exists(files) 42 | } 43 | }, 44 | 45 | fake = function(x){ 46 | 47 | xt <- path_standardize(x) 48 | 49 | for (i in seq_len(nrow(self$memory))){ 50 | op <- self$memory[i, ] 51 | 52 | if (identical(op$op, "create")){ 53 | x <- c(x, op$file) 54 | xt <- path_standardize(x) 55 | 56 | } else if (identical(op$op, "remove")){ 57 | x <- x[!xt %in% op$file] 58 | xt <- x 59 | } 60 | } 61 | 62 | x 63 | }, 64 | 65 | memory = NULL, 66 | 67 | reset = function(){ 68 | self$memory <- data.frame( 69 | op = character(), 70 | file = character(), 71 | stringsAsFactors = FALSE 72 | ) 73 | }, 74 | 75 | create = function(file){ 76 | assert(is.character(file)) 77 | file <- path_standardize(file) 78 | self$memory <- rbind( 79 | self$memory, 80 | data.frame( 81 | op = "create", 82 | file = file, 83 | stringsAsFactors = FALSE 84 | ) 85 | ) 86 | rep(TRUE, length(file)) 87 | }, 88 | 89 | 90 | remove = function(file){ 91 | assert(is.character(file)) 92 | file <- path_standardize(file) 93 | self$memory <- rbind( 94 | self$memory, 95 | data.frame( 96 | op = "remove", 97 | file = file, 98 | stringsAsFactors = FALSE 99 | ) 100 | ) 101 | rep(TRUE, length(file)) 102 | }, 103 | 104 | move = function(from, to){ 105 | assert(is.character(from)) 106 | assert(is.character(to)) 107 | from <- path_standardize(from) 108 | to <- path_standardize(to) 109 | 110 | self$remove(from) 111 | self$create(to) 112 | rep(TRUE, length(from)) 113 | } 114 | ) 115 | ) 116 | -------------------------------------------------------------------------------- /R/conditions.R: -------------------------------------------------------------------------------- 1 | NotImplementedError <- function( 2 | message = "function not implemented", 3 | ..., 4 | class = NULL, 5 | call = NULL 6 | ){ 7 | error(message, ..., class = c(class, "NotImplementedError")) 8 | } 9 | 10 | 11 | 12 | ValueError <- function( 13 | message, 14 | ..., 15 | class = NULL, 16 | call = NULL 17 | ){ 18 | error(message, ..., class = c(class, "ValueError")) 19 | } 20 | 21 | 22 | 23 | DirIsNotEmptyError <- function( 24 | message = sprintf("directory '%s' does not exist.", dir), 25 | ..., 26 | dir, 27 | class = NULL, 28 | call = NULL 29 | ){ 30 | error(message, ..., class = c(class, "DirIsNotEmptyError"), call = call) 31 | } 32 | 33 | 34 | 35 | DirDoesNotExistError <- function( 36 | message = sprintf("directory '%s' does not exist.", dir), 37 | ..., 38 | dir, 39 | class = NULL, 40 | call = NULL 41 | ){ 42 | error(message, ..., class = c(class, "DirDoesNotExistError"), call = call) 43 | } 44 | 45 | 46 | 47 | PathIsNotADirError <- function( 48 | message = sprintf("'%s' is not a directory.", dir), 49 | ..., 50 | dir, 51 | class = NULL, 52 | call = NULL 53 | ){ 54 | error(message, ..., class = c(class, "PathIsNotADirError"), call = call) 55 | } 56 | 57 | 58 | 59 | NotImplementedError <- function( 60 | message = sprintf("functionality is not yet implemented", dir), 61 | ..., 62 | dir, 63 | class = NULL, 64 | call = NULL 65 | ){ 66 | error(message, ..., class = c(class, "NotImplementedError"), call = call) 67 | } 68 | 69 | 70 | 71 | 72 | ObjectHasNotChangedMessage <- function(message, ..., class = NULL, call = NULL){ 73 | condition( 74 | message = as.character(message), 75 | call = call, 76 | class = union(class, c("ObjectHasNotChangedMessage", "message")) 77 | ) 78 | } 79 | 80 | 81 | 82 | 83 | condition <- function(message, ..., class = NULL, call = NULL){ 84 | structure( 85 | list( 86 | message = as.character(message), 87 | call = call, 88 | ...), 89 | class = union(class, c("condition")) 90 | ) 91 | } 92 | 93 | 94 | 95 | 96 | error <- function(message, ..., class = NULL, call = NULL){ 97 | structure( 98 | list( 99 | message = as.character(message), 100 | call = call, 101 | ...), 102 | class = union(class, c("error", "condition")) 103 | ) 104 | } 105 | -------------------------------------------------------------------------------- /R/copy_or_compress.R: -------------------------------------------------------------------------------- 1 | #' Compress and remove a file 2 | #' 3 | #' Internal helper function used in [backup()] 4 | #' 5 | #' @inheritParams rotate_date 6 | #' @param file `character` scalar. File to copy/compress 7 | #' @param outname `scalar` `character` scalar. name of the target file. 8 | #' @param add_ext `logical` scalar. add `.zip` extensions to `outname` when 9 | #' compressing 10 | #' 11 | #' @noRd 12 | #' 13 | #' @return `character` scalar: path to the compressed file 14 | #' 15 | copy_or_compress <- function( 16 | file, 17 | outname, 18 | compression = FALSE, 19 | add_ext = TRUE, 20 | overwrite = FALSE 21 | ){ 22 | stopifnot( 23 | is_scalar_character(file), 24 | is_scalar_character(outname), 25 | file_exists(file), 26 | is_scalar_logical(overwrite), 27 | is_scalar_logical(add_ext) 28 | ) 29 | 30 | assert( 31 | is_scalar_atomic(compression) && ( 32 | compression %in% c("utils::zip", "zip::zipr") || 33 | compression %in% 1:9 || 34 | is_bool(compression) 35 | ), 36 | '`compression` must be `TRUE`, `FALSE`, or an integer between 1 and 9', 37 | 'or the character scalers "utils::zip" or "zip::zipr" not: ', 38 | preview_object(compression) 39 | ) 40 | 41 | 42 | # init 43 | if (isTRUE(compression)){ 44 | compression <- "utils::zip" 45 | } 46 | 47 | if (!isFALSE(compression)) 48 | outname <- paste0(outname, ".zip") 49 | 50 | if (file_exists(outname)){ 51 | if (overwrite){ 52 | file_remove(outname) 53 | } else { 54 | stop(sprintf("File '%s' exists and `overwrite == FALSE`", outname)) 55 | } 56 | } 57 | 58 | if (compression %in% 1:9){ 59 | compression_level <- compression 60 | compression <- "zip::zipr" 61 | } else { 62 | compression_level <- 9 63 | } 64 | 65 | 66 | # logic 67 | if (DRY_RUN$active || isFALSE(compression)){ 68 | file_copy(file, outname, overwrite = overwrite) 69 | 70 | } else if (identical(compression, "zip::zipr")){ 71 | assert_namespace("zip") 72 | msg_file_copy(file, outname) 73 | zip::zipr(outname, file) 74 | 75 | } else if (identical(compression, "utils::zip")){ 76 | owd <- setwd(dir = dirname(file)) 77 | on.exit(setwd(owd)) 78 | utils::zip(outname, files = basename(file), flags="-q") 79 | 80 | } else { 81 | stop("should not be possible to arrive here") 82 | } 83 | 84 | Sys.setFileTime(outname, file.mtime(file)) 85 | outname 86 | } 87 | -------------------------------------------------------------------------------- /R/list_backups.R: -------------------------------------------------------------------------------- 1 | #' Discover existing backups 2 | #' 3 | #' These function return information on the backups of a file (if any exist) 4 | #' 5 | #' @param file `character` scalar: Path to a file. 6 | #' @inheritSection rotate Intervals 7 | #' @inheritParams rotate 8 | #' @export 9 | #' @seealso [rotate()] 10 | #' @examples 11 | #' # setup example files 12 | #' tf <- tempfile("test", fileext = ".rds") 13 | #' saveRDS(cars, tf) 14 | #' backup(tf) 15 | #' backup(tf) 16 | #' 17 | #' backup_info(tf) 18 | #' list_backups(tf) 19 | #' n_backups(tf) 20 | #' newest_backup(tf) 21 | #' oldest_backup(tf) 22 | #' 23 | #' # cleanup 24 | #' prune_backups(tf, 0) 25 | #' n_backups(tf) 26 | #' file.remove(tf) 27 | #' @export 28 | #' @return `backup_info()` returns a `data.frame` similar to the output of 29 | #' [file.info()] 30 | backup_info <- function( 31 | file, 32 | dir = dirname(file) 33 | ){ 34 | if (is_pure_BackupQueueIndex(file, dir = dir)) 35 | BackupQueueIndex$new(file, dir = dir)$files 36 | else if (is_pure_BackupQueueDateTime(file, dir = dir)) 37 | BackupQueueDateTime$new(file, dir = dir)$files 38 | else 39 | BackupQueue$new(file, dir = dir)$files 40 | } 41 | 42 | 43 | 44 | 45 | #' @export 46 | #' @return `list_backups()` returns the paths to all backups of `file` 47 | #' @rdname backup_info 48 | list_backups <- function( 49 | file, 50 | dir = dirname(file) 51 | ){ 52 | BackupQueue$new(file, dir = dir)$files$path 53 | } 54 | 55 | 56 | 57 | #' @rdname backup_info 58 | #' @export 59 | #' @return `n_backups()` returns the number of backups of `file` as an `integer` 60 | #' scalar 61 | n_backups <- function( 62 | file, 63 | dir = dirname(file) 64 | ){ 65 | if (!is_pure_BackupQueue(file, dir = dir)){ 66 | warning( 67 | "Found index as well as timestamped backups for '", file, "'. ", 68 | "This is fine, but some rotor functions might not work as expected", 69 | "on such files.", 70 | call. = FALSE 71 | ) 72 | } 73 | BackupQueue$new(file, dir = dir)$n 74 | } 75 | 76 | 77 | 78 | 79 | #' @return `newest_backup()` and `oldest_backup()` return the paths to the 80 | #' newest or oldest backup of `file` (or an empty `character` vector if none exist) 81 | #' @export 82 | #' @rdname backup_info 83 | newest_backup <- function( 84 | file, 85 | dir = dirname(file) 86 | ){ 87 | bq <- BackupQueue$new(file, dir = dir) 88 | if (!bq$has_backups){ 89 | return(character()) 90 | } 91 | 92 | assert( 93 | is_pure_BackupQueueIndex(file, dir = dir) || 94 | is_pure_BackupQueueDateTime(file, dir = dir), 95 | "Can only determine newest backup for files that only have either indexed ", 96 | "or timestamped backups, but '", file, "' has both:\n", 97 | paste("~ ", bq$files$path, collapse = "\n") 98 | ) 99 | 100 | bq <- BackupQueueDateTime$new(file, dir = dir) 101 | 102 | if (!bq$has_backups){ 103 | bq <- BackupQueueIndex$new(file, dir = dir) 104 | } 105 | 106 | first(bq$files$path) 107 | } 108 | 109 | 110 | 111 | 112 | #' @export 113 | #' @rdname backup_info 114 | oldest_backup <- function( 115 | file, 116 | dir = dirname(file) 117 | ){ 118 | bq <- BackupQueue$new(file, dir = dir) 119 | if (!bq$has_backups){ 120 | return(character()) 121 | } 122 | 123 | assert( 124 | is_pure_BackupQueueIndex(file, dir = dir) || 125 | is_pure_BackupQueueDateTime(file, dir = dir), 126 | "Can only determine newest backup for files that only have either indexed ", 127 | "or timestamped backups, but '", file, "' has both:\n", 128 | paste("~ ", bq$files$path, collapse = "\n") 129 | ) 130 | 131 | bq <- BackupQueueDateTime$new(file, dir = dir) 132 | 133 | if (!bq$has_backups){ 134 | bq <- BackupQueueIndex$new(file, dir = dir) 135 | } 136 | 137 | last(bq$files$path) 138 | } 139 | -------------------------------------------------------------------------------- /R/parsers.R: -------------------------------------------------------------------------------- 1 | #' @param x `character` scalar (`1k`, `1.5g`) etc 2 | #' @return a `numeric` scalar (can be `double` or `integer`) 3 | #' @noRd 4 | #' 5 | parse_size <- function(x){ 6 | if (is.infinite(x)) return(x) 7 | assert(is_scalar(x) && !is.na(x)) 8 | 9 | if (is_integerish(x)){ 10 | res <- as.integer(x) 11 | } else if (is.numeric(x)){ 12 | res <- as.integer(floor(x)) 13 | warning("`x` ist not an integer file size, rounding down to ", res, " bits") 14 | 15 | } else if (is.character(x)){ 16 | unit_start <- regexec("[kmgt]", tolower(x))[[1]] 17 | num <- trimws(substr(x, 1, unit_start - 1L)) 18 | unit <- trimws(substr(x, unit_start, nchar(x))) 19 | res <- as.numeric(num) * parse_info_unit(unit) 20 | 21 | } else { 22 | stop(ValueError(paste("`x` is not a valid file size but ", preview_object(x)))) 23 | } 24 | 25 | assert(is_scalar(res) && !is.na(res) && is_scalar_numeric(res)) 26 | res 27 | } 28 | 29 | 30 | 31 | 32 | #' @param x a `character` scalar, see the `size` argument of `rotate()` 33 | #' @return an `integer` scalar (bytes) 34 | #' @noRd 35 | parse_info_unit <- function(x){ 36 | assert(is_scalar_character(x)) 37 | x <- tolower(x) 38 | 39 | iec <- c("kib", "mib", "gib", "tib", "kb", "mb", "gb", "tb") 40 | 41 | if (x %in% iec) 42 | x <- substr(x, 1, 1) 43 | 44 | valid_units <- c("k", "m", "g", "t") 45 | 46 | assert( 47 | x %in% valid_units, 48 | "'", x, "' is not one of the following valid file size units: ", 49 | paste(c(valid_units, iec), collapse = ", ") 50 | ) 51 | 52 | res <- switch( 53 | tolower(x), 54 | k = 2^10, 55 | m = 2^20, 56 | g = 2^30, 57 | t = 2^40, 58 | NULL 59 | ) 60 | 61 | assert( 62 | !is.null(res), 63 | "Something went wrong when parsing the unit of information. ", 64 | "Please file a bug report" 65 | ) 66 | res 67 | } 68 | 69 | 70 | 71 | 72 | # datetime ---------------------------------------------------------------- 73 | 74 | parse_date <- function(x){ 75 | if (is_Date(x)){ 76 | return(x) 77 | 78 | } else if (is_POSIXct(x)){ 79 | return(as.Date(format(x))) 80 | 81 | } else if (!is.character(x) && !is_integerish(x)) { 82 | stop( 83 | "`", deparse(substitute(x)), "` must be a character or Date, ", 84 | "not ", preview_object(x), call. = FALSE 85 | ) 86 | } 87 | 88 | x <- standardize_date_stamp(x) 89 | x <- prep_ymd(x) 90 | res <- as.Date(x) 91 | 92 | assert(!anyNA(res)) 93 | res 94 | } 95 | 96 | 97 | 98 | 99 | parse_datetime <- function(x){ 100 | if (is_POSIXct(x)){ 101 | return(x) 102 | } else if (is_Date(x)) { 103 | return(as.POSIXct(format(x))) 104 | } else if (!is.character(x) && !is_integerish(x)) { 105 | stop( 106 | "`", deparse(substitute(x)), "` must be a character, Date, or POSIXt, ", 107 | "not ", preview_object(x), call. = FALSE 108 | ) 109 | } 110 | 111 | x <- standardize_datetime_stamp(x) 112 | 113 | dd <- strsplit_at_pos(x, 8) 114 | dd[, 1] <- prep_ymd(dd[, 1]) 115 | dd[, 2] <- prep_hms(dd[, 2]) 116 | 117 | res <- as.POSIXct(paste(dd[, 1], dd[, 2])) 118 | assert(!anyNA(res)) 119 | res 120 | } 121 | 122 | 123 | 124 | 125 | prep_ymd <- function(.x){ 126 | assert(all(nchar(.x) %in% c(8, 6, 4))) 127 | y <- substr(.x, 1, 4) 128 | m <- ifelse(nchar(.x) > 4, substr(.x, 5, 6), "01") 129 | d <- ifelse(nchar(.x) > 6, substr(.x, 7, 8), "01") 130 | paste(y, m, d, sep = "-") 131 | } 132 | 133 | 134 | 135 | 136 | prep_hms <- function(.x){ 137 | assert(all(nchar(.x) %in% c(0, 2, 4, 6))) 138 | h <- ifelse(!is_blank(.x) , substr(.x, 1, 2), "00") 139 | m <- ifelse(nchar(.x) > 2, substr(.x, 3, 4), "00") 140 | s <- ifelse(nchar(.x) > 4, substr(.x, 5, 6), "00") 141 | paste(h, m, s, sep = ":") 142 | } 143 | 144 | 145 | 146 | 147 | standardize_datetime_stamp <- function(x){ 148 | gsub("T|-|_|\\s", "", format(x)) 149 | } 150 | 151 | 152 | 153 | 154 | standardize_date_stamp <- function(x){ 155 | gsub("-|_|\\s", "", format(x)) 156 | } 157 | 158 | 159 | 160 | 161 | 162 | # rotation interval ------------------------------------------------------- 163 | 164 | 165 | parse_rotation_interval <- function(x){ 166 | if (is_rotation_interval(x)) 167 | return(x) 168 | 169 | assert(is_scalar(x) && !is.na(x)) 170 | 171 | if (is.infinite(x)) 172 | return(rotation_interval(value = Inf, unit = "day")) 173 | 174 | if (is_integerish(x)){ 175 | return(rotation_interval(value = as.integer(x), unit = "day")) 176 | } else { 177 | assert(is.character(x)) 178 | } 179 | 180 | splt <- strsplit(x, "\\s")[[1]] 181 | assert(identical(length(splt), 2L)) 182 | 183 | value <- splt[[1]] 184 | unit <- splt[[2]] 185 | 186 | valid_units <- c("day", "week", "month", "quarter", "year") 187 | unit <- gsub("s$", "", tolower(trimws(unit))) 188 | 189 | assert(unit %in% valid_units) 190 | value <- as.integer(value) 191 | assert(!is.na(value)) 192 | 193 | rotation_interval(value = value, unit = unit) 194 | } 195 | 196 | 197 | 198 | 199 | rotation_interval <- function(value, unit){ 200 | structure(list(value = value, unit = unit), class = "rotation_interval") 201 | } 202 | 203 | 204 | 205 | 206 | is_rotation_interval <- function( 207 | x 208 | ){ 209 | inherits(x, "rotation_interval") 210 | } 211 | -------------------------------------------------------------------------------- /R/rotate.R: -------------------------------------------------------------------------------- 1 | #' Rotate or backup files 2 | #' 3 | #' @description 4 | #' Functions starting with `backup` create backups of a `file`, while functions 5 | #' starting with `rotate` do the same but also replace the original `file` 6 | #' with an empty one (this is useful for log rotation) 7 | #' 8 | #' **Note:**: `rotate()` and co will not work reliable on filenames that contain 9 | #' dots but have no file extension (e.g. `my.holiday.picture.jpg` is OK but 10 | #' `my.holiday.picture` is not) 11 | #' 12 | #' 13 | #' @param file `character` scalar: file to backup/rotate 14 | #' 15 | #' @param age minimum age after which to backup/rotate a file; can be 16 | #' - a `character` scalar representing an Interval in the form 17 | #' `" "` (e.g. `"2 months"`, see *Intervals* section below). 18 | #' - a `Date` or a `character` scalar representing a Date for 19 | #' a fixed point in time after which to backup/rotate. See `format` for 20 | #' which Date/Datetime formats are supported by rotor. 21 | #' 22 | #' (if `age` *and* `size` are provided, both criteria must be `TRUE` to 23 | #' trigger rotation) 24 | #' @param format a scalar `character` that can be a subset of of valid 25 | #' `strftime()` formatting strings. The default setting is 26 | #' `"%Y-%m-%d--%H-%M-%S"`. 27 | #' * You can use an arbitrary number of dashes anywhere in the format, so 28 | #' `"%Y-%m-%d--%H-%M-%S"` and `"%Y%m%d%H%M%S"` are both legal. 29 | #' * `T` and `_` can also be used as separators. For example, the following 30 | #' datetime formats are also possible: 31 | #' `%Y-%m-%d_%H-%M-%S` (Python logging default), 32 | #' `%Y%m%dT%H%M%S` ([ISO 8601](https://en.wikipedia.org/wiki/ISO_8601)) 33 | #' * All datetime components except `%Y` are optional. If you leave out part 34 | #' of the timestamp, the first point in time in the period is assumed. For 35 | #' example (assuming the current year is 2019) `%Y` is identical to 36 | #' `2019-01-01--00-00-00`. 37 | #' * The timestamps must be lexically sortable, so `"%Y-%m-%d"` is legal, 38 | #' `"%m-%d-%Y"` and `%Y-%d` are not. 39 | #' 40 | #' @param now The current `Date` or time (`POSIXct`) as a scalar. You can pass a 41 | #' custom value here to to override the real system time. As a convenience you 42 | #' can also pass in `character` strings that follow the guidelines outlined 43 | #' above for `format`, but please note that these differ from the formats 44 | #' understood by [as.POSIXct()] or [as.Date()]. 45 | #' 46 | #' @param max_backups maximum number of backups to keep 47 | #' - an `integer` scalar: Maximum number of backups to keep 48 | #' 49 | #' In addition for timestamped backups the following value are supported: 50 | #' - a `Date` scalar: Remove all backups before this date 51 | #' - a `character` scalar representing a Date in ISO format (e.g. `"2019-12-31"`) 52 | #' - a `character` scalar representing an Interval in the form `" "` (see below for more info) 53 | #' 54 | #' @param size scalar `integer`, `character` or `Inf`. Backup/rotate only if 55 | #' `file` is larger than this size. `Integers` are interpreted as bytes. You 56 | #' can pass `character` vectors that contain a file size suffix like `1k` 57 | #' (kilobytes), `3M` (megabytes), `4G` (gigabytes), `5T` (terabytes). Instead 58 | #' of these short forms you can also be explicit and use the IEC suffixes 59 | #' `KiB`, `MiB`, `GiB`, `TiB`. In Both cases `1` kilobyte is `1024` bytes, 1 60 | #' `megabyte` is `1024` kilobytes, etc... . 61 | #' 62 | #' (if `age` *and* `size` are provided, both criteria must be `TRUE` to 63 | #' trigger rotation) 64 | #' 65 | #' @param dir `character` scalar. The directory in which the backups 66 | #' of `file` are stored (defaults to `dirname(file)`) 67 | #' 68 | #' @param compression Whether or not backups should be compressed 69 | #' - `FALSE` for uncompressed backups, 70 | #' - `TRUE` for zip compression; uses [zip()] 71 | #' - a scalar `integer` between `1` and `9` to specify a compression 72 | #' level (requires the 73 | #' [zip](https://CRAN.R-project.org/package=zip) package, 74 | #' see its documentation for details) 75 | #' - the `character` scalars `"utils::zip()"` or `"zip::zipr"` to force a 76 | #' specific zip command 77 | #' 78 | #' @param dry_run `logical` scalar. If `TRUE` no changes are applied to the 79 | #' file system (no files are created or deleted) 80 | #' 81 | #' @param verbose `logical` scalar. If `TRUE` additional informative `messages` 82 | #' are printed 83 | #' 84 | #' @param create_file `logical` scalar. If `TRUE` create an empty file in 85 | #' place of `file` after rotating. 86 | #' 87 | #' @param overwrite `logical` scalar. If `TRUE` overwrite backups if a backup 88 | #' of the same name (usually due to timestamp collision) exists. 89 | #' 90 | #' @return `file` as a `character` scalar (invisibly) 91 | #' 92 | #' @section Side Effects: 93 | #' `backup()`, `backup_date()`, and `backup_time()` may create files (if the 94 | #' specified conditions are met). They may also delete backups, based on 95 | #' `max_backup`. 96 | #' 97 | #' `rotate()`, `rotate_date()` and `rotate_time()` do the same, but in 98 | #' addition delete the input `file`, or replace it with an empty file if 99 | #' `create_file == TRUE` (the default). 100 | #' 101 | #' @section Intervals: 102 | #' 103 | #' In **rotor**, an interval is a character string in the form 104 | #' `" "`. The following intervals are possible: 105 | #' `"day(s)"`, `"week(s)"`, `"month(s)"`, `"quarter(s)"`, `"year(s)"`. 106 | #' The plural `"s"` is optional (so `"2 weeks"` and `"2 week"` are equivalent). 107 | #' Please be aware that weeks are 108 | #' [ISOweeks](https://en.wikipedia.org/wiki/ISO_week_date) 109 | #' and start on Monday (not Sunday as in some countries). 110 | #' 111 | #' Interval strings can be used as arguments when backing up or rotating files, 112 | #' or for pruning backup queues (i.e. limiting the number of backups of a 113 | #' single) file. 114 | #' 115 | #' When rotating/backing up `"1 months"` means "make a new backup if the last 116 | #' backup is from the preceding month". E.g if the last backup of `myfile` 117 | #' is from `2019-02-01` then `backup_time(myfile, age = "1 month")` will only 118 | #' create a backup if the current date is at least `2019-03-01`. 119 | #' 120 | #' When pruning/limiting backup queues, `"1 year"` means "keep at least most 121 | #' one year worth of backups". So if you call 122 | #' `backup_time(myfile, max_backups = "1 year")` on `2019-03-01`, it will create 123 | #' a backup and then remove all backups of `myfile` before `2019-01-01`. 124 | #' @seealso [list_backups()] 125 | #' @export 126 | #' 127 | #' @examples 128 | #' # setup example file 129 | #' tf <- tempfile("test", fileext = ".rds") 130 | #' saveRDS(cars, tf) 131 | #' 132 | #' # create two backups of `tf`` 133 | #' backup(tf) 134 | #' backup(tf) 135 | #' list_backups(tf) # find all backups of a file 136 | #' 137 | #' # If `size` is set, a backup is only created if the target file is at least 138 | #' # that big. This is more useful for log rotation than for backups. 139 | #' backup(tf, size = "100 mb") # no backup becuase `tf` is to small 140 | #' list_backups(tf) 141 | #' 142 | #' # If `dry_run` is TRUE, backup() only shows what would happen without 143 | #' # actually creating or deleting files 144 | #' backup(tf, size = "0.1kb", dry_run = TRUE) 145 | #' 146 | #' # rotate() is the same as backup(), but replaces `tf`` with an empty file 147 | #' rotate(tf) 148 | #' list_backups(tf) 149 | #' file.size(tf) 150 | #' file.size(list_backups(tf)) 151 | #' 152 | #' # prune_backups() can remove old backups 153 | #' prune_backups(tf, 1) # keep only one backup 154 | #' list_backups(tf) 155 | #' 156 | #' # rotate/backup_date() adds a date instead of an index 157 | #' # you should not mix index backups and timestamp backups 158 | #' # so we clean up first 159 | #' prune_backups(tf, 0) 160 | #' saveRDS(cars, tf) 161 | #' 162 | #' # backup_date() adds the date instead of an index to the filename 163 | #' backup_date(tf) 164 | #' 165 | #' # `age` sets the minimum age of the last backup before creating a new one. 166 | #' # the example below creates no new backup since it's less than a week 167 | #' # since the last. 168 | #' backup_date(tf, age = "1 week") 169 | #' 170 | #' # `now` overrides the current date. 171 | #' backup_date(tf, age = "1 year", now = "2999-12-31") 172 | #' list_backups(tf) 173 | #' 174 | #' # backup_time() creates backups with a full timestamp 175 | #' backup_time(tf) 176 | #' 177 | #' # It's okay to mix backup_date() and backup_time() 178 | #' list_backups(tf) 179 | #' 180 | #' # cleanup 181 | #' prune_backups(tf, 0) 182 | #' file.remove(tf) 183 | rotate <- function( 184 | file, 185 | size = 1, 186 | max_backups = Inf, 187 | compression = FALSE, 188 | dir = dirname(file), 189 | create_file = TRUE, 190 | dry_run = FALSE, 191 | verbose = dry_run 192 | ){ 193 | rotate_internal( 194 | file, 195 | size = size, 196 | max_backups = max_backups, 197 | compression = compression, 198 | dir = dir, 199 | create_file = create_file, 200 | dry_run = dry_run, 201 | verbose = verbose, 202 | do_rotate = TRUE 203 | ) 204 | } 205 | 206 | 207 | 208 | 209 | #' @rdname rotate 210 | #' @export 211 | backup <- function( 212 | file, 213 | size = 0, 214 | max_backups = Inf, 215 | compression = FALSE, 216 | dir = dirname(file), 217 | dry_run = FALSE, 218 | verbose = dry_run 219 | ){ 220 | rotate_internal( 221 | file, 222 | size = size, 223 | max_backups = max_backups, 224 | compression = compression, 225 | dir = dir, 226 | dry_run = dry_run, 227 | verbose = verbose, 228 | create_file = FALSE, 229 | do_rotate = FALSE 230 | ) 231 | } 232 | 233 | 234 | 235 | 236 | rotate_internal <- function( 237 | file, 238 | size, 239 | max_backups, 240 | compression, 241 | create_file, 242 | dir, 243 | dry_run, 244 | verbose, 245 | do_rotate 246 | ){ 247 | stopifnot( 248 | is_scalar_bool(do_rotate), 249 | is_scalar_bool(dry_run), 250 | is_scalar_bool(verbose), 251 | is_scalar_bool(create_file) 252 | ) 253 | 254 | assert_pure_BackupQueue(file, dir = dir, warn_only = TRUE) 255 | 256 | if (dry_run){ 257 | DRY_RUN$activate() 258 | on.exit(DRY_RUN$deactivate()) 259 | } 260 | 261 | bq <- BackupQueueIndex$new( 262 | file, 263 | dir = dir, 264 | max_backups = max_backups, 265 | compression = compression 266 | ) 267 | 268 | if (bq$should_rotate(size = size, verbose = verbose)){ 269 | bq$push() 270 | } else { 271 | do_rotate <- FALSE 272 | } 273 | 274 | 275 | bq$prune(max_backups) 276 | 277 | if (do_rotate){ 278 | file_remove(file) 279 | 280 | if (create_file) 281 | file_create(file) 282 | } 283 | 284 | 285 | invisible(file) 286 | } 287 | 288 | 289 | 290 | 291 | #' @description `prune_backups()` physically deletes all backups of a file 292 | #' based on `max_backups` 293 | #' @section Side Effects: 294 | #' `prune_backups()` may delete files, depending on `max_backups`. 295 | #' @export 296 | #' @rdname rotate 297 | prune_backups <- function( 298 | file, 299 | max_backups, 300 | dir = dirname(file), 301 | dry_run = FALSE, 302 | verbose = dry_run 303 | ){ 304 | assert_pure_BackupQueue(file, dir = dir) 305 | assert(is_scalar_character(file)) 306 | 307 | if (dry_run){ 308 | DRY_RUN$activate() 309 | on.exit(DRY_RUN$deactivate()) 310 | } 311 | 312 | bq <- BackupQueueIndex$new(file, dir = dir) 313 | 314 | if (!bq$has_backups) 315 | bq <- BackupQueueDateTime$new(file, dir = dir) 316 | 317 | bq$prune(max_backups = max_backups) 318 | invisible(file) 319 | } 320 | 321 | 322 | 323 | 324 | #' @description `prune_backups()` physically deletes all backups of a file 325 | #' based on `max_backups` 326 | #' @section Side Effects: 327 | #' `prune_backups()` may delete files, depending on `max_backups`. 328 | #' @export 329 | #' @rdname rotate 330 | prune_identical_backups <- function( 331 | file, 332 | dir = dirname(file), 333 | dry_run = FALSE, 334 | verbose = dry_run 335 | ){ 336 | assert_pure_BackupQueue(file, dir = dir) 337 | assert(is_scalar_character(file)) 338 | 339 | if (dry_run){ 340 | DRY_RUN$activate() 341 | on.exit(DRY_RUN$deactivate()) 342 | } 343 | 344 | bq <- BackupQueueIndex$new(file, dir = dir) 345 | 346 | if (!bq$has_backups) 347 | bq <- BackupQueueDateTime$new(file, dir = dir) 348 | 349 | bq$prune_identical() 350 | invisible(file) 351 | } 352 | -------------------------------------------------------------------------------- /R/rotate_date.R: -------------------------------------------------------------------------------- 1 | #' @rdname rotate 2 | #' @export 3 | rotate_date <- function( 4 | file, 5 | age = 1, 6 | size = 1, 7 | max_backups = Inf, 8 | compression = FALSE, 9 | format = "%Y-%m-%d", 10 | dir = dirname(file), 11 | overwrite = FALSE, 12 | create_file = TRUE, 13 | now = Sys.Date(), 14 | dry_run = FALSE, 15 | verbose = dry_run 16 | ){ 17 | rotate_date_internal( 18 | file = file, 19 | age = age, 20 | format = format, 21 | size = size, 22 | max_backups = max_backups, 23 | compression = compression, 24 | overwrite = overwrite, 25 | dir = dir, 26 | now = now, 27 | dry_run = dry_run, 28 | verbose = verbose, 29 | create_file = create_file, 30 | do_rotate = TRUE 31 | ) 32 | } 33 | 34 | 35 | 36 | 37 | #' @rdname rotate 38 | #' @export 39 | backup_date <- function( 40 | file, 41 | age = 1, 42 | size = 1, 43 | max_backups = Inf, 44 | compression = FALSE, 45 | format = "%Y-%m-%d", 46 | dir = dirname(file), 47 | overwrite = FALSE, 48 | now = Sys.Date(), 49 | dry_run = FALSE, 50 | verbose = dry_run 51 | ){ 52 | rotate_date_internal( 53 | file = file, 54 | age = age, 55 | format = format, 56 | size = size, 57 | max_backups = max_backups, 58 | compression = compression, 59 | overwrite = overwrite, 60 | dir = dir, 61 | now = now, 62 | dry_run = dry_run, 63 | verbose = verbose, 64 | do_rotate = FALSE, 65 | create_file = FALSE 66 | ) 67 | } 68 | 69 | 70 | 71 | 72 | rotate_date_internal <- function( 73 | file, 74 | age, 75 | format, 76 | size, 77 | max_backups, 78 | compression, 79 | overwrite, 80 | create_file, 81 | dir, 82 | now, 83 | do_rotate, 84 | dry_run, 85 | verbose 86 | ){ 87 | stopifnot( 88 | is_scalar_bool(do_rotate), 89 | is_scalar_bool(dry_run), 90 | is_scalar_bool(verbose), 91 | is_scalar_bool(create_file) 92 | ) 93 | 94 | assert_pure_BackupQueue(file, dir = dir, warn_only = TRUE) 95 | 96 | if (dry_run){ 97 | DRY_RUN$activate() 98 | on.exit(DRY_RUN$deactivate()) 99 | } 100 | 101 | bq <- BackupQueueDate$new( 102 | file, 103 | fmt = format, 104 | dir = dir, 105 | compression = compression 106 | ) 107 | 108 | # backup 109 | if (bq$should_rotate(size = size, age = age, now = now, verbose = verbose)){ 110 | bq$push( 111 | now = now, 112 | overwrite = overwrite 113 | ) 114 | } else { 115 | do_rotate <- FALSE 116 | } 117 | 118 | 119 | # prune 120 | bq$prune(max_backups) 121 | 122 | 123 | # rotate 124 | if (do_rotate){ 125 | file_remove(file) 126 | 127 | if (create_file){ 128 | file_create(file) 129 | } 130 | } 131 | 132 | 133 | invisible(file) 134 | } 135 | -------------------------------------------------------------------------------- /R/rotate_rds.R: -------------------------------------------------------------------------------- 1 | #' Serialize R objects to disk (with backup) 2 | #' 3 | #' The `rotate_rds*()` functions are wrappers around [base::saveRDS()][base::readRDS()] that 4 | #' create a backup of the destination file (if it exists) instead of just 5 | #' overwriting it. 6 | #' 7 | #' @note The default value for `age` is different for `rotate_rds_date()` (`-1`) 8 | #' than for [rotate_date()] (`1`) to make it a bit safer. This means if you 9 | #' execute `rotate_date()` twice on the same file on a given day it will 10 | #' silently not rotate the file, while `rotate_rds_date()` will throw an 11 | #' error. 12 | #' 13 | #' @param on_change_only `logical` scalaror a `list`. Rotate only if `object` 14 | #' is different from the object saved in `file`. If a `list`, arguments 15 | #' that will be passed on to `data.table::all.equal` (only when both obects 16 | #' are `data.tables`) 17 | #' 18 | #' @inheritParams base::saveRDS 19 | #' @inheritDotParams rotate 20 | #' @inheritParams rotate_date 21 | #' @inheritDotParams rotate_date 22 | #' @inheritDotParams rotate_time 23 | #' 24 | #' @return the path to `file` (invisibly) 25 | #' @export 26 | #' 27 | #' @examples 28 | #' dest <- tempfile() 29 | #' rotate_rds(iris, dest) 30 | #' rotate_rds(iris, dest) 31 | #' rotate_rds(iris, dest) 32 | #' 33 | #' list_backups(dest) 34 | #' 35 | #' # cleanup 36 | #' unlink(list_backups(dest)) 37 | #' unlink(dest) 38 | #' @rdname rotate_rds 39 | #' @export 40 | rotate_rds <- function( 41 | object, 42 | file = "", 43 | ascii = FALSE, 44 | version = NULL, 45 | compress = TRUE, 46 | refhook = NULL, 47 | ..., 48 | on_change_only = FALSE 49 | ){ 50 | rotate_rds_internal( 51 | object = object, 52 | file = file, 53 | ascii = ascii, 54 | version = version, 55 | compress = compress, 56 | refhook = refhook, 57 | ..., 58 | on_change_only = on_change_only, 59 | fun = rotate 60 | ) 61 | } 62 | 63 | 64 | 65 | #' @rdname rotate_rds 66 | #' @export 67 | rotate_rds_date <- function( 68 | object, 69 | file = "", 70 | ascii = FALSE, 71 | version = NULL, 72 | compress = TRUE, 73 | refhook = NULL, 74 | ..., 75 | age = -1L, 76 | on_change_only = FALSE 77 | ){ 78 | rotate_rds_internal( 79 | object = object, 80 | file = file, 81 | ascii = ascii, 82 | version = version, 83 | compress = compress, 84 | refhook = refhook, 85 | ..., 86 | age = age, 87 | on_change_only = on_change_only, 88 | fun = rotate_date 89 | ) 90 | } 91 | 92 | 93 | 94 | 95 | #' @rdname rotate_rds 96 | #' @export 97 | rotate_rds_time <- function( 98 | object, 99 | file = "", 100 | ascii = FALSE, 101 | version = NULL, 102 | compress = TRUE, 103 | refhook = NULL, 104 | ..., 105 | age = -1L, 106 | on_change_only = FALSE 107 | ){ 108 | rotate_rds_internal( 109 | object = object, 110 | file = file, 111 | ascii = ascii, 112 | version = version, 113 | compress = compress, 114 | refhook = refhook, 115 | ..., 116 | age = age, 117 | on_change_only = on_change_only, 118 | fun = rotate_time 119 | ) 120 | } 121 | 122 | 123 | 124 | 125 | rotate_rds_internal <- function( 126 | object, 127 | file, 128 | ascii, 129 | version, 130 | compress, 131 | refhook, 132 | ..., 133 | on_change_only, 134 | fun 135 | ){ 136 | assert(is_scalar_character(file)) 137 | assert(is_scalar_bool(on_change_only) || is.list(on_change_only)) 138 | 139 | if (file.exists(file)){ 140 | if (isTRUE(on_change_only) || is.list(on_change_only)){ 141 | comp <- readRDS(file) 142 | if (is.list(on_change_only)){ 143 | extra_args <- on_change_only 144 | } else { 145 | extra_args <- list() 146 | } 147 | 148 | if (objects_are_equal(object, comp, extra_args)){ 149 | message(ObjectHasNotChangedMessage("not rotating: object has not changed")) 150 | return(invisible(file)) 151 | } 152 | } 153 | fun(file, ...) 154 | } 155 | 156 | saveRDS( 157 | object = object, 158 | file = file, 159 | ascii = ascii, 160 | version = version, 161 | compress = compress, 162 | refhook = refhook 163 | ) 164 | 165 | invisible(file) 166 | } 167 | 168 | 169 | 170 | 171 | objects_are_equal <- function( 172 | x, 173 | y, 174 | extra_args = NULL 175 | ){ 176 | if (identical(x, y)){ 177 | return(TRUE) 178 | } 179 | 180 | if (inherits(x, "data.table") && inherits(y, "data.table")){ 181 | assert_namespace("data.table") 182 | return(isTRUE(do.call(all.equal, c(list(x, y), extra_args)))) 183 | } 184 | 185 | FALSE 186 | } 187 | -------------------------------------------------------------------------------- /R/rotate_time.R: -------------------------------------------------------------------------------- 1 | #' @rdname rotate 2 | #' @export 3 | rotate_time <- function( 4 | file, 5 | age = -1, 6 | size = 1, 7 | max_backups = Inf, 8 | compression = FALSE, 9 | format = "%Y-%m-%d--%H-%M-%S", 10 | dir = dirname(file), 11 | overwrite = FALSE, 12 | create_file = TRUE, 13 | now = Sys.time(), 14 | dry_run = FALSE, 15 | verbose = dry_run 16 | ){ 17 | rotate_time_internal( 18 | file = file, 19 | age = age, 20 | format = format, 21 | size = size, 22 | max_backups = max_backups, 23 | compression = compression, 24 | overwrite = overwrite, 25 | dir = dir, 26 | now = now, 27 | dry_run = dry_run, 28 | verbose = verbose, 29 | do_rotate = TRUE, 30 | create_file = create_file 31 | ) 32 | } 33 | 34 | 35 | 36 | 37 | #' @rdname rotate 38 | #' @export 39 | backup_time <- function( 40 | file, 41 | age = -1, 42 | size = 1, 43 | max_backups = Inf, 44 | compression = FALSE, 45 | format = "%Y-%m-%d--%H-%M-%S", 46 | dir = dirname(file), 47 | overwrite = FALSE, 48 | now = Sys.time(), 49 | dry_run = FALSE, 50 | verbose = dry_run 51 | ){ 52 | rotate_time_internal( 53 | file = file, 54 | age = age, 55 | format = format, 56 | size = size, 57 | max_backups = max_backups, 58 | compression = compression, 59 | overwrite = overwrite, 60 | dir = dir, 61 | now = now, 62 | dry_run = dry_run, 63 | verbose = verbose, 64 | do_rotate = FALSE, 65 | create_file = FALSE 66 | ) 67 | } 68 | 69 | 70 | 71 | 72 | rotate_time_internal <- function( 73 | file, 74 | age, 75 | format, 76 | size, 77 | max_backups, 78 | compression, 79 | overwrite, 80 | create_file, 81 | dir, 82 | now, 83 | do_rotate, 84 | dry_run, 85 | verbose 86 | ){ 87 | stopifnot( 88 | is_scalar_bool(do_rotate), 89 | is_scalar_bool(dry_run), 90 | is_scalar_bool(verbose), 91 | is_scalar_bool(create_file) 92 | ) 93 | 94 | assert_pure_BackupQueue(file, dir = dir, warn_only = TRUE) 95 | 96 | if (dry_run){ 97 | DRY_RUN$activate() 98 | on.exit(DRY_RUN$deactivate()) 99 | } 100 | 101 | bq <- BackupQueueDateTime$new(file, fmt = format, dir = dir) 102 | 103 | if (bq$should_rotate(size = size, age = age, now = now, verbose = verbose)){ 104 | bq$push( 105 | now = now, 106 | overwrite = overwrite 107 | ) 108 | } else { 109 | do_rotate <- FALSE 110 | } 111 | 112 | bq$prune(max_backups) 113 | 114 | 115 | if (do_rotate){ 116 | file_remove(file) 117 | 118 | if (create_file) 119 | file_create(file) 120 | } 121 | 122 | 123 | invisible(file) 124 | } 125 | 126 | 127 | 128 | 129 | is_backup_time_necessary <- function( 130 | bq, age, now 131 | ){ 132 | if (is.null(age) || !bq$has_backups) 133 | return(TRUE) 134 | 135 | if (is_parsable_datetime(age)) 136 | return(is_backup_older_than_datetime(bq$last_rotation, age)) 137 | 138 | if (is_parsable_rotation_interval(age)) 139 | return(is_backup_older_than_interval(bq$last_rotation, age, now)) 140 | } 141 | -------------------------------------------------------------------------------- /R/rotor-package.R: -------------------------------------------------------------------------------- 1 | #' @keywords internal 2 | "_PACKAGE" 3 | 4 | # The following block is used by usethis to automatically manage 5 | # roxygen namespace tags. Modify with care! 6 | ## usethis namespace: start 7 | ## usethis namespace: end 8 | NULL 9 | 10 | 11 | 12 | 13 | 14 | .onLoad <- function(...){ 15 | 16 | # +- colors ------------------------------------------------------------------ 17 | if (requireNamespace("crayon", quietly = TRUE) && crayon::has_color()){ 18 | 19 | style_error <- crayon::make_style("#BB3333", colors = 256) 20 | style_fatal <- function(...) style_error(crayon::bold(...)) 21 | style_warning <- crayon::make_style("#EEBB50", colors = 256) 22 | style_subtle <- crayon::make_style(grDevices::grey(0.5), grey = TRUE) 23 | style_accent <- crayon::make_style("#ca2c92", colors = 256) 24 | col_nchar <- crayon::col_nchar 25 | 26 | } else { 27 | style_fatal <- function(...) paste(...) 28 | style_error <- style_fatal 29 | style_warning <- style_fatal 30 | style_subtle <- style_fatal 31 | style_accent <- style_fatal 32 | col_nchar <- function(...) nchar(...) 33 | } 34 | 35 | assign("style_fatal", style_fatal, envir = parent.env(environment())) 36 | assign("style_error", style_error, envir = parent.env(environment())) 37 | assign("style_warning", style_warning, envir = parent.env(environment())) 38 | assign("style_subtle", style_subtle, envir = parent.env(environment())) 39 | assign("style_accent", style_accent, envir = parent.env(environment())) 40 | assign("col_nchar", col_nchar, envir = parent.env(environment())) 41 | 42 | # Memory for dry-run operations 43 | assign("DRY_RUN", DryRunMemory$new(), parent.env(environment())) 44 | } 45 | 46 | 47 | 48 | 49 | disable_r6_note <- function(){ 50 | R6::is.R6(NULL) 51 | NULL 52 | } 53 | -------------------------------------------------------------------------------- /R/utils-fs.R: -------------------------------------------------------------------------------- 1 | file_rename <- function( 2 | from, 3 | to, 4 | dry_run = DRY_RUN$active, 5 | verbose = dry_run 6 | ){ 7 | msg_file_rename(from, to, dry_run = dry_run, verbose = verbose) 8 | if (dry_run) { 9 | return(DRY_RUN$move(from, to)) 10 | } 11 | 12 | file.rename(from, to) 13 | } 14 | 15 | 16 | 17 | 18 | #' @param ... passed to file.copy 19 | #' @noRd 20 | file_copy <- function( 21 | from, 22 | to, 23 | ..., 24 | dry_run = DRY_RUN$active, 25 | verbose = dry_run 26 | ){ 27 | msg_file_copy(from, to, dry_run = dry_run, verbose = verbose) 28 | if (dry_run){ 29 | return(DRY_RUN$create(to)) 30 | } 31 | 32 | file.copy(from, to, ..., copy.date = TRUE) 33 | } 34 | 35 | 36 | 37 | 38 | file_create <- function( 39 | ..., 40 | showWarnings = TRUE, 41 | dry_run = DRY_RUN$active, 42 | verbose = dry_run 43 | ){ 44 | msg_file_create(..., dry_run = dry_run, verbose = verbose) 45 | if (dry_run) { 46 | return(DRY_RUN$create(...)) 47 | } 48 | 49 | file.create(..., showWarnings = showWarnings) 50 | } 51 | 52 | 53 | 54 | 55 | file_remove<- function( 56 | ..., 57 | dry_run = DRY_RUN$active, 58 | verbose = dry_run 59 | ){ 60 | msg_file_remove(..., dry_run = dry_run, verbose = verbose) 61 | if (dry_run) { 62 | return(DRY_RUN$remove(...)) 63 | } 64 | 65 | file.remove(...) 66 | } 67 | 68 | 69 | 70 | 71 | file_exists<- function( 72 | ..., 73 | dry_run = DRY_RUN$active, 74 | verbose = dry_run 75 | ){ 76 | if (dry_run) { 77 | return(DRY_RUN$exists(...)) 78 | } 79 | 80 | file.exists(...) 81 | } 82 | 83 | 84 | 85 | 86 | list_files <- function( 87 | path = ".", 88 | full.names = FALSE, 89 | ..., 90 | dry_run = DRY_RUN$active, 91 | verbose = dry_run, 92 | all.files = TRUE, 93 | no.. = TRUE 94 | ){ 95 | if (dry_run) { 96 | res <- DRY_RUN$list(path, ...) 97 | if (!full.names) res <- basename(res) 98 | return(res) 99 | } 100 | 101 | list.files(path = path, full.names = full.names, ..., no.. = no.., all.files = all.files) 102 | } 103 | 104 | 105 | 106 | 107 | msg_file_copy <- function( 108 | from, 109 | to, 110 | dry_run = DRY_RUN$active, 111 | verbose = dry_run 112 | ){ 113 | stopifnot( 114 | is.character(from), 115 | is.character(to), 116 | is_scalar_logical(verbose), 117 | is_scalar_logical(dry_run) 118 | ) 119 | 120 | if (!verbose) return() 121 | 122 | to <- ifelse( 123 | dirname(from) == dirname(to), 124 | basename(to), 125 | to 126 | ) 127 | 128 | message(paste0("[dry_run] "[dry_run], "copying:")) 129 | message(paste0("[dry_run] "[dry_run], "+ ", from , " -> ", to, "\n")) 130 | } 131 | 132 | 133 | 134 | 135 | msg_file_remove <- function( 136 | ..., 137 | dry_run = DRY_RUN$active, 138 | verbose = dry_run 139 | ){ 140 | files <- c(...) 141 | stopifnot( 142 | is.character(files), 143 | is_scalar_logical(verbose), 144 | is_scalar_logical(dry_run) 145 | ) 146 | 147 | if (!verbose) return() 148 | 149 | message(paste0("[dry_run] "[dry_run], "removing:")) 150 | message(paste0("[dry_run] "[dry_run], "- ", files, "\n")) 151 | } 152 | 153 | 154 | 155 | 156 | msg_file_rename <- function( 157 | from, 158 | to, 159 | dry_run = DRY_RUN$active, 160 | verbose = dry_run 161 | ){ 162 | stopifnot( 163 | is.character(from), 164 | is.character(to), 165 | is_scalar_logical(verbose), 166 | is_scalar_logical(dry_run) 167 | ) 168 | 169 | if (!verbose) 170 | return() 171 | 172 | sel <- from != to 173 | from <- from[sel] 174 | to <- to[sel] 175 | 176 | if (!length(from)) 177 | return() 178 | 179 | to <- ifelse( 180 | dirname(from) == dirname(to), 181 | basename(to), 182 | to 183 | ) 184 | 185 | message(paste0("[dry_run] "[dry_run], "renaming:")) 186 | message(paste0("[dry_run] "[dry_run], "~ ", from , " -> ", to, "\n")) 187 | } 188 | 189 | 190 | 191 | 192 | msg_file_create <- function( 193 | ..., 194 | dry_run = DRY_RUN$active, 195 | verbose = dry_run) 196 | { 197 | files <- c(...) 198 | stopifnot( 199 | is.character(files), 200 | is_scalar_logical(verbose), 201 | is_scalar_logical(dry_run) 202 | ) 203 | 204 | if (!verbose) return() 205 | 206 | message(paste0("[dry_run] "[dry_run], "creating:")) 207 | message(paste0("[dry_run] "[dry_run], "+ ", files, "\n")) 208 | } 209 | 210 | 211 | 212 | 213 | #' Check whether further prunign checks are necessary (you still have to check for max_backups downstream!) 214 | #' 215 | #' @param obj 216 | #' @param max_backups 217 | #' @noRd 218 | #' 219 | #' @return logical scalar 220 | should_prune <- function( 221 | obj, 222 | max_backups 223 | ){ 224 | if (!obj$has_backups){ 225 | return(FALSE) 226 | } 227 | 228 | if (is.infinite(max_backups) || is.na(max_backups)){ 229 | return(FALSE) 230 | } 231 | 232 | TRUE 233 | } 234 | -------------------------------------------------------------------------------- /R/utils-predicates.R: -------------------------------------------------------------------------------- 1 | 2 | is_pure_BackupQueueIndex <- function( 3 | file, 4 | dir = dirname(file) 5 | ){ 6 | identical(BackupQueueDateTime$new(file, dir = dir)$n, 0L) 7 | } 8 | 9 | 10 | 11 | 12 | is_pure_BackupQueueDateTime <- function( 13 | file, 14 | dir = dirname(file) 15 | ){ 16 | bi <- BackupQueueIndex$new(file, dir = dir) 17 | identical(bi$n, 0L) || min(bi$files$index) > 1L 18 | } 19 | 20 | 21 | 22 | 23 | is_pure_BackupQueue <- function( 24 | file, 25 | dir = dirname(file) 26 | ){ 27 | bi <- BackupQueueIndex$new(file, dir = dir) 28 | 29 | if (bi$n < 1){ 30 | TRUE 31 | } else if (identical(min(bi$files$index), 1L)){ 32 | # check if min index is 1 to filter out BackupQueueIndex that are truely 33 | # BackupQueueDate but only have integer like timestamps 34 | identical( 35 | try(BackupQueueDateTime$new(file, dir = dir)$n, silent = TRUE), 36 | 0L 37 | ) 38 | } else { 39 | TRUE 40 | } 41 | } 42 | 43 | 44 | 45 | 46 | assert_pure_BackupQueue <- function( 47 | file, 48 | dir = dirname(file), 49 | warn_only = FALSE 50 | ){ 51 | if (is_pure_BackupQueue(file, dir = dir)) 52 | return(TRUE) 53 | 54 | msg <- paste0( 55 | "Indexed as well as timestamped backups exist for '", file, "'.\n", 56 | paste("*", list_backups(file), collapse = "\n") 57 | ) 58 | 59 | if (warn_only){ 60 | warning(msg, call. = FALSE) 61 | FALSE 62 | } else { 63 | stop("Operation not possible: ", msg, call. = FALSE) 64 | } 65 | } 66 | 67 | 68 | 69 | 70 | is_parsable_rotation_interval <- function(x){ 71 | is_scalar(x) && ( 72 | is.infinite(x) || 73 | is_integerish(x) || 74 | grepl("\\d+\\syear|quarter|month|week|day", x) 75 | ) 76 | } 77 | 78 | 79 | 80 | 81 | is_valid_date_format <- function(x){ 82 | is_scalar_character(x) && 83 | x %in% c( 84 | "%Y-%m-%d", 85 | "%Y-%m", 86 | "%Y%m%d", 87 | "%Y%m", 88 | "%Y" 89 | ) 90 | } 91 | 92 | 93 | 94 | 95 | assert_valid_date_format <- function(x){ 96 | xdep <- deparse(substitute(x)) 97 | if (!is_valid_datetime_format(x)){ 98 | stop( 99 | "`", xdep, "` is not a valid date format but ", preview_object(x), 100 | ". See ?rotate for details." 101 | ) 102 | } 103 | TRUE 104 | } 105 | 106 | 107 | 108 | 109 | is_valid_date_format <- function( 110 | x 111 | ){ 112 | if (!is_scalar_character(x)) 113 | return(FALSE) 114 | 115 | x <- standardize_datetime_stamp(x) 116 | 117 | if (nchar(x) > 6) 118 | return(FALSE) 119 | 120 | is_valid_datetime_format(x) 121 | } 122 | 123 | 124 | 125 | 126 | assert_valid_datetime_format <- function(x){ 127 | xdep <- deparse(substitute(x)) 128 | if (!is_valid_datetime_format(x)) 129 | stop( 130 | "`", xdep, "` is not a valid datetime format but ", preview_object(x), 131 | ". See ?rotate for details." 132 | ) 133 | else 134 | TRUE 135 | } 136 | 137 | 138 | 139 | 140 | is_valid_datetime_format <- function( 141 | x 142 | ){ 143 | if (!is_scalar_character(x)) 144 | return(FALSE) 145 | 146 | standardize_datetime_stamp(x) %in% c( 147 | "%Y%m%d%H%M%S", 148 | "%Y%m%d%H%M", 149 | "%Y%m%d%H", 150 | "%Y%m%d", 151 | "%Y%m", 152 | "%Y" 153 | ) 154 | } 155 | 156 | 157 | 158 | 159 | is_parsable_datetime <- function(x){ 160 | is_scalar(x) && ( 161 | is_Date(x) || 162 | is_POSIXct(x) || 163 | grepl("^\\d{4,14}$", standardize_datetime_stamp(x)) 164 | ) 165 | } 166 | 167 | 168 | 169 | 170 | 171 | is_parsable_date <- function(x){ 172 | is_scalar(x) && ( 173 | is_Date(x) || 174 | is_scalar(x) && grepl("^\\d{4,8}$", standardize_datetime_stamp(x)) 175 | ) 176 | } 177 | 178 | 179 | 180 | 181 | is_backup_older_than_datetime <- function( 182 | backup_date, 183 | datetime, 184 | verbose = FALSE 185 | ){ 186 | if (is_Date(backup_date)) 187 | backup_date <- as.POSIXct(format(backup_date)) 188 | 189 | assert(is_scalar_POSIXct(backup_date)) 190 | assert(is_parsable_datetime(datetime)) 191 | parsed_td <- parse_datetime(datetime) 192 | 193 | res <- backup_date < parsed_td 194 | 195 | if (verbose && !res){ 196 | message(sprintf( 197 | "Not rotating: last backup (%s) is newer than %s" , 198 | format(backup_date), format(parsed_td) 199 | )) 200 | } 201 | 202 | res 203 | } 204 | 205 | 206 | 207 | 208 | is_backup_older_than_interval <- function( 209 | backup_date, 210 | interval, 211 | now, 212 | verbose = FALSE 213 | ){ 214 | if (is_POSIXct(backup_date)) 215 | backup_date <- as.Date(format(backup_date)) 216 | 217 | if (is_POSIXct(now)){ 218 | now <- as.Date(format(now)) 219 | } else if (is.character(now)){ 220 | now <- as.Date(parse_datetime(now)) 221 | } 222 | 223 | assert(is_scalar_Date(backup_date)) 224 | assert(is_scalar_Date(now)) 225 | iv <- parse_rotation_interval(interval) 226 | 227 | 228 | as_period <- switch( 229 | iv$unit, 230 | day = identity, 231 | week = dint::as_date_yw, 232 | month = dint::as_date_ym, 233 | quarter = dint::as_date_yq, 234 | year = dint::get_year 235 | ) 236 | 237 | res <- as_period(backup_date) + 1L * iv$value <= as_period(now) 238 | 239 | if (verbose && !res){ 240 | message(sprintf( 241 | "Not rotating: last backup (%s) is younger than '%s'" , 242 | format(backup_date), paste(interval, collapse = " ") 243 | )) 244 | } 245 | 246 | res 247 | } 248 | 249 | 250 | 251 | 252 | assert_valid_compression <- function(compression){ 253 | assert( 254 | is_scalar_atomic(compression) && ( 255 | compression %in% c("utils::zip", "zip::zipr") || 256 | compression %in% 1:9 || 257 | is_bool(compression) 258 | ), 259 | '`compression` must be `TRUE`, `FALSE`, or an integer between 1 and 9', 260 | 'or the character scalers "utils::zip" or "zip::zipr" not: ', 261 | preview_object(compression) 262 | ) 263 | } 264 | 265 | 266 | 267 | 268 | is_zipcmd_available <- function(cmd = Sys.getenv("R_ZIPCMD", "zip")){ 269 | 270 | if (is_blank(cmd)){ 271 | return(FALSE) 272 | } 273 | 274 | if (.Platform$OS.type == "windows"){ 275 | suppressWarnings(res <- system2("where", cmd, stderr = NULL, stdout = NULL)) 276 | } else { 277 | res <- tryCatch( 278 | system2("command", paste("-v", cmd), stderr = NULL, stdout = NULL), 279 | warning = function(w) {99} 280 | ) 281 | } 282 | 283 | assert(is_scalar(res)) 284 | res == 0 285 | } 286 | 287 | 288 | 289 | 290 | is_dir <- function( 291 | x 292 | ){ 293 | file.exists(x) && file.info(x)$isdir 294 | } 295 | -------------------------------------------------------------------------------- /R/utils-rd.R: -------------------------------------------------------------------------------- 1 | r6_usage <- function( 2 | x, 3 | name = "x", 4 | ignore = NULL, 5 | header = "", 6 | show_methods = TRUE 7 | ){ 8 | if (is.list(x)){ 9 | classname <- deparse(substitute(x)) 10 | classname <- gsub("(list\\()|\\)$", "", classname) 11 | classname <- unlist(strsplit(classname, ", ", fixed = TRUE)) 12 | 13 | res <- lapply( 14 | seq_along(x), 15 | function(i){ 16 | collect_usage.R6( 17 | x = x[[i]], 18 | classname = classname[[i]], 19 | ignore = ignore 20 | ) 21 | } 22 | ) 23 | 24 | res <- list( 25 | ctor = unlist(lapply(res, `[[`, "ctor")), 26 | fields = unique(unlist(lapply(res, `[[`, "fields"))), 27 | methods = unique(unlist(lapply(res, `[[`, "methods"))) 28 | ) 29 | 30 | } else if (R6::is.R6Class(x)){ 31 | res <- collect_usage.R6( 32 | x, 33 | classname = deparse(substitute(x)), 34 | ignore = ignore 35 | ) 36 | } else { 37 | stop("Object ", preview_object(x), "not supported") 38 | } 39 | 40 | 41 | fmt_r6_usage( 42 | res, 43 | name = name, 44 | header = header, 45 | show_methods = show_methods 46 | ) 47 | } 48 | 49 | 50 | 51 | 52 | #' Format R6 usage 53 | #' 54 | #' @param x an `R6ClassGenerator` 55 | #' @param classname `character` scalar. The name of the R6 class 56 | #' @param ignore `character` vector. methods/fields to ignore when generating 57 | #' usage 58 | #' 59 | #' @return a `list` with the components `ctor`, `fields` and `methods` 60 | #' @noRd 61 | collect_usage.R6 <- function( 62 | x, 63 | classname = deparse(substitute(x)), 64 | ignore = TRUE 65 | ){ 66 | public_methods <- vapply( 67 | setdiff(names(x$public_methods), ignore), 68 | function(nm) make_function_usage(nm, formals(x$public_methods[[nm]])), 69 | character(1) 70 | ) 71 | 72 | 73 | ctor <- get_public_method_recursively(x, "initialize") 74 | if (!is.null(ctor)){ 75 | ctor <- make_function_usage(paste0(classname, "$new"), formals(ctor)) 76 | } 77 | 78 | fields <- c(names(x$public_fields), names(x$active)) 79 | 80 | 81 | if (!is.null(fields)) fields <- sort(fields) 82 | fields <- setdiff(fields, ignore) 83 | 84 | els <- list( 85 | ctor = ctor, 86 | methods = 87 | public_methods[!names(public_methods) %in% c("initialize", "finalize")], 88 | fields = fields 89 | ) 90 | 91 | els <- els[!vapply(els, is_empty, FALSE)] 92 | 93 | if ("get_inherit" %in% names(x)){ 94 | els <- c(els, collect_usage.R6(x$get_inherit(), ignore = ignore)) 95 | list( 96 | ctor = els$ctor, 97 | fields = unique(unlist(els[names(els) == "fields"])), 98 | methods = unique(unlist(els[names(els) == "methods"])) 99 | ) 100 | } else { 101 | els 102 | } 103 | } 104 | 105 | 106 | 107 | 108 | #' Format R6 usage 109 | #' 110 | #' @param x output of collect_usage.R6 111 | #' @param header an optional `character` vector for a heading 112 | #' @param show_methods `logical` scalar: Show methods 113 | #' 114 | #' @return a `character` vector 115 | #' @noRd 116 | fmt_r6_usage <- function( 117 | x, 118 | name = x, 119 | header = "", 120 | show_methods = TRUE 121 | ){ 122 | assert(is_scalar_bool(show_methods)) 123 | 124 | res <- c() 125 | res <- c("@section Usage:", "") 126 | 127 | 128 | ctors <- unlist(lapply( 129 | x$ctor, 130 | function(.x) c(strwrap(paste0(name, " <- ", .x), width = 80, exdent = 2), "") 131 | )) 132 | 133 | res <- c( 134 | res, 135 | "```", 136 | header, 137 | ctors 138 | ) 139 | 140 | if (show_methods){ 141 | res <- c( 142 | res, 143 | paste0(name, "$", sort(x$methods)), "", 144 | paste0(name, "$", sort(x$fields)), "", 145 | "```" 146 | ) 147 | } 148 | 149 | res 150 | } 151 | 152 | 153 | 154 | 155 | get_public_method_recursively = function(ctor, method){ 156 | if (is.function(ctor)) 157 | return(ctor) 158 | else if (is.null(ctor)) 159 | return(NULL) 160 | 161 | if (method %in% names(ctor$public_methods)){ 162 | return(ctor$public_methods[[method]]) 163 | 164 | } else { 165 | get_public_method_recursively(ctor$get_inherit(), method) 166 | } 167 | } 168 | 169 | 170 | 171 | 172 | make_function_usage <- function(name, arglist){ 173 | paste0(name, "(", fmt_formals(arglist), ")") 174 | } 175 | 176 | 177 | 178 | 179 | fmt_formals <- function(fmls){ 180 | 181 | arg_to_text <- function(.x) { 182 | if (is.symbol(.x) && deparse(.x) == "") 183 | return("") 184 | 185 | text <- enc2utf8(deparse(.x, backtick = TRUE, width.cutoff = 500L)) 186 | text <- paste0(text, collapse = "\n") 187 | Encoding(text) <- "UTF-8" 188 | text 189 | } 190 | 191 | res <- vapply(fmls, arg_to_text, character(1)) 192 | sep <- ifelse(res == "", "", " = ") 193 | paste0(names(res), sep, res, collapse = ", ") 194 | } 195 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | last <- function(x){ 2 | x[[length(x)]] 3 | } 4 | 5 | 6 | 7 | 8 | first <- function(x){ 9 | x[[1]] 10 | } 11 | 12 | 13 | 14 | 15 | fmt_bytes <- function( 16 | x, 17 | na = "" 18 | ){ 19 | x <- as.numeric(x) 20 | 21 | readablifiy <- function(.x){ 22 | if (is.na(.x) || is.null(.x)){ 23 | return(na) 24 | } 25 | 26 | for (unit in c("B", "KiB", "MiB", "GiB", "TiB")){ 27 | if (max(abs(.x), na.rm = TRUE) < 1024 || unit == "TiB") 28 | break 29 | else 30 | .x <- .x / 1024 31 | } 32 | 33 | return(paste(round(.x, 1), unit)) 34 | } 35 | 36 | vapply(x, readablifiy, character(1)) 37 | } 38 | 39 | 40 | 41 | 42 | expect_snapshot_unchanged <- function(snap){ 43 | if (!length(snap$info$size) && !length(utils::fileSnapshot(snap$path)$info$size)) 44 | testthat::expect_true(TRUE) 45 | else 46 | testthat::expect_true(!any(utils::changedFiles(snap)$changes)) 47 | } 48 | 49 | 50 | 51 | 52 | #' Splits a string at `pos` (removing the character at pos) 53 | #' 54 | #' @param x a `character` vector 55 | #' @param pos an `integer` vector 56 | #' 57 | #' @noRd 58 | strsplit_at_seperator_pos <- function( 59 | x, 60 | pos, 61 | seps = "." 62 | ){ 63 | assert( 64 | all(substr(x, pos, pos) %in% seps), 65 | "Not all names have a '.' sepparator at pos ", pos, ":\n", 66 | paste0("* ", x, collapse = "\n") 67 | ) 68 | matrix(data = c(substr(x, 1, pos - 1L), substr(x, pos + 1L, nchar(x))), ncol = 2) 69 | } 70 | 71 | 72 | 73 | 74 | strsplit_at_pos <- function( 75 | x, 76 | pos 77 | ){ 78 | matrix(data = c(substr(x, 1, pos), substr(x, pos + 1L, nchar(x))), ncol = 2) 79 | } 80 | 81 | 82 | 83 | 84 | path_equal <- function(x, y){ 85 | if (identical(x, y)){ 86 | return(TRUE) 87 | } 88 | 89 | x <- path_tidy(x) 90 | y <- path_tidy(y) 91 | 92 | if (identical(x, y)){ 93 | return(TRUE) 94 | } 95 | 96 | x <- path.expand(x) 97 | y <- path.expand(y) 98 | 99 | identical(x, y) 100 | } 101 | 102 | 103 | 104 | 105 | path_setequal <- function(x, y){ 106 | x <- unique(x) 107 | y <- unique(y) 108 | 109 | if (setequal(x, y)){ 110 | return(TRUE) 111 | } 112 | 113 | x <- path_tidy(x) 114 | y <- path_tidy(y) 115 | 116 | if (setequal(x, y)){ 117 | return(TRUE) 118 | } 119 | 120 | x <- path.expand(x) 121 | y <- path.expand(y) 122 | setequal(x, y) 123 | } 124 | 125 | 126 | 127 | 128 | expect_path_equal <- function(x, y){ 129 | testthat::expect_true(path_equal(x, y)) 130 | } 131 | 132 | 133 | 134 | 135 | expect_path_setequal <- function(x, y){ 136 | testthat::expect_true(path_setequal(x, y)) 137 | } 138 | 139 | 140 | 141 | 142 | #' Clean up paths to make them comparable, inspired by fs::path_tidy 143 | #' 144 | #' @param x `character` vector 145 | #' 146 | #' @return a `character` vector 147 | #' @noRd 148 | path_tidy <- function(x){ 149 | x <- gsub("\\\\", "/", x) 150 | x <- gsub("(?!^)/+", "/", x, perl = TRUE) 151 | 152 | sel <- x != "/" 153 | x[sel] <- gsub("/$", "", x[sel]) 154 | 155 | sel <- is_windows_path(x) 156 | 157 | if (any(sel)){ 158 | clean_win <- function(.x){ 159 | substr(.x, 1, 1) <- toupper(substr(.x, 1 ,1)) 160 | .sel <- nchar(.x) == 2 161 | .x[.sel] <- paste0(.x[.sel], "/") 162 | .x 163 | } 164 | 165 | x[sel] <- clean_win(x[sel]) 166 | } 167 | 168 | x 169 | } 170 | 171 | 172 | 173 | 174 | path_standardize <- function(x){ 175 | path_tidy(path.expand(x)) 176 | } 177 | 178 | 179 | 180 | 181 | is_windows_path <- function(x){ 182 | nchar(x) >= 2 & grepl("^[A-Za-z].*", x) & substr(x, 2, 2) == ":" 183 | } 184 | 185 | 186 | 187 | 188 | # for R < 3.5 189 | isFALSE <- function(x){ 190 | identical(x, FALSE) 191 | } 192 | 193 | 194 | 195 | expect_dir_empty <- function( 196 | path 197 | ){ 198 | assert(is_scalar_character(path)) 199 | testthat::expect_true( 200 | dir.exists(path), 201 | info = sprintf("'%s' does not exist", path) 202 | ) 203 | testthat::expect_true( 204 | is_dir(path), 205 | info = sprintf("'%s' is not a directory", path) 206 | ) 207 | testthat::expect_true( 208 | length(list.files(path)) == 0L, 209 | info = sprintf("Directory '%s' is not empty", path) 210 | ) 211 | } 212 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | # rotor 16 | 17 | 18 | [![Lifecycle: maturing](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://lifecycle.r-lib.org/articles/stages.html#maturing) 19 | [![CRAN status](https://www.r-pkg.org/badges/version/rotor)](https://cran.r-project.org/package=rotor) 20 | 21 | 22 | **rotor** provides a cross platform R reimagination of 23 | [logrotate](https://linux.die.net/man/8/logrotate). It is a companion package to 24 | the logging package [lgr](https://github.com/s-fleck/lgr). In 25 | contrast to logrotate, rotor relies solely on information encoded in a suffixes 26 | of file names for conditionally creating backups (i.e. a timestamp or index). It 27 | therefore also works with backups created by other tools, as long as the 28 | filename has a format that rotor can understand. 29 | 30 | `rotate()`, `rotate_date()`, and `rotate_time()` move a file and insert a suffix 31 | (either an integer or a timestamp) into the filename. In addition, they create 32 | an empty file in place of the original one. This is useful for log rotation. 33 | `backup()`, `backup_date()` and `backup_time()` do the same but keep the 34 | original file. 35 | 36 | rotor also includes utility functions for finding and examining the backups of a 37 | file: `list_backups()`, `backup_info()`, `n_backups`, `newest_backup()`, 38 | `oldest_backup()`. See the 39 | [function reference](https://s-fleck.github.io/rotor/reference/index.html) for 40 | details. 41 | 42 | ## Installation 43 | 44 | You can install the released version of rotor from [CRAN](https://CRAN.R-project.org) with: 45 | 46 | ``` r 47 | install.packages("rotor") 48 | ``` 49 | 50 | And the development version from [GitHub](https://github.com/) with: 51 | 52 | ``` r 53 | # install.packages("remotes") 54 | remotes::install_github("s-fleck/rotor") 55 | ``` 56 | ## Example 57 | 58 | First we create a temporary directory for the files created by the code examples 59 | ```{r setup, results = "hide"} 60 | library(rotor) 61 | 62 | # create a directory 63 | td <- file.path(tempdir(), "rotor") 64 | dir.create(td, recursive = TRUE) 65 | 66 | # create an example logfile 67 | tf <- file.path(td, "mylogfile.log") 68 | writeLines("An important message", tf) 69 | ``` 70 | 71 | ### Indexed backups 72 | 73 | `backup()` makes a copy of a file and inserts an index between the filename 74 | and the file extension. The file with the index `1` is always the most recently 75 | made backup. 76 | ```{r backup index, collapse=TRUE} 77 | backup(tf) 78 | 79 | # backup and rotate also support compression 80 | backup(tf, compression = TRUE) 81 | 82 | # display backups of a file 83 | list_backups(tf) 84 | ``` 85 | 86 | `rotate()` also backs up a file, but replaces the original file with an empty 87 | one. 88 | 89 | ```{r rotate index, collapse=TRUE} 90 | rotate(tf) 91 | list_backups(tf) 92 | 93 | # the original file is now empty 94 | readLines(tf) 95 | 96 | # its content was moved to the first backup 97 | readLines(list_backups(tf)[[1]]) 98 | 99 | # we can now safely write to the original file 100 | writeLines("another important message", tf) 101 | ``` 102 | 103 | The `max_backups` parameter limits the maximum number of backups rotor will 104 | keep of a file. Notice how the zipped backup we created above moves to index 4 105 | as we create two new backups. 106 | ```{r} 107 | backup(tf, max_backups = 4) 108 | backup(tf, max_backups = 4) 109 | 110 | list_backups(tf) 111 | ``` 112 | 113 | We can also use `prune_backups()` to delete old backups. Other than ensuring 114 | that no new backups is created, it works identically to using `backup()` with 115 | the `max_backups` parameter. By setting it to `0`, we delete all backups. 116 | ```{r} 117 | prune_backups(tf, max_backups = 0) 118 | ``` 119 | 120 | ## Timestamped backups 121 | 122 | **rotor** can also create timestamped backups. `backup_date()` creates uses a 123 | Date (`yyyy-mm-dd`) timestamp, `backup_time()` uses a full datetime-stamp by 124 | default (`yyyy-mm-dd--hh-mm-ss`). The format of the timestamp can be modified 125 | with a subset of the formatting tokens understood by `strftime()` (within 126 | certain restrictions). Backups created with both functions are compatible with 127 | each other (but not with those created with `backup_index()`). 128 | 129 | ```{r timestamp} 130 | # be default backup_date() only makes a backup if the last backups is younger 131 | # than 1 day, so we set `age` to -1 for this example 132 | backup_date(tf, age = -1) 133 | backup_date(tf, format = "%Y-%m", age = -1) 134 | backup_time(tf) 135 | backup_time(tf, format = "%Y-%m-%d_%H-%M-%S") # Python logging 136 | backup_time(tf, format = "%Y%m%dT%H%M%S") # ISO 8601 compatible 137 | 138 | backup_info(tf) 139 | ``` 140 | If we examine the "timestamp" column in the example above, we see that missing 141 | date information is always interpreted as the start of the period; i.e. so 142 | `"2019-01"` is equivalent to `"2019-01-01--00--00--00"` for all intents and 143 | purposes. 144 | 145 | ```{r} 146 | prune_backups(tf, max_backups = 0) # cleanup 147 | list_backups(tf) 148 | ``` 149 | 150 | Besides passing a total number of backups to keep, `max_backups` can also be 151 | a period or a date / datetime for timestamped backups. 152 | ```{r eval = FALSE} 153 | # keep all backups younger than one year 154 | prune_backups(tf, "1 year") 155 | 156 | # keep all backups from April 4th, 2018 and onwards 157 | prune_backups(tf, "2018-04-01") 158 | ``` 159 | 160 | ```{r cleanup, include = FALSE} 161 | unlink(td, recursive = TRUE) 162 | ``` 163 | 164 | 165 | ## Cache 166 | 167 | rotor also provides a simple on-disk key-value store that can be pruned by size, 168 | age or number of files. 169 | 170 | ```{r} 171 | cache <- Cache$new(file.path(tempdir(), "cache-test"), hashfun = digest::digest) 172 | key1 <- cache$push(iris) 173 | key2 <- cache$push(cars) 174 | key3 <- cache$push(mtcars) 175 | 176 | cache$files$path 177 | 178 | head(cache$read(key1)) 179 | 180 | cache$prune(max_files = 1) 181 | cache$files$path 182 | cache$purge() # deletes all cached files 183 | cache$destroy() # deletes the cache directory 184 | ``` 185 | 186 | 187 | 188 | # Dependencies 189 | 190 | **rotor**'s dependencies are intentionally kept slim. It only comes with two 191 | non-base dependencies: 192 | 193 | * [R6](https://github.com/r-lib/R6): A light weight system for 194 | encapsulated object-oriented programming. 195 | * [dint](https://github.com/s-fleck/dint): A toolkit for working year-quarter 196 | and year-month dates that I am also the author of. It is used by 197 | `rotate_date()` and `rotate_time()` to deal with calendar periods (such as 198 | weeks or months). 199 | 200 | Both packages have no transitive dependencies (i.e they do not depend on 201 | anything outside of base R) 202 | 203 | 204 | Optional dependencies: 205 | 206 | * [digest](https://github.com/eddelbuettel/digest), 207 | [ulid](https://cran.r-project.org/package=ulid), or 208 | [uuid](https://CRAN.R-project.org/package=uuid ) for generating 209 | hashes or UIDs when using `Cache`. Storage keys for cache files can also be set 210 | manually, in which case no external dependencies are required. 211 | * [zip](https://CRAN.R-project.org/package=zip) is supported as an alternative 212 | to the integrated zip function in R. Might work better on some systems and 213 | worse on others. 214 | * [crayon](https://cran.r-project.org/package=crayon) for 215 | terminal colors 216 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # rotor 5 | 6 | 7 | 8 | [![Lifecycle: 9 | maturing](https://img.shields.io/badge/lifecycle-maturing-blue.svg)](https://lifecycle.r-lib.org/articles/stages.html#maturing) 10 | [![CRAN 11 | status](https://www.r-pkg.org/badges/version/rotor)](https://cran.r-project.org/package=rotor) 12 | 13 | 14 | **rotor** provides a cross platform R reimagination of 15 | [logrotate](https://linux.die.net/man/8/logrotate). It is a companion 16 | package to the logging package [lgr](https://github.com/s-fleck/lgr). In 17 | contrast to logrotate, rotor relies solely on information encoded in a 18 | suffixes of file names for conditionally creating backups (i.e. a 19 | timestamp or index). It therefore also works with backups created by 20 | other tools, as long as the filename has a format that rotor can 21 | understand. 22 | 23 | `rotate()`, `rotate_date()`, and `rotate_time()` move a file and insert 24 | a suffix (either an integer or a timestamp) into the filename. In 25 | addition, they create an empty file in place of the original one. This 26 | is useful for log rotation. `backup()`, `backup_date()` and 27 | `backup_time()` do the same but keep the original file. 28 | 29 | rotor also includes utility functions for finding and examining the 30 | backups of a file: `list_backups()`, `backup_info()`, `n_backups`, 31 | `newest_backup()`, `oldest_backup()`. See the [function 32 | reference](https://s-fleck.github.io/rotor/reference/index.html) for 33 | details. 34 | 35 | ## Installation 36 | 37 | You can install the released version of rotor from 38 | [CRAN](https://CRAN.R-project.org) with: 39 | 40 | ``` r 41 | install.packages("rotor") 42 | ``` 43 | 44 | And the development version from [GitHub](https://github.com/) with: 45 | 46 | ``` r 47 | # install.packages("remotes") 48 | remotes::install_github("s-fleck/rotor") 49 | ``` 50 | 51 | ## Example 52 | 53 | First we create a temporary directory for the files created by the code 54 | examples 55 | 56 | ``` r 57 | library(rotor) 58 | 59 | # create a directory 60 | td <- file.path(tempdir(), "rotor") 61 | dir.create(td, recursive = TRUE) 62 | 63 | # create an example logfile 64 | tf <- file.path(td, "mylogfile.log") 65 | writeLines("An important message", tf) 66 | ``` 67 | 68 | ### Indexed backups 69 | 70 | `backup()` makes a copy of a file and inserts an index between the 71 | filename and the file extension. The file with the index `1` is always 72 | the most recently made backup. 73 | 74 | ``` r 75 | backup(tf) 76 | 77 | # backup and rotate also support compression 78 | backup(tf, compression = TRUE) 79 | 80 | # display backups of a file 81 | list_backups(tf) 82 | #> [1] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.1.log.zip" 83 | #> [2] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2.log" 84 | ``` 85 | 86 | `rotate()` also backs up a file, but replaces the original file with an 87 | empty one. 88 | 89 | ``` r 90 | rotate(tf) 91 | list_backups(tf) 92 | #> [1] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.1.log" 93 | #> [2] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2.log.zip" 94 | #> [3] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.3.log" 95 | 96 | # the original file is now empty 97 | readLines(tf) 98 | #> character(0) 99 | 100 | # its content was moved to the first backup 101 | readLines(list_backups(tf)[[1]]) 102 | #> [1] "An important message" 103 | 104 | # we can now safely write to the original file 105 | writeLines("another important message", tf) 106 | ``` 107 | 108 | The `max_backups` parameter limits the maximum number of backups rotor 109 | will keep of a file. Notice how the zipped backup we created above moves 110 | to index 4 as we create two new backups. 111 | 112 | ``` r 113 | backup(tf, max_backups = 4) 114 | backup(tf, max_backups = 4) 115 | 116 | list_backups(tf) 117 | #> [1] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.1.log" 118 | #> [2] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2.log" 119 | #> [3] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.3.log" 120 | #> [4] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.4.log.zip" 121 | ``` 122 | 123 | We can also use `prune_backups()` to delete old backups. Other than 124 | ensuring that no new backups is created, it works identically to using 125 | `backup()` with the `max_backups` parameter. By setting it to `0`, we 126 | delete all backups. 127 | 128 | ``` r 129 | prune_backups(tf, max_backups = 0) 130 | ``` 131 | 132 | ## Timestamped backups 133 | 134 | **rotor** can also create timestamped backups. `backup_date()` creates 135 | uses a Date (`yyyy-mm-dd`) timestamp, `backup_time()` uses a full 136 | datetime-stamp by default (`yyyy-mm-dd--hh-mm-ss`). The format of the 137 | timestamp can be modified with a subset of the formatting tokens 138 | understood by `strftime()` (within certain restrictions). Backups 139 | created with both functions are compatible with each other (but not with 140 | those created with `backup_index()`). 141 | 142 | ``` r 143 | # be default backup_date() only makes a backup if the last backups is younger 144 | # than 1 day, so we set `age` to -1 for this example 145 | backup_date(tf, age = -1) 146 | backup_date(tf, format = "%Y-%m", age = -1) 147 | backup_time(tf) 148 | backup_time(tf, format = "%Y-%m-%d_%H-%M-%S") # Python logging 149 | backup_time(tf, format = "%Y%m%dT%H%M%S") # ISO 8601 compatible 150 | 151 | backup_info(tf) 152 | #> path 153 | #> 1 C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2022-09-02--13-25-45.log 154 | #> 3 C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2022-09-02_13-25-45.log 155 | #> 5 C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.20220902T132545.log 156 | #> 2 C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2022-09-02.log 157 | #> 4 C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/rotor/mylogfile.2022-09.log 158 | #> name sfx ext size isdir mode mtime 159 | #> 1 mylogfile 2022-09-02--13-25-45 log 27 FALSE 666 2022-09-02 13:25:45 160 | #> 3 mylogfile 2022-09-02_13-25-45 log 27 FALSE 666 2022-09-02 13:25:45 161 | #> 5 mylogfile 20220902T132545 log 27 FALSE 666 2022-09-02 13:25:45 162 | #> 2 mylogfile 2022-09-02 log 27 FALSE 666 2022-09-02 13:25:45 163 | #> 4 mylogfile 2022-09 log 27 FALSE 666 2022-09-02 13:25:45 164 | #> ctime atime exe timestamp 165 | #> 1 2022-09-02 13:25:45 2022-09-02 13:25:45 no 2022-09-02 13:25:45 166 | #> 3 2022-09-02 13:25:45 2022-09-02 13:25:45 no 2022-09-02 13:25:45 167 | #> 5 2022-09-02 13:25:45 2022-09-02 13:25:45 no 2022-09-02 13:25:45 168 | #> 2 2022-09-02 13:25:45 2022-09-02 13:25:45 no 2022-09-02 00:00:00 169 | #> 4 2022-09-02 13:25:45 2022-09-02 13:25:45 no 2022-09-01 00:00:00 170 | ``` 171 | 172 | If we examine the “timestamp” column in the example above, we see that 173 | missing date information is always interpreted as the start of the 174 | period; i.e. so `"2019-01"` is equivalent to `"2019-01-01--00--00--00"` 175 | for all intents and purposes. 176 | 177 | ``` r 178 | prune_backups(tf, max_backups = 0) # cleanup 179 | list_backups(tf) 180 | #> character(0) 181 | ``` 182 | 183 | Besides passing a total number of backups to keep, `max_backups` can 184 | also be a period or a date / datetime for timestamped backups. 185 | 186 | ``` r 187 | # keep all backups younger than one year 188 | prune_backups(tf, "1 year") 189 | 190 | # keep all backups from April 4th, 2018 and onwards 191 | prune_backups(tf, "2018-04-01") 192 | ``` 193 | 194 | ## Cache 195 | 196 | rotor also provides a simple on-disk key-value store that can be pruned 197 | by size, age or number of files. 198 | 199 | ``` r 200 | cache <- Cache$new(file.path(tempdir(), "cache-test"), hashfun = digest::digest) 201 | #> creating directory 'C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/cache-test' 202 | key1 <- cache$push(iris) 203 | key2 <- cache$push(cars) 204 | key3 <- cache$push(mtcars) 205 | 206 | cache$files$path 207 | #> [1] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/cache-test/d3c5d071001b61a9f6131d3004fd0988" 208 | #> [2] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/cache-test/f98a59010652c8e1ee062ed4c43f648e" 209 | #> [3] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/cache-test/a63c70e73b58d0823ab3bcbd3b543d6f" 210 | 211 | head(cache$read(key1)) 212 | #> Sepal.Length Sepal.Width Petal.Length Petal.Width Species 213 | #> 1 5.1 3.5 1.4 0.2 setosa 214 | #> 2 4.9 3.0 1.4 0.2 setosa 215 | #> 3 4.7 3.2 1.3 0.2 setosa 216 | #> 4 4.6 3.1 1.5 0.2 setosa 217 | #> 5 5.0 3.6 1.4 0.2 setosa 218 | #> 6 5.4 3.9 1.7 0.4 setosa 219 | 220 | cache$prune(max_files = 1) 221 | cache$files$path 222 | #> [1] "C:/Users/STEFAN~1.FLE/AppData/Local/Temp/RtmpYZSExE/cache-test/a63c70e73b58d0823ab3bcbd3b543d6f" 223 | cache$purge() # deletes all cached files 224 | cache$destroy() # deletes the cache directory 225 | ``` 226 | 227 | # Dependencies 228 | 229 | **rotor**’s dependencies are intentionally kept slim. It only comes with 230 | two non-base dependencies: 231 | 232 | - [R6](https://github.com/r-lib/R6): A light weight system for 233 | encapsulated object-oriented programming. 234 | - [dint](https://github.com/s-fleck/dint): A toolkit for working 235 | year-quarter and year-month dates that I am also the author of. It 236 | is used by `rotate_date()` and `rotate_time()` to deal with calendar 237 | periods (such as weeks or months). 238 | 239 | Both packages have no transitive dependencies (i.e they do not depend on 240 | anything outside of base R) 241 | 242 | Optional dependencies: 243 | 244 | - [digest](https://github.com/eddelbuettel/digest), 245 | [ulid](https://cran.r-project.org/package=ulid), or 246 | [uuid](https://CRAN.R-project.org/package=uuid) for generating 247 | hashes or UIDs when using `Cache`. Storage keys for cache files can 248 | also be set manually, in which case no external dependencies are 249 | required. 250 | - [zip](https://CRAN.R-project.org/package=zip) is supported as an 251 | alternative to the integrated zip function in R. Might work better 252 | on some systems and worse on others. 253 | - [crayon](https://cran.r-project.org/package=crayon) for terminal 254 | colors 255 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | destination: docs 2 | -------------------------------------------------------------------------------- /codecov.yml: -------------------------------------------------------------------------------- 1 | comment: false 2 | 3 | coverage: 4 | status: 5 | project: 6 | default: 7 | target: auto 8 | threshold: 1% 9 | patch: 10 | default: 11 | target: auto 12 | threshold: 1% 13 | -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 notes 4 | 5 | Fix issues related to the change in behaviour of `as.character.POSIXct()` & co 6 | in r-devel. 7 | -------------------------------------------------------------------------------- /inst/WORDLIST: -------------------------------------------------------------------------------- 1 | datetime 2 | Datetime 3 | GiB 4 | github 5 | https 6 | ISOweeks 7 | KiB 8 | lexically 9 | lgr 10 | Lifecycle 11 | linux 12 | logrotate 13 | MiB 14 | reimagination 15 | sortable 16 | subclasses 17 | TiB 18 | Codecov 19 | covr 20 | BackupQueue 21 | BackupQueueIndex 22 | BackupQueueDate 23 | BackupQueueDateTime 24 | DateTime 25 | appender 26 | IEC 27 | getters 28 | datestamped 29 | uuid 30 | UID 31 | 's 32 | ORCID 33 | infos 34 | -------------------------------------------------------------------------------- /inst/benchmarks/benchmarks.R: -------------------------------------------------------------------------------- 1 | 2 | library(rotor) 3 | library(bench) 4 | 5 | tf <- tempfile() 6 | file.create(tf) 7 | 8 | backup_date(tf, now = "2019-01-01") 9 | backup_date(tf, now = "2019-01-02") 10 | backup_date(tf, now = "2019-01-03") 11 | backup_date(tf, now = "2019-01-04") 12 | backup_date(tf, now = "2019-01-05") 13 | 14 | 15 | bq_cached <- BackupQueueDate$new(tf, cache_backups = TRUE) 16 | bq <- BackupQueueDate$new(tf, cache_backups = FALSE) 17 | 18 | res <- bench::mark( 19 | bq$n, 20 | bq$files, 21 | bq$should_rotate(age = "1 year", size = -1), 22 | bq_cached$n, 23 | bq_cached$files, 24 | bq_cached$should_rotate(age = "1 year", size = -1), 25 | check = FALSE 26 | ) 27 | 28 | plot(res) 29 | -------------------------------------------------------------------------------- /inst/benchmarks/benchmarks.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | title: "benchmarks" 3 | --- 4 | 5 | ```{r, include = FALSE} 6 | knitr::opts_chunk$set( 7 | collapse = TRUE, 8 | comment = "#>" 9 | ) 10 | ``` 11 | 12 | ```{r setup} 13 | library(rotor) 14 | library(bench) 15 | ``` 16 | 17 | 18 | ```{r} 19 | 20 | tf <- tempfile() 21 | file.create(tf) 22 | 23 | backup_date(tf, now = "2019-01-01") 24 | backup_date(tf, now = "2019-01-02") 25 | backup_date(tf, now = "2019-01-03") 26 | backup_date(tf, now = "2019-01-04") 27 | backup_date(tf, now = "2019-01-05") 28 | 29 | 30 | 31 | ``` 32 | 33 | -------------------------------------------------------------------------------- /man-roxygen/datime_formats.R: -------------------------------------------------------------------------------- 1 | #' @section Supported Datetime Formats 2 | #' 3 | #' **rotor** only supports a limited number of 4 | #' [ISO_8601](https://en.wikipedia.org/wiki/ISO_8601) 5 | #' inspired formats for Dates and Datetimes. 6 | #' To work with lgr dateimtes have to be lexically sortable (`2018-12-04`` is 7 | #' ok, `12-04-2018` is not) and can only contain characters that are valid in 8 | #' filenames (`2018-12-04T12-34-52` is ok, `2018-12-04T12:34:52`) is not. 9 | #' The formatting string syntax is as with [strftime()]. 10 | #' 11 | #' For Dates, the recommended format is `"%Y-%m-%d"`. The `%m` and `%d` are 12 | #' optional, as are the dashes (`-`). 13 | #' 14 | #' For Datettimes, the recommended format is `""%Y-%m-%d--%H-%M-%S"` (for 15 | #' readability) or `""%Y%m%dT%H%M%S"` (ISO compatible). `%M` and 16 | #' `%S` are optional, as is the `T`. You can also add dashes (`-`) between the 17 | #' date/time components if you like. 18 | #' 19 | #' Examples: 20 | #' 21 | #' ``` 22 | #' `2018-12-04` 23 | #' `201810` # same as `2018-10-01` 24 | #' 25 | #' `20181204T123452` 26 | #' `2018120412` # same as `2018-12-04T12-00-00` 27 | #' ``` 28 | #' 29 | #' These formats are all based on 30 | #' . 31 | #' To work with 32 | #' 33 | #' 34 | #' 35 | #' 36 | #' @family abstract classes 37 | -------------------------------------------------------------------------------- /man-roxygen/r6_api.R: -------------------------------------------------------------------------------- 1 | #' @details 2 | #' This class is part of the [R6][R6::R6Class] API of **rotor** which is 3 | #' intended for developers that want to extend this package. For normal usage, 4 | #' the simpler functional API is recommended (see [rotate()]). 5 | #' 6 | #' @family R6 Classes 7 | -------------------------------------------------------------------------------- /man/BackupQueue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BackupQueue.R 3 | \name{BackupQueue} 4 | \alias{BackupQueue} 5 | \title{An R6 Class for managing backups (abstract base class)} 6 | \description{ 7 | \code{BackupQueue}is an abstract class not intended for direct usage, please refer to 8 | \link{BackupQueueIndex}, \link{BackupQueueDateTime}, \link{BackupQueueDate} instead. 9 | } 10 | \details{ 11 | This class is part of the \link[R6:R6Class]{R6} API of \strong{rotor} which is 12 | intended for developers that want to extend this package. For normal usage, 13 | the simpler functional API is recommended (see \code{\link[=rotate]{rotate()}}). 14 | } 15 | \seealso{ 16 | Other R6 Classes: 17 | \code{\link{BackupQueueDateTime}}, 18 | \code{\link{BackupQueueDate}}, 19 | \code{\link{BackupQueueIndex}}, 20 | \code{\link{Cache}}, 21 | \code{\link{DirectoryQueue}} 22 | } 23 | \concept{R6 Classes} 24 | \section{Super class}{ 25 | \code{\link[rotor:DirectoryQueue]{rotor::DirectoryQueue}} -> \code{BackupQueue} 26 | } 27 | \section{Public fields}{ 28 | \if{html}{\out{
}} 29 | \describe{ 30 | \item{\code{dir}}{\code{character} scalar. Directory in which to place the backups.} 31 | 32 | \item{\code{n}}{\code{integer} scalar. The number of backups that exist for \code{BackupQueue$origin}} 33 | } 34 | \if{html}{\out{
}} 35 | } 36 | \section{Active bindings}{ 37 | \if{html}{\out{
}} 38 | \describe{ 39 | \item{\code{dir}}{\code{character} scalar. Directory in which to place the backups.} 40 | 41 | \item{\code{n}}{\code{integer} scalar. The number of backups that exist for \code{BackupQueue$origin}} 42 | 43 | \item{\code{file}}{\code{character} scalar. The file to backup/rotate.} 44 | 45 | \item{\code{compression}}{(Optional) compression to use \code{compression} argument of \code{\link[=rotate]{rotate()}}.} 46 | 47 | \item{\code{max_backups}}{Maximum number/size/age of backups. See \code{max_backups} 48 | argument of \code{\link[=rotate]{rotate()}}} 49 | 50 | \item{\code{has_backups}}{Returns \code{TRUE} if at least one backup of \code{BackupQueue$origin} 51 | exists 52 | All backups of self$origin} 53 | } 54 | \if{html}{\out{
}} 55 | } 56 | \section{Methods}{ 57 | \subsection{Public methods}{ 58 | \itemize{ 59 | \item \href{#method-BackupQueue-new}{\code{BackupQueue$new()}} 60 | \item \href{#method-BackupQueue-prune}{\code{BackupQueue$prune()}} 61 | \item \href{#method-BackupQueue-prune_identical}{\code{BackupQueue$prune_identical()}} 62 | \item \href{#method-BackupQueue-print}{\code{BackupQueue$print()}} 63 | \item \href{#method-BackupQueue-push_backup}{\code{BackupQueue$push_backup()}} 64 | \item \href{#method-BackupQueue-set_origin}{\code{BackupQueue$set_origin()}} 65 | \item \href{#method-BackupQueue-set_compression}{\code{BackupQueue$set_compression()}} 66 | \item \href{#method-BackupQueue-set_max_backups}{\code{BackupQueue$set_max_backups()}} 67 | \item \href{#method-BackupQueue-set_file}{\code{BackupQueue$set_file()}} 68 | \item \href{#method-BackupQueue-set_backup_dir}{\code{BackupQueue$set_backup_dir()}} 69 | } 70 | } 71 | \if{html}{\out{ 72 |
Inherited methods 73 | 77 |
78 | }} 79 | \if{html}{\out{
}} 80 | \if{html}{\out{}} 81 | \if{latex}{\out{\hypertarget{method-BackupQueue-new}{}}} 82 | \subsection{Method \code{new()}}{ 83 | \subsection{Usage}{ 84 | \if{html}{\out{
}}\preformatted{BackupQueue$new( 85 | origin, 86 | dir = dirname(origin), 87 | max_backups = Inf, 88 | compression = FALSE, 89 | backup_dir = NULL 90 | )}\if{html}{\out{
}} 91 | } 92 | 93 | } 94 | \if{html}{\out{
}} 95 | \if{html}{\out{}} 96 | \if{latex}{\out{\hypertarget{method-BackupQueue-prune}{}}} 97 | \subsection{Method \code{prune()}}{ 98 | Delete all backups except \code{max_backups}. See \code{\link[=prune_backups]{prune_backups()}}. 99 | \subsection{Usage}{ 100 | \if{html}{\out{
}}\preformatted{BackupQueue$prune(max_backups = self$max_backups)}\if{html}{\out{
}} 101 | } 102 | 103 | } 104 | \if{html}{\out{
}} 105 | \if{html}{\out{}} 106 | \if{latex}{\out{\hypertarget{method-BackupQueue-prune_identical}{}}} 107 | \subsection{Method \code{prune_identical()}}{ 108 | Delete all identical backups. Uses \code{\link[tools:md5sum]{tools::md5sum()}} to 109 | compare the files. 110 | Set the file to be backed up 111 | \subsection{Usage}{ 112 | \if{html}{\out{
}}\preformatted{BackupQueue$prune_identical()}\if{html}{\out{
}} 113 | } 114 | 115 | } 116 | \if{html}{\out{
}} 117 | \if{html}{\out{}} 118 | \if{latex}{\out{\hypertarget{method-BackupQueue-print}{}}} 119 | \subsection{Method \code{print()}}{ 120 | \subsection{Usage}{ 121 | \if{html}{\out{
}}\preformatted{BackupQueue$print()}\if{html}{\out{
}} 122 | } 123 | 124 | } 125 | \if{html}{\out{
}} 126 | \if{html}{\out{}} 127 | \if{latex}{\out{\hypertarget{method-BackupQueue-push_backup}{}}} 128 | \subsection{Method \code{push_backup()}}{ 129 | \subsection{Usage}{ 130 | \if{html}{\out{
}}\preformatted{BackupQueue$push_backup(...)}\if{html}{\out{
}} 131 | } 132 | 133 | } 134 | \if{html}{\out{
}} 135 | \if{html}{\out{}} 136 | \if{latex}{\out{\hypertarget{method-BackupQueue-set_origin}{}}} 137 | \subsection{Method \code{set_origin()}}{ 138 | \subsection{Usage}{ 139 | \if{html}{\out{
}}\preformatted{BackupQueue$set_origin(x)}\if{html}{\out{
}} 140 | } 141 | 142 | \subsection{Arguments}{ 143 | \if{html}{\out{
}} 144 | \describe{ 145 | \item{\code{x}}{a \code{character} scalar. Path to a file 146 | Set the file to be backed up} 147 | } 148 | \if{html}{\out{
}} 149 | } 150 | } 151 | \if{html}{\out{
}} 152 | \if{html}{\out{}} 153 | \if{latex}{\out{\hypertarget{method-BackupQueue-set_compression}{}}} 154 | \subsection{Method \code{set_compression()}}{ 155 | \subsection{Usage}{ 156 | \if{html}{\out{
}}\preformatted{BackupQueue$set_compression(x)}\if{html}{\out{
}} 157 | } 158 | 159 | \subsection{Arguments}{ 160 | \if{html}{\out{
}} 161 | \describe{ 162 | \item{\code{x}}{a \code{character} scalar. Path to a file} 163 | } 164 | \if{html}{\out{
}} 165 | } 166 | } 167 | \if{html}{\out{
}} 168 | \if{html}{\out{}} 169 | \if{latex}{\out{\hypertarget{method-BackupQueue-set_max_backups}{}}} 170 | \subsection{Method \code{set_max_backups()}}{ 171 | \subsection{Usage}{ 172 | \if{html}{\out{
}}\preformatted{BackupQueue$set_max_backups(x)}\if{html}{\out{
}} 173 | } 174 | 175 | } 176 | \if{html}{\out{
}} 177 | \if{html}{\out{}} 178 | \if{latex}{\out{\hypertarget{method-BackupQueue-set_file}{}}} 179 | \subsection{Method \code{set_file()}}{ 180 | \subsection{Usage}{ 181 | \if{html}{\out{
}}\preformatted{BackupQueue$set_file(x)}\if{html}{\out{
}} 182 | } 183 | 184 | } 185 | \if{html}{\out{
}} 186 | \if{html}{\out{}} 187 | \if{latex}{\out{\hypertarget{method-BackupQueue-set_backup_dir}{}}} 188 | \subsection{Method \code{set_backup_dir()}}{ 189 | \subsection{Usage}{ 190 | \if{html}{\out{
}}\preformatted{BackupQueue$set_backup_dir(x)}\if{html}{\out{
}} 191 | } 192 | 193 | } 194 | } 195 | -------------------------------------------------------------------------------- /man/BackupQueueDate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BackupQueue.R 3 | \name{BackupQueueDate} 4 | \alias{BackupQueueDate} 5 | \title{An R6 class for managing datestamped backups} 6 | \description{ 7 | A BackupQueue for date-stamped backups, e.g. \code{foo.log}, \verb{foo.2020-07-24.log} 8 | } 9 | \details{ 10 | This class is part of the \link[R6:R6Class]{R6} API of \strong{rotor} which is 11 | intended for developers that want to extend this package. For normal usage, 12 | the simpler functional API is recommended (see \code{\link[=rotate]{rotate()}}). 13 | } 14 | \seealso{ 15 | Other R6 Classes: 16 | \code{\link{BackupQueueDateTime}}, 17 | \code{\link{BackupQueueIndex}}, 18 | \code{\link{BackupQueue}}, 19 | \code{\link{Cache}}, 20 | \code{\link{DirectoryQueue}} 21 | } 22 | \concept{R6 Classes} 23 | \section{Super classes}{ 24 | \code{\link[rotor:DirectoryQueue]{rotor::DirectoryQueue}} -> \code{\link[rotor:BackupQueue]{rotor::BackupQueue}} -> \code{\link[rotor:BackupQueueDateTime]{rotor::BackupQueueDateTime}} -> \code{BackupQueueDate} 25 | } 26 | \section{Methods}{ 27 | \subsection{Public methods}{ 28 | \itemize{ 29 | \item \href{#method-BackupQueueDate-new}{\code{BackupQueueDate$new()}} 30 | \item \href{#method-BackupQueueDate-set_fmt}{\code{BackupQueueDate$set_fmt()}} 31 | } 32 | } 33 | \if{html}{\out{ 34 |
Inherited methods 35 | 51 |
52 | }} 53 | \if{html}{\out{
}} 54 | \if{html}{\out{}} 55 | \if{latex}{\out{\hypertarget{method-BackupQueueDate-new}{}}} 56 | \subsection{Method \code{new()}}{ 57 | \subsection{Usage}{ 58 | \if{html}{\out{
}}\preformatted{BackupQueueDate$new( 59 | origin, 60 | dir = dirname(origin), 61 | max_backups = Inf, 62 | compression = FALSE, 63 | fmt = "\%Y-\%m-\%d", 64 | cache_backups = FALSE, 65 | backup_dir = NULL 66 | )}\if{html}{\out{
}} 67 | } 68 | 69 | } 70 | \if{html}{\out{
}} 71 | \if{html}{\out{}} 72 | \if{latex}{\out{\hypertarget{method-BackupQueueDate-set_fmt}{}}} 73 | \subsection{Method \code{set_fmt()}}{ 74 | \subsection{Usage}{ 75 | \if{html}{\out{
}}\preformatted{BackupQueueDate$set_fmt(x)}\if{html}{\out{
}} 76 | } 77 | 78 | } 79 | } 80 | -------------------------------------------------------------------------------- /man/BackupQueueDateTime.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BackupQueue.R 3 | \name{BackupQueueDateTime} 4 | \alias{BackupQueueDateTime} 5 | \title{An R6 class for managing timestamped backups} 6 | \description{ 7 | A BackupQueue for timestamped backups, e.g. \code{foo.log}, \verb{foo.2020-07-24_10-54-30.log} 8 | } 9 | \details{ 10 | This class is part of the \link[R6:R6Class]{R6} API of \strong{rotor} which is 11 | intended for developers that want to extend this package. For normal usage, 12 | the simpler functional API is recommended (see \code{\link[=rotate]{rotate()}}). 13 | } 14 | \seealso{ 15 | Other R6 Classes: 16 | \code{\link{BackupQueueDate}}, 17 | \code{\link{BackupQueueIndex}}, 18 | \code{\link{BackupQueue}}, 19 | \code{\link{Cache}}, 20 | \code{\link{DirectoryQueue}} 21 | } 22 | \concept{R6 Classes} 23 | \section{Super classes}{ 24 | \code{\link[rotor:DirectoryQueue]{rotor::DirectoryQueue}} -> \code{\link[rotor:BackupQueue]{rotor::BackupQueue}} -> \code{BackupQueueDateTime} 25 | } 26 | \section{Active bindings}{ 27 | \if{html}{\out{
}} 28 | \describe{ 29 | \item{\code{fmt}}{See \code{format} argument of \code{\link[=rotate_date]{rotate_date()}} 30 | \code{logical} scalar. If \code{TRUE} (the default) the list of backups is cached, 31 | if \code{FALSE} it is read from disk every time this appender triggers. 32 | Caching brings a significant speedup for checking whether to rotate or 33 | not based on the \code{age} of the last backup, but is only safe if there are 34 | no other programs/functions interacting with the backups. This is only 35 | advantageous for high frequency file rotation (i.e. several times per 36 | second) 37 | \code{POSIXct} scalar. Timestamp of the last rotation (the last backup)} 38 | } 39 | \if{html}{\out{
}} 40 | } 41 | \section{Methods}{ 42 | \subsection{Public methods}{ 43 | \itemize{ 44 | \item \href{#method-BackupQueueDateTime-new}{\code{BackupQueueDateTime$new()}} 45 | \item \href{#method-BackupQueueDateTime-push}{\code{BackupQueueDateTime$push()}} 46 | \item \href{#method-BackupQueueDateTime-prune}{\code{BackupQueueDateTime$prune()}} 47 | \item \href{#method-BackupQueueDateTime-should_rotate}{\code{BackupQueueDateTime$should_rotate()}} 48 | \item \href{#method-BackupQueueDateTime-update_backups_cache}{\code{BackupQueueDateTime$update_backups_cache()}} 49 | \item \href{#method-BackupQueueDateTime-set_max_backups}{\code{BackupQueueDateTime$set_max_backups()}} 50 | \item \href{#method-BackupQueueDateTime-set_fmt}{\code{BackupQueueDateTime$set_fmt()}} 51 | \item \href{#method-BackupQueueDateTime-set_cache_backups}{\code{BackupQueueDateTime$set_cache_backups()}} 52 | } 53 | } 54 | \if{html}{\out{ 55 |
Inherited methods 56 | 66 |
67 | }} 68 | \if{html}{\out{
}} 69 | \if{html}{\out{}} 70 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-new}{}}} 71 | \subsection{Method \code{new()}}{ 72 | \subsection{Usage}{ 73 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$new( 74 | origin, 75 | dir = dirname(origin), 76 | max_backups = Inf, 77 | compression = FALSE, 78 | fmt = "\%Y-\%m-\%d--\%H-\%M-\%S", 79 | cache_backups = FALSE, 80 | backup_dir = NULL 81 | )}\if{html}{\out{
}} 82 | } 83 | 84 | } 85 | \if{html}{\out{
}} 86 | \if{html}{\out{}} 87 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-push}{}}} 88 | \subsection{Method \code{push()}}{ 89 | Create a new time-stamped backup (e.g. \file{logfile.2020-07-22_12-26-29.log}) 90 | \subsection{Usage}{ 91 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$push(overwrite = FALSE, now = Sys.time())}\if{html}{\out{
}} 92 | } 93 | 94 | \subsection{Arguments}{ 95 | \if{html}{\out{
}} 96 | \describe{ 97 | \item{\code{overwrite}}{\code{logical} scalar. Overwrite backups with the same 98 | filename (i.e timestamp)?} 99 | 100 | \item{\code{now}}{\code{POSIXct} scalar. Can be used as an override mechanism for 101 | the current system time if necessary.} 102 | } 103 | \if{html}{\out{
}} 104 | } 105 | } 106 | \if{html}{\out{
}} 107 | \if{html}{\out{}} 108 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-prune}{}}} 109 | \subsection{Method \code{prune()}}{ 110 | \subsection{Usage}{ 111 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$prune(max_backups = self$max_backups)}\if{html}{\out{
}} 112 | } 113 | 114 | } 115 | \if{html}{\out{
}} 116 | \if{html}{\out{}} 117 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-should_rotate}{}}} 118 | \subsection{Method \code{should_rotate()}}{ 119 | Should a file of \code{size} and \code{age} be rotated? See \code{size} and \code{age} 120 | arguments of \code{\link[=rotate_date]{rotate_date()}}. \code{now} overrides the current system time, 121 | `last_rotation`` overrides the date of the last rotation. 122 | \subsection{Usage}{ 123 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$should_rotate( 124 | size, 125 | age, 126 | now = Sys.time(), 127 | last_rotation = self$last_rotation \%||\% file.info(self$origin)$ctime, 128 | verbose = FALSE 129 | )}\if{html}{\out{
}} 130 | } 131 | 132 | \subsection{Returns}{ 133 | \code{TRUE} or \code{FALSE} 134 | } 135 | } 136 | \if{html}{\out{
}} 137 | \if{html}{\out{}} 138 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-update_backups_cache}{}}} 139 | \subsection{Method \code{update_backups_cache()}}{ 140 | Force update of the backups cache (only if \verb{$cache_backups == TRUE}). 141 | \subsection{Usage}{ 142 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$update_backups_cache()}\if{html}{\out{
}} 143 | } 144 | 145 | } 146 | \if{html}{\out{
}} 147 | \if{html}{\out{}} 148 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-set_max_backups}{}}} 149 | \subsection{Method \code{set_max_backups()}}{ 150 | \subsection{Usage}{ 151 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$set_max_backups(x)}\if{html}{\out{
}} 152 | } 153 | 154 | } 155 | \if{html}{\out{
}} 156 | \if{html}{\out{}} 157 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-set_fmt}{}}} 158 | \subsection{Method \code{set_fmt()}}{ 159 | \subsection{Usage}{ 160 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$set_fmt(x)}\if{html}{\out{
}} 161 | } 162 | 163 | } 164 | \if{html}{\out{
}} 165 | \if{html}{\out{}} 166 | \if{latex}{\out{\hypertarget{method-BackupQueueDateTime-set_cache_backups}{}}} 167 | \subsection{Method \code{set_cache_backups()}}{ 168 | \subsection{Usage}{ 169 | \if{html}{\out{
}}\preformatted{BackupQueueDateTime$set_cache_backups(x)}\if{html}{\out{
}} 170 | } 171 | 172 | } 173 | } 174 | -------------------------------------------------------------------------------- /man/BackupQueueIndex.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/BackupQueue.R 3 | \name{BackupQueueIndex} 4 | \alias{BackupQueueIndex} 5 | \title{An R6 class for managing indexed backups} 6 | \description{ 7 | A BackupQueue for indexed backups, e.g. \code{foo.log}, \code{foo.1.log}, \code{foo.2.log}, ... 8 | } 9 | \details{ 10 | This class is part of the \link[R6:R6Class]{R6} API of \strong{rotor} which is 11 | intended for developers that want to extend this package. For normal usage, 12 | the simpler functional API is recommended (see \code{\link[=rotate]{rotate()}}). 13 | } 14 | \seealso{ 15 | Other R6 Classes: 16 | \code{\link{BackupQueueDateTime}}, 17 | \code{\link{BackupQueueDate}}, 18 | \code{\link{BackupQueue}}, 19 | \code{\link{Cache}}, 20 | \code{\link{DirectoryQueue}} 21 | } 22 | \concept{R6 Classes} 23 | \section{Super classes}{ 24 | \code{\link[rotor:DirectoryQueue]{rotor::DirectoryQueue}} -> \code{\link[rotor:BackupQueue]{rotor::BackupQueue}} -> \code{BackupQueueIndex} 25 | } 26 | \section{Methods}{ 27 | \subsection{Public methods}{ 28 | \itemize{ 29 | \item \href{#method-BackupQueueIndex-push}{\code{BackupQueueIndex$push()}} 30 | \item \href{#method-BackupQueueIndex-prune}{\code{BackupQueueIndex$prune()}} 31 | \item \href{#method-BackupQueueIndex-prune_identical}{\code{BackupQueueIndex$prune_identical()}} 32 | \item \href{#method-BackupQueueIndex-should_rotate}{\code{BackupQueueIndex$should_rotate()}} 33 | \item \href{#method-BackupQueueIndex-pad_index}{\code{BackupQueueIndex$pad_index()}} 34 | \item \href{#method-BackupQueueIndex-increment_index}{\code{BackupQueueIndex$increment_index()}} 35 | } 36 | } 37 | \if{html}{\out{ 38 |
Inherited methods 39 | 50 |
51 | }} 52 | \if{html}{\out{
}} 53 | \if{html}{\out{}} 54 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-push}{}}} 55 | \subsection{Method \code{push()}}{ 56 | Create a new index-stamped backup (e.g. \file{logfile.1.log}) 57 | \subsection{Usage}{ 58 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$push()}\if{html}{\out{
}} 59 | } 60 | 61 | } 62 | \if{html}{\out{
}} 63 | \if{html}{\out{}} 64 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-prune}{}}} 65 | \subsection{Method \code{prune()}}{ 66 | \subsection{Usage}{ 67 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$prune(max_backups = self$max_backups)}\if{html}{\out{
}} 68 | } 69 | 70 | } 71 | \if{html}{\out{
}} 72 | \if{html}{\out{}} 73 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-prune_identical}{}}} 74 | \subsection{Method \code{prune_identical()}}{ 75 | \subsection{Usage}{ 76 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$prune_identical()}\if{html}{\out{
}} 77 | } 78 | 79 | } 80 | \if{html}{\out{
}} 81 | \if{html}{\out{}} 82 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-should_rotate}{}}} 83 | \subsection{Method \code{should_rotate()}}{ 84 | Should a file of \code{size} be rotated? See \code{size} argument of \code{\link[=rotate]{rotate()}} 85 | \subsection{Usage}{ 86 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$should_rotate(size, verbose = FALSE)}\if{html}{\out{
}} 87 | } 88 | 89 | \subsection{Returns}{ 90 | \code{TRUE} or \code{FALSE} 91 | } 92 | } 93 | \if{html}{\out{
}} 94 | \if{html}{\out{}} 95 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-pad_index}{}}} 96 | \subsection{Method \code{pad_index()}}{ 97 | Pad the indices in the filenames of indexed backups 98 | to the number of digits of the largest index. Usually does not have to 99 | be called manually. 100 | \subsection{Usage}{ 101 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$pad_index()}\if{html}{\out{
}} 102 | } 103 | 104 | } 105 | \if{html}{\out{
}} 106 | \if{html}{\out{}} 107 | \if{latex}{\out{\hypertarget{method-BackupQueueIndex-increment_index}{}}} 108 | \subsection{Method \code{increment_index()}}{ 109 | Increment die Indices of all backups by \code{n} Usually does 110 | not have to be called manually. 111 | \subsection{Usage}{ 112 | \if{html}{\out{
}}\preformatted{BackupQueueIndex$increment_index(n = 1)}\if{html}{\out{
}} 113 | } 114 | 115 | \subsection{Arguments}{ 116 | \if{html}{\out{
}} 117 | \describe{ 118 | \item{\code{n}}{\code{integer} > 0} 119 | } 120 | \if{html}{\out{
}} 121 | } 122 | } 123 | } 124 | -------------------------------------------------------------------------------- /man/DirectoryQueue.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/DirectoryQueue.R 3 | \name{DirectoryQueue} 4 | \alias{DirectoryQueue} 5 | \title{An R6 class for managing persistent file-based queues (abstract base class)} 6 | \description{ 7 | Abstract class from which all other classes in \pkg{rotor} inherit their 8 | basic fields and methods. 9 | } 10 | \details{ 11 | This class is part of the \link[R6:R6Class]{R6} API of \strong{rotor} which is 12 | intended for developers that want to extend this package. For normal usage, 13 | the simpler functional API is recommended (see \code{\link[=rotate]{rotate()}}). 14 | } 15 | \seealso{ 16 | Other R6 Classes: 17 | \code{\link{BackupQueueDateTime}}, 18 | \code{\link{BackupQueueDate}}, 19 | \code{\link{BackupQueueIndex}}, 20 | \code{\link{BackupQueue}}, 21 | \code{\link{Cache}} 22 | } 23 | \concept{R6 Classes} 24 | \section{Active bindings}{ 25 | \if{html}{\out{
}} 26 | \describe{ 27 | \item{\code{dir}}{a \code{character} scalar. path of the directory in which to store 28 | the cache files} 29 | } 30 | \if{html}{\out{
}} 31 | } 32 | \section{Methods}{ 33 | \subsection{Public methods}{ 34 | \itemize{ 35 | \item \href{#method-DirectoryQueue-new}{\code{DirectoryQueue$new()}} 36 | \item \href{#method-DirectoryQueue-push}{\code{DirectoryQueue$push()}} 37 | \item \href{#method-DirectoryQueue-prune}{\code{DirectoryQueue$prune()}} 38 | \item \href{#method-DirectoryQueue-set_dir}{\code{DirectoryQueue$set_dir()}} 39 | } 40 | } 41 | \if{html}{\out{
}} 42 | \if{html}{\out{}} 43 | \if{latex}{\out{\hypertarget{method-DirectoryQueue-new}{}}} 44 | \subsection{Method \code{new()}}{ 45 | \subsection{Usage}{ 46 | \if{html}{\out{
}}\preformatted{DirectoryQueue$new(...)}\if{html}{\out{
}} 47 | } 48 | 49 | } 50 | \if{html}{\out{
}} 51 | \if{html}{\out{}} 52 | \if{latex}{\out{\hypertarget{method-DirectoryQueue-push}{}}} 53 | \subsection{Method \code{push()}}{ 54 | \subsection{Usage}{ 55 | \if{html}{\out{
}}\preformatted{DirectoryQueue$push(x, ...)}\if{html}{\out{
}} 56 | } 57 | 58 | } 59 | \if{html}{\out{
}} 60 | \if{html}{\out{}} 61 | \if{latex}{\out{\hypertarget{method-DirectoryQueue-prune}{}}} 62 | \subsection{Method \code{prune()}}{ 63 | \subsection{Usage}{ 64 | \if{html}{\out{
}}\preformatted{DirectoryQueue$prune(x, ...)}\if{html}{\out{
}} 65 | } 66 | 67 | } 68 | \if{html}{\out{
}} 69 | \if{html}{\out{}} 70 | \if{latex}{\out{\hypertarget{method-DirectoryQueue-set_dir}{}}} 71 | \subsection{Method \code{set_dir()}}{ 72 | \subsection{Usage}{ 73 | \if{html}{\out{
}}\preformatted{DirectoryQueue$set_dir(x, create = TRUE)}\if{html}{\out{
}} 74 | } 75 | 76 | } 77 | } 78 | -------------------------------------------------------------------------------- /man/backup_info.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/list_backups.R 3 | \name{backup_info} 4 | \alias{backup_info} 5 | \alias{list_backups} 6 | \alias{n_backups} 7 | \alias{newest_backup} 8 | \alias{oldest_backup} 9 | \title{Discover existing backups} 10 | \usage{ 11 | backup_info(file, dir = dirname(file)) 12 | 13 | list_backups(file, dir = dirname(file)) 14 | 15 | n_backups(file, dir = dirname(file)) 16 | 17 | newest_backup(file, dir = dirname(file)) 18 | 19 | oldest_backup(file, dir = dirname(file)) 20 | } 21 | \arguments{ 22 | \item{file}{\code{character} scalar: Path to a file.} 23 | 24 | \item{dir}{\code{character} scalar. The directory in which the backups 25 | of \code{file} are stored (defaults to \code{dirname(file)})} 26 | } 27 | \value{ 28 | \code{backup_info()} returns a \code{data.frame} similar to the output of 29 | \code{\link[=file.info]{file.info()}} 30 | 31 | \code{list_backups()} returns the paths to all backups of \code{file} 32 | 33 | \code{n_backups()} returns the number of backups of \code{file} as an \code{integer} 34 | scalar 35 | 36 | \code{newest_backup()} and \code{oldest_backup()} return the paths to the 37 | newest or oldest backup of \code{file} (or an empty \code{character} vector if none exist) 38 | } 39 | \description{ 40 | These function return information on the backups of a file (if any exist) 41 | } 42 | \section{Intervals}{ 43 | 44 | 45 | In \strong{rotor}, an interval is a character string in the form 46 | \code{" "}. The following intervals are possible: 47 | \code{"day(s)"}, \code{"week(s)"}, \code{"month(s)"}, \code{"quarter(s)"}, \code{"year(s)"}. 48 | The plural \code{"s"} is optional (so \code{"2 weeks"} and \code{"2 week"} are equivalent). 49 | Please be aware that weeks are 50 | \href{https://en.wikipedia.org/wiki/ISO_week_date}{ISOweeks} 51 | and start on Monday (not Sunday as in some countries). 52 | 53 | Interval strings can be used as arguments when backing up or rotating files, 54 | or for pruning backup queues (i.e. limiting the number of backups of a 55 | single) file. 56 | 57 | When rotating/backing up \code{"1 months"} means "make a new backup if the last 58 | backup is from the preceding month". E.g if the last backup of \code{myfile} 59 | is from \code{2019-02-01} then \code{backup_time(myfile, age = "1 month")} will only 60 | create a backup if the current date is at least \code{2019-03-01}. 61 | 62 | When pruning/limiting backup queues, \code{"1 year"} means "keep at least most 63 | one year worth of backups". So if you call 64 | \code{backup_time(myfile, max_backups = "1 year")} on \code{2019-03-01}, it will create 65 | a backup and then remove all backups of \code{myfile} before \code{2019-01-01}. 66 | } 67 | 68 | \examples{ 69 | # setup example files 70 | tf <- tempfile("test", fileext = ".rds") 71 | saveRDS(cars, tf) 72 | backup(tf) 73 | backup(tf) 74 | 75 | backup_info(tf) 76 | list_backups(tf) 77 | n_backups(tf) 78 | newest_backup(tf) 79 | oldest_backup(tf) 80 | 81 | # cleanup 82 | prune_backups(tf, 0) 83 | n_backups(tf) 84 | file.remove(tf) 85 | } 86 | \seealso{ 87 | \code{\link[=rotate]{rotate()}} 88 | } 89 | -------------------------------------------------------------------------------- /man/rotate.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rotate.R, R/rotate_date.R, R/rotate_time.R 3 | \name{rotate} 4 | \alias{rotate} 5 | \alias{backup} 6 | \alias{prune_backups} 7 | \alias{prune_identical_backups} 8 | \alias{rotate_date} 9 | \alias{backup_date} 10 | \alias{rotate_time} 11 | \alias{backup_time} 12 | \title{Rotate or backup files} 13 | \usage{ 14 | rotate( 15 | file, 16 | size = 1, 17 | max_backups = Inf, 18 | compression = FALSE, 19 | dir = dirname(file), 20 | create_file = TRUE, 21 | dry_run = FALSE, 22 | verbose = dry_run 23 | ) 24 | 25 | backup( 26 | file, 27 | size = 0, 28 | max_backups = Inf, 29 | compression = FALSE, 30 | dir = dirname(file), 31 | dry_run = FALSE, 32 | verbose = dry_run 33 | ) 34 | 35 | prune_backups( 36 | file, 37 | max_backups, 38 | dir = dirname(file), 39 | dry_run = FALSE, 40 | verbose = dry_run 41 | ) 42 | 43 | prune_identical_backups( 44 | file, 45 | dir = dirname(file), 46 | dry_run = FALSE, 47 | verbose = dry_run 48 | ) 49 | 50 | rotate_date( 51 | file, 52 | age = 1, 53 | size = 1, 54 | max_backups = Inf, 55 | compression = FALSE, 56 | format = "\%Y-\%m-\%d", 57 | dir = dirname(file), 58 | overwrite = FALSE, 59 | create_file = TRUE, 60 | now = Sys.Date(), 61 | dry_run = FALSE, 62 | verbose = dry_run 63 | ) 64 | 65 | backup_date( 66 | file, 67 | age = 1, 68 | size = 1, 69 | max_backups = Inf, 70 | compression = FALSE, 71 | format = "\%Y-\%m-\%d", 72 | dir = dirname(file), 73 | overwrite = FALSE, 74 | now = Sys.Date(), 75 | dry_run = FALSE, 76 | verbose = dry_run 77 | ) 78 | 79 | rotate_time( 80 | file, 81 | age = -1, 82 | size = 1, 83 | max_backups = Inf, 84 | compression = FALSE, 85 | format = "\%Y-\%m-\%d--\%H-\%M-\%S", 86 | dir = dirname(file), 87 | overwrite = FALSE, 88 | create_file = TRUE, 89 | now = Sys.time(), 90 | dry_run = FALSE, 91 | verbose = dry_run 92 | ) 93 | 94 | backup_time( 95 | file, 96 | age = -1, 97 | size = 1, 98 | max_backups = Inf, 99 | compression = FALSE, 100 | format = "\%Y-\%m-\%d--\%H-\%M-\%S", 101 | dir = dirname(file), 102 | overwrite = FALSE, 103 | now = Sys.time(), 104 | dry_run = FALSE, 105 | verbose = dry_run 106 | ) 107 | } 108 | \arguments{ 109 | \item{file}{\code{character} scalar: file to backup/rotate} 110 | 111 | \item{size}{scalar \code{integer}, \code{character} or \code{Inf}. Backup/rotate only if 112 | \code{file} is larger than this size. \code{Integers} are interpreted as bytes. You 113 | can pass \code{character} vectors that contain a file size suffix like \verb{1k} 114 | (kilobytes), \verb{3M} (megabytes), \verb{4G} (gigabytes), \verb{5T} (terabytes). Instead 115 | of these short forms you can also be explicit and use the IEC suffixes 116 | \code{KiB}, \code{MiB}, \code{GiB}, \code{TiB}. In Both cases \code{1} kilobyte is \code{1024} bytes, 1 117 | \code{megabyte} is \code{1024} kilobytes, etc... . 118 | 119 | (if \code{age} \emph{and} \code{size} are provided, both criteria must be \code{TRUE} to 120 | trigger rotation)} 121 | 122 | \item{max_backups}{maximum number of backups to keep 123 | \itemize{ 124 | \item an \code{integer} scalar: Maximum number of backups to keep 125 | } 126 | 127 | In addition for timestamped backups the following value are supported: 128 | \itemize{ 129 | \item a \code{Date} scalar: Remove all backups before this date 130 | \item a \code{character} scalar representing a Date in ISO format (e.g. \code{"2019-12-31"}) 131 | \item a \code{character} scalar representing an Interval in the form \code{" "} (see below for more info) 132 | }} 133 | 134 | \item{compression}{Whether or not backups should be compressed 135 | \itemize{ 136 | \item \code{FALSE} for uncompressed backups, 137 | \item \code{TRUE} for zip compression; uses \code{\link[=zip]{zip()}} 138 | \item a scalar \code{integer} between \code{1} and \code{9} to specify a compression 139 | level (requires the 140 | \href{https://CRAN.R-project.org/package=zip}{zip} package, 141 | see its documentation for details) 142 | \item the \code{character} scalars \code{"utils::zip()"} or \code{"zip::zipr"} to force a 143 | specific zip command 144 | }} 145 | 146 | \item{dir}{\code{character} scalar. The directory in which the backups 147 | of \code{file} are stored (defaults to \code{dirname(file)})} 148 | 149 | \item{create_file}{\code{logical} scalar. If \code{TRUE} create an empty file in 150 | place of \code{file} after rotating.} 151 | 152 | \item{dry_run}{\code{logical} scalar. If \code{TRUE} no changes are applied to the 153 | file system (no files are created or deleted)} 154 | 155 | \item{verbose}{\code{logical} scalar. If \code{TRUE} additional informative \code{messages} 156 | are printed} 157 | 158 | \item{age}{minimum age after which to backup/rotate a file; can be 159 | \itemize{ 160 | \item a \code{character} scalar representing an Interval in the form 161 | \code{" "} (e.g. \code{"2 months"}, see \emph{Intervals} section below). 162 | \item a \code{Date} or a \code{character} scalar representing a Date for 163 | a fixed point in time after which to backup/rotate. See \code{format} for 164 | which Date/Datetime formats are supported by rotor. 165 | } 166 | 167 | (if \code{age} \emph{and} \code{size} are provided, both criteria must be \code{TRUE} to 168 | trigger rotation)} 169 | 170 | \item{format}{a scalar \code{character} that can be a subset of of valid 171 | \code{strftime()} formatting strings. The default setting is 172 | \code{"\%Y-\%m-\%d--\%H-\%M-\%S"}. 173 | \itemize{ 174 | \item You can use an arbitrary number of dashes anywhere in the format, so 175 | \code{"\%Y-\%m-\%d--\%H-\%M-\%S"} and \code{"\%Y\%m\%d\%H\%M\%S"} are both legal. 176 | \item \code{T} and \verb{_} can also be used as separators. For example, the following 177 | datetime formats are also possible: 178 | \verb{\%Y-\%m-\%d_\%H-\%M-\%S} (Python logging default), 179 | \verb{\%Y\%m\%dT\%H\%M\%S} (\href{https://en.wikipedia.org/wiki/ISO_8601}{ISO 8601}) 180 | \item All datetime components except \verb{\%Y} are optional. If you leave out part 181 | of the timestamp, the first point in time in the period is assumed. For 182 | example (assuming the current year is 2019) \verb{\%Y} is identical to 183 | \code{2019-01-01--00-00-00}. 184 | \item The timestamps must be lexically sortable, so \code{"\%Y-\%m-\%d"} is legal, 185 | \code{"\%m-\%d-\%Y"} and \verb{\%Y-\%d} are not. 186 | }} 187 | 188 | \item{overwrite}{\code{logical} scalar. If \code{TRUE} overwrite backups if a backup 189 | of the same name (usually due to timestamp collision) exists.} 190 | 191 | \item{now}{The current \code{Date} or time (\code{POSIXct}) as a scalar. You can pass a 192 | custom value here to to override the real system time. As a convenience you 193 | can also pass in \code{character} strings that follow the guidelines outlined 194 | above for \code{format}, but please note that these differ from the formats 195 | understood by \code{\link[=as.POSIXct]{as.POSIXct()}} or \code{\link[=as.Date]{as.Date()}}.} 196 | } 197 | \value{ 198 | \code{file} as a \code{character} scalar (invisibly) 199 | } 200 | \description{ 201 | Functions starting with \code{backup} create backups of a \code{file}, while functions 202 | starting with \code{rotate} do the same but also replace the original \code{file} 203 | with an empty one (this is useful for log rotation) 204 | 205 | \strong{Note:}: \code{rotate()} and co will not work reliable on filenames that contain 206 | dots but have no file extension (e.g. \code{my.holiday.picture.jpg} is OK but 207 | \code{my.holiday.picture} is not) 208 | 209 | \code{prune_backups()} physically deletes all backups of a file 210 | based on \code{max_backups} 211 | 212 | \code{prune_backups()} physically deletes all backups of a file 213 | based on \code{max_backups} 214 | } 215 | \section{Side Effects}{ 216 | 217 | \code{backup()}, \code{backup_date()}, and \code{backup_time()} may create files (if the 218 | specified conditions are met). They may also delete backups, based on 219 | \code{max_backup}. 220 | 221 | \code{rotate()}, \code{rotate_date()} and \code{rotate_time()} do the same, but in 222 | addition delete the input \code{file}, or replace it with an empty file if 223 | \code{create_file == TRUE} (the default). 224 | 225 | 226 | \code{prune_backups()} may delete files, depending on \code{max_backups}. 227 | 228 | 229 | \code{prune_backups()} may delete files, depending on \code{max_backups}. 230 | } 231 | 232 | \section{Intervals}{ 233 | 234 | 235 | In \strong{rotor}, an interval is a character string in the form 236 | \code{" "}. The following intervals are possible: 237 | \code{"day(s)"}, \code{"week(s)"}, \code{"month(s)"}, \code{"quarter(s)"}, \code{"year(s)"}. 238 | The plural \code{"s"} is optional (so \code{"2 weeks"} and \code{"2 week"} are equivalent). 239 | Please be aware that weeks are 240 | \href{https://en.wikipedia.org/wiki/ISO_week_date}{ISOweeks} 241 | and start on Monday (not Sunday as in some countries). 242 | 243 | Interval strings can be used as arguments when backing up or rotating files, 244 | or for pruning backup queues (i.e. limiting the number of backups of a 245 | single) file. 246 | 247 | When rotating/backing up \code{"1 months"} means "make a new backup if the last 248 | backup is from the preceding month". E.g if the last backup of \code{myfile} 249 | is from \code{2019-02-01} then \code{backup_time(myfile, age = "1 month")} will only 250 | create a backup if the current date is at least \code{2019-03-01}. 251 | 252 | When pruning/limiting backup queues, \code{"1 year"} means "keep at least most 253 | one year worth of backups". So if you call 254 | \code{backup_time(myfile, max_backups = "1 year")} on \code{2019-03-01}, it will create 255 | a backup and then remove all backups of \code{myfile} before \code{2019-01-01}. 256 | } 257 | 258 | \examples{ 259 | # setup example file 260 | tf <- tempfile("test", fileext = ".rds") 261 | saveRDS(cars, tf) 262 | 263 | # create two backups of `tf`` 264 | backup(tf) 265 | backup(tf) 266 | list_backups(tf) # find all backups of a file 267 | 268 | # If `size` is set, a backup is only created if the target file is at least 269 | # that big. This is more useful for log rotation than for backups. 270 | backup(tf, size = "100 mb") # no backup becuase `tf` is to small 271 | list_backups(tf) 272 | 273 | # If `dry_run` is TRUE, backup() only shows what would happen without 274 | # actually creating or deleting files 275 | backup(tf, size = "0.1kb", dry_run = TRUE) 276 | 277 | # rotate() is the same as backup(), but replaces `tf`` with an empty file 278 | rotate(tf) 279 | list_backups(tf) 280 | file.size(tf) 281 | file.size(list_backups(tf)) 282 | 283 | # prune_backups() can remove old backups 284 | prune_backups(tf, 1) # keep only one backup 285 | list_backups(tf) 286 | 287 | # rotate/backup_date() adds a date instead of an index 288 | # you should not mix index backups and timestamp backups 289 | # so we clean up first 290 | prune_backups(tf, 0) 291 | saveRDS(cars, tf) 292 | 293 | # backup_date() adds the date instead of an index to the filename 294 | backup_date(tf) 295 | 296 | # `age` sets the minimum age of the last backup before creating a new one. 297 | # the example below creates no new backup since it's less than a week 298 | # since the last. 299 | backup_date(tf, age = "1 week") 300 | 301 | # `now` overrides the current date. 302 | backup_date(tf, age = "1 year", now = "2999-12-31") 303 | list_backups(tf) 304 | 305 | # backup_time() creates backups with a full timestamp 306 | backup_time(tf) 307 | 308 | # It's okay to mix backup_date() and backup_time() 309 | list_backups(tf) 310 | 311 | # cleanup 312 | prune_backups(tf, 0) 313 | file.remove(tf) 314 | } 315 | \seealso{ 316 | \code{\link[=list_backups]{list_backups()}} 317 | } 318 | -------------------------------------------------------------------------------- /man/rotate_rds.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rotate_rds.R 3 | \name{rotate_rds} 4 | \alias{rotate_rds} 5 | \alias{rotate_rds_date} 6 | \alias{rotate_rds_time} 7 | \title{Serialize R objects to disk (with backup)} 8 | \usage{ 9 | rotate_rds( 10 | object, 11 | file = "", 12 | ascii = FALSE, 13 | version = NULL, 14 | compress = TRUE, 15 | refhook = NULL, 16 | ..., 17 | on_change_only = FALSE 18 | ) 19 | 20 | rotate_rds_date( 21 | object, 22 | file = "", 23 | ascii = FALSE, 24 | version = NULL, 25 | compress = TRUE, 26 | refhook = NULL, 27 | ..., 28 | age = -1L, 29 | on_change_only = FALSE 30 | ) 31 | 32 | rotate_rds_time( 33 | object, 34 | file = "", 35 | ascii = FALSE, 36 | version = NULL, 37 | compress = TRUE, 38 | refhook = NULL, 39 | ..., 40 | age = -1L, 41 | on_change_only = FALSE 42 | ) 43 | } 44 | \arguments{ 45 | \item{object}{\R object to serialize.} 46 | 47 | \item{file}{a \link[base]{connection} or the name of the file where the \R object 48 | is saved to or read from.} 49 | 50 | \item{ascii}{a logical. If \code{TRUE} or \code{NA}, an ASCII 51 | representation is written; otherwise (default), a binary one is used. 52 | See the comments in the help for \code{\link[base]{save}}.} 53 | 54 | \item{version}{the workspace format version to use. \code{NULL} 55 | specifies the current default version (3). The only other supported 56 | value is 2, the default from \R 1.4.0 to \R 3.5.0.} 57 | 58 | \item{compress}{a logical specifying whether saving to a named file is 59 | to use \code{"gzip"} compression, or one of \code{"gzip"}, 60 | \code{"bzip2"} or \code{"xz"} to indicate the type of compression to 61 | be used. Ignored if \code{file} is a connection.} 62 | 63 | \item{refhook}{a hook function for handling reference objects.} 64 | 65 | \item{...}{ 66 | Arguments passed on to \code{\link[=rotate]{rotate}}, \code{\link[=rotate_date]{rotate_date}}, \code{\link[=rotate_time]{rotate_time}} 67 | \describe{ 68 | \item{\code{max_backups}}{maximum number of backups to keep 69 | \itemize{ 70 | \item an \code{integer} scalar: Maximum number of backups to keep 71 | } 72 | 73 | In addition for timestamped backups the following value are supported: 74 | \itemize{ 75 | \item a \code{Date} scalar: Remove all backups before this date 76 | \item a \code{character} scalar representing a Date in ISO format (e.g. \code{"2019-12-31"}) 77 | \item a \code{character} scalar representing an Interval in the form \code{" "} (see below for more info) 78 | }} 79 | \item{\code{size}}{scalar \code{integer}, \code{character} or \code{Inf}. Backup/rotate only if 80 | \code{file} is larger than this size. \code{Integers} are interpreted as bytes. You 81 | can pass \code{character} vectors that contain a file size suffix like \verb{1k} 82 | (kilobytes), \verb{3M} (megabytes), \verb{4G} (gigabytes), \verb{5T} (terabytes). Instead 83 | of these short forms you can also be explicit and use the IEC suffixes 84 | \code{KiB}, \code{MiB}, \code{GiB}, \code{TiB}. In Both cases \code{1} kilobyte is \code{1024} bytes, 1 85 | \code{megabyte} is \code{1024} kilobytes, etc... . 86 | 87 | (if \code{age} \emph{and} \code{size} are provided, both criteria must be \code{TRUE} to 88 | trigger rotation)} 89 | \item{\code{dir}}{\code{character} scalar. The directory in which the backups 90 | of \code{file} are stored (defaults to \code{dirname(file)})} 91 | \item{\code{compression}}{Whether or not backups should be compressed 92 | \itemize{ 93 | \item \code{FALSE} for uncompressed backups, 94 | \item \code{TRUE} for zip compression; uses \code{\link[=zip]{zip()}} 95 | \item a scalar \code{integer} between \code{1} and \code{9} to specify a compression 96 | level (requires the 97 | \href{https://CRAN.R-project.org/package=zip}{zip} package, 98 | see its documentation for details) 99 | \item the \code{character} scalars \code{"utils::zip()"} or \code{"zip::zipr"} to force a 100 | specific zip command 101 | }} 102 | \item{\code{dry_run}}{\code{logical} scalar. If \code{TRUE} no changes are applied to the 103 | file system (no files are created or deleted)} 104 | \item{\code{verbose}}{\code{logical} scalar. If \code{TRUE} additional informative \code{messages} 105 | are printed} 106 | \item{\code{create_file}}{\code{logical} scalar. If \code{TRUE} create an empty file in 107 | place of \code{file} after rotating.} 108 | \item{\code{format}}{a scalar \code{character} that can be a subset of of valid 109 | \code{strftime()} formatting strings. The default setting is 110 | \code{"\%Y-\%m-\%d--\%H-\%M-\%S"}. 111 | \itemize{ 112 | \item You can use an arbitrary number of dashes anywhere in the format, so 113 | \code{"\%Y-\%m-\%d--\%H-\%M-\%S"} and \code{"\%Y\%m\%d\%H\%M\%S"} are both legal. 114 | \item \code{T} and \verb{_} can also be used as separators. For example, the following 115 | datetime formats are also possible: 116 | \verb{\%Y-\%m-\%d_\%H-\%M-\%S} (Python logging default), 117 | \verb{\%Y\%m\%dT\%H\%M\%S} (\href{https://en.wikipedia.org/wiki/ISO_8601}{ISO 8601}) 118 | \item All datetime components except \verb{\%Y} are optional. If you leave out part 119 | of the timestamp, the first point in time in the period is assumed. For 120 | example (assuming the current year is 2019) \verb{\%Y} is identical to 121 | \code{2019-01-01--00-00-00}. 122 | \item The timestamps must be lexically sortable, so \code{"\%Y-\%m-\%d"} is legal, 123 | \code{"\%m-\%d-\%Y"} and \verb{\%Y-\%d} are not. 124 | }} 125 | \item{\code{now}}{The current \code{Date} or time (\code{POSIXct}) as a scalar. You can pass a 126 | custom value here to to override the real system time. As a convenience you 127 | can also pass in \code{character} strings that follow the guidelines outlined 128 | above for \code{format}, but please note that these differ from the formats 129 | understood by \code{\link[=as.POSIXct]{as.POSIXct()}} or \code{\link[=as.Date]{as.Date()}}.} 130 | \item{\code{overwrite}}{\code{logical} scalar. If \code{TRUE} overwrite backups if a backup 131 | of the same name (usually due to timestamp collision) exists.} 132 | }} 133 | 134 | \item{on_change_only}{\code{logical} scalaror a \code{list}. Rotate only if \code{object} 135 | is different from the object saved in \code{file}. If a \code{list}, arguments 136 | that will be passed on to \code{data.table::all.equal} (only when both obects 137 | are \code{data.tables})} 138 | 139 | \item{age}{minimum age after which to backup/rotate a file; can be 140 | \itemize{ 141 | \item a \code{character} scalar representing an Interval in the form 142 | \code{" "} (e.g. \code{"2 months"}, see \emph{Intervals} section below). 143 | \item a \code{Date} or a \code{character} scalar representing a Date for 144 | a fixed point in time after which to backup/rotate. See \code{format} for 145 | which Date/Datetime formats are supported by rotor. 146 | } 147 | 148 | (if \code{age} \emph{and} \code{size} are provided, both criteria must be \code{TRUE} to 149 | trigger rotation)} 150 | } 151 | \value{ 152 | the path to \code{file} (invisibly) 153 | } 154 | \description{ 155 | The \verb{rotate_rds*()} functions are wrappers around \link[base:readRDS]{base::saveRDS()} that 156 | create a backup of the destination file (if it exists) instead of just 157 | overwriting it. 158 | } 159 | \note{ 160 | The default value for \code{age} is different for \code{rotate_rds_date()} (\code{-1}) 161 | than for \code{\link[=rotate_date]{rotate_date()}} (\code{1}) to make it a bit safer. This means if you 162 | execute \code{rotate_date()} twice on the same file on a given day it will 163 | silently not rotate the file, while \code{rotate_rds_date()} will throw an 164 | error. 165 | } 166 | \examples{ 167 | dest <- tempfile() 168 | rotate_rds(iris, dest) 169 | rotate_rds(iris, dest) 170 | rotate_rds(iris, dest) 171 | 172 | list_backups(dest) 173 | 174 | # cleanup 175 | unlink(list_backups(dest)) 176 | unlink(dest) 177 | } 178 | -------------------------------------------------------------------------------- /man/rotor-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/rotor-package.R 3 | \docType{package} 4 | \name{rotor-package} 5 | \alias{rotor} 6 | \alias{rotor-package} 7 | \title{rotor: Log Rotation and Conditional Backups} 8 | \description{ 9 | Conditionally rotate or back-up files based on their size or the date of the last backup; inspired by the 'Linux' utility 'logrotate'. 10 | } 11 | \seealso{ 12 | Useful links: 13 | \itemize{ 14 | \item \url{https://s-fleck.github.io/rotor/} 15 | \item Report bugs at \url{https://github.com/s-fleck/rotor/issues} 16 | } 17 | 18 | } 19 | \author{ 20 | \strong{Maintainer}: Stefan Fleck \email{stefan.b.fleck@gmail.com} (\href{https://orcid.org/0000-0003-3344-9851}{ORCID}) 21 | 22 | } 23 | \keyword{internal} 24 | -------------------------------------------------------------------------------- /revdep/.gitignore: -------------------------------------------------------------------------------- 1 | checks 2 | library 3 | checks.noindex 4 | library.noindex 5 | data.sqlite 6 | *.html 7 | -------------------------------------------------------------------------------- /revdep/email.yml: -------------------------------------------------------------------------------- 1 | release_date: ??? 2 | rel_release_date: ??? 3 | my_news_url: ??? 4 | release_version: ??? 5 | release_details: ??? 6 | -------------------------------------------------------------------------------- /rotor.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: XeLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(rotor) 3 | 4 | test_check("rotor") 5 | -------------------------------------------------------------------------------- /tests/testthat/test_Cache.R: -------------------------------------------------------------------------------- 1 | context("Cache") 2 | 3 | 4 | # generate lexically sortable ids. For equal timestamp, Cache$files is sorted 5 | # by id, so that the tests do not fail on file systems with low-accuracy 6 | # timestamps 7 | .id_cache <- new.env() 8 | assign("id", 0L, .id_cache) 9 | ascending_id <- function(){ 10 | x <- get("id", .id_cache) 11 | x <- pad_left(as.integer(x) + 1L, width = 8, pad = "0") 12 | assert(identical(nchar(x), 8L)) 13 | assign("id", x, .id_cache) 14 | x 15 | } 16 | 17 | 18 | test_that("Cache works as expected", { 19 | td <- file.path(tempdir(), "cache-test") 20 | on.exit(unlink(td, recursive = TRUE)) 21 | 22 | # cache can be created 23 | cache <- Cache$new(td) 24 | 25 | # put elements into the cache 26 | key1 <- cache$push(iris) 27 | key2 <- cache$push(cars) 28 | expect_identical(cache$n, 2L) 29 | 30 | # read elements from the cache 31 | expect_identical(cache$read(key1), iris) 32 | expect_identical(cache$read(key2), cars) 33 | 34 | # remove 35 | cache$remove(key1) 36 | expect_identical(cache$n, 1L) 37 | expect_error(cache$read(key1)) 38 | 39 | # pop 40 | expect_error(cache$pop(key1)) 41 | res <- cache$pop(key2) 42 | expect_identical(cache$n, 0L) 43 | expect_identical(res, cars) 44 | }) 45 | 46 | 47 | 48 | 49 | test_that("setting hash functions work", { 50 | td <- file.path(tempdir(), "cache-test") 51 | on.exit(unlink(td, recursive = TRUE)) 52 | 53 | # When using a real hash function as hashfun, identical objects will only 54 | # be added to the cache once 55 | cache_hash <- Cache$new(td, hashfun = digest::digest) 56 | cache_hash$push(iris) 57 | cache_hash$push(iris) 58 | expect_identical(cache_hash$n, 1L) 59 | cache_hash$purge() 60 | expect_identical(cache_hash$n, 0L) 61 | 62 | 63 | # To override this behaviour use a function that generates globally unique ids instead of hashes 64 | cache_uid <- Cache$new(td, hashfun = function(x) ascending_id()) 65 | cache_uid$push(iris) 66 | cache_uid$push(iris) 67 | expect_identical(cache_hash$n, 2L) 68 | cache_hash$purge() 69 | 70 | # fail if hashfun does not returns a scalar 71 | cache_err <- Cache$new(td, hashfun = function(x) c(ascending_id(), ascending_id())) 72 | expect_error(cache_err$push(iris), class = "ValueError") 73 | }) 74 | 75 | 76 | 77 | 78 | 79 | test_that("pruning works by number of files works", { 80 | td <- file.path(tempdir(), "cache-test") 81 | on.exit(unlink(td, recursive = TRUE)) 82 | 83 | cache <- Cache$new(td, hashfun = function(x) ascending_id()) 84 | k1 <- cache$push(iris) 85 | k2 <- cache$push(letters) 86 | k3 <- cache$push(cars) 87 | expect_identical(cache$n, 3L) 88 | 89 | # cached files are sorted in the order of their creation 90 | expect_identical(cache$files$key[[1]], k1) 91 | expect_identical(cache$files$key[[2]], k2) 92 | expect_identical(cache$files$key[[3]], k3) 93 | 94 | cache$prune(max_files = 2) 95 | expect_identical(cache$read(cache$files$key[[1]]), letters) 96 | expect_identical(cache$read(cache$files$key[[2]]), cars) 97 | cache$purge() 98 | }) 99 | 100 | 101 | 102 | test_that("$files is ordered by key if timestamps are identical", { 103 | td <- file.path(tempdir(), "cache-test") 104 | on.exit(unlink(td, recursive = TRUE)) 105 | 106 | cache <- Cache$new(td, hashfun = function(x) ascending_id()) 107 | k1 <- cache$push(iris) 108 | k2 <- cache$push(letters) 109 | k3 <- cache$push(cars) 110 | expect_identical(cache$n, 3L) 111 | 112 | for (p in cache$files$path){ # loop necessary for compat with R < 3.6.0 113 | Sys.setFileTime(p, "1999-01-01 00:00:00") 114 | } 115 | 116 | expect_identical(cache$files$key[[1]], k1) 117 | expect_identical(cache$files$key[[2]], k2) 118 | expect_identical(cache$files$key[[3]], k3) 119 | 120 | cache$prune(max_files = 2) 121 | expect_identical(cache$read(cache$files$key[[1]]), letters) 122 | expect_identical(cache$read(cache$files$key[[2]]), cars) 123 | cache$purge() 124 | }) 125 | 126 | 127 | 128 | 129 | test_that("pruning by size works, even if timestamps are identical", { 130 | td <- file.path(tempdir(), "cache-test") 131 | on.exit(unlink(td, recursive = TRUE)) 132 | 133 | # When using a real hash function as hashfun, identical objects will only 134 | # be added to the cache once 135 | cache <- Cache$new(td, hashfun = function(x) ascending_id()) 136 | for (i in 1:5) cache$push(iris) 137 | cache$push(cars) 138 | expect_identical(cache$n, 6L) 139 | 140 | 141 | for (p in cache$files$path){ # loop necessary for compat with R < 3.6.0 142 | Sys.setFileTime(p, "1999-01-01 00:00:00") 143 | } 144 | 145 | expect_true(cache$size > 2048) 146 | cache$prune(max_size = "2kb") 147 | expect_true(cache$size <= 2048) 148 | 149 | cache$prune(max_files = 2) 150 | expect_identical(cache$read(cache$files$key[[2]]), cars) 151 | cache$purge 152 | }) 153 | 154 | 155 | 156 | 157 | test_that("Inf max_* do not prunes", { 158 | td <- file.path(tempdir(), "cache-test") 159 | on.exit(unlink(td, recursive = TRUE)) 160 | 161 | # When using a real hash function as hashfun, identical objects will only 162 | # be added to the cache once 163 | cache <- Cache$new(td, hashfun = function(x) ascending_id()) 164 | for (i in 1:5) cache$push(iris) 165 | cache$push(cars) 166 | expect_identical(cache$n, 6L) 167 | 168 | cache$prune(max_files = Inf, max_age = Inf, max_size = Inf) 169 | expect_identical(cache$n, 6L) 170 | 171 | cache$prune(max_files = NULL, max_age = NULL, max_size = NULL) 172 | expect_identical(cache$n, 6L) 173 | 174 | cache$purge() 175 | }) 176 | 177 | 178 | 179 | 180 | test_that("pruning by age works", { 181 | td <- file.path(tempdir(), "cache-test") 182 | on.exit(unlink(td, recursive = TRUE)) 183 | 184 | # create mock class that always 185 | MockCache <- R6::R6Class( 186 | inherit = Cache, 187 | 188 | public = list( 189 | mock_timestamp = NULL 190 | ), 191 | 192 | active = list( 193 | files = function(){ 194 | files <- list.files(self$dir, full.names = TRUE) 195 | 196 | if (!length(files)){ 197 | return(EMPTY_CACHE_INDEX) 198 | } 199 | 200 | finfo <- file.info(files) 201 | 202 | res <- cbind( 203 | data.frame(path = rownames(finfo), stringsAsFactors = FALSE), 204 | data.frame(key = basename(rownames(finfo)), stringsAsFactors = FALSE), 205 | finfo 206 | ) 207 | 208 | if (!is.null(self$mock_timestamp)){ 209 | assert(length(self$mock_timestamp) >= nrow(res)) 210 | res$atime <- res$ctime <- res$mtime <- self$mock_timestamp[1:nrow(res)] 211 | } 212 | 213 | row.names(res) <- NULL 214 | 215 | res[order(res$mtime), ] 216 | } 217 | ) 218 | ) 219 | 220 | cache <- MockCache$new(dir = td, hashfun = function(x) ascending_id()) 221 | on.exit(cache$purge(), add = TRUE) 222 | for (i in 1:5) cache$push(iris) 223 | 224 | expect_identical(nrow(cache$files), 5L) 225 | 226 | cache$mock_timestamp <- as.POSIXct(c( 227 | "2020-01-01", 228 | "2020-01-02", 229 | "2020-01-03", 230 | "2020-01-04", 231 | "2020-01-05" 232 | )) 233 | keep <- cache$files[cache$files$mtime >= as.POSIXct("2020-01-02"), ] 234 | expect_identical( 235 | nrow(keep), 236 | 4L, 237 | label = paste0(nrow(keep), " (timestamps:", comma(keep$mtime), ")") 238 | ) 239 | cache$prune(max_age = "2020-01-02") 240 | expect_setequal(cache$files$key, keep$key) 241 | cache$mock_timestamp <- as.POSIXct(c( 242 | "2020-01-02", 243 | "2020-01-03", 244 | "2020-01-04", 245 | "2020-01-05" 246 | )) 247 | 248 | keep <- cache$files[cache$files$mtime >= as.POSIXct("2020-01-04"), ] 249 | expect_identical( 250 | nrow(keep), 251 | 2L, 252 | label = paste0(nrow(keep), " (timestamps:", comma(keep$mtime), ")") 253 | ) 254 | cache$prune(max_age = "2 days", now = max(cache$files$mtime)) 255 | expect_true( 256 | setequal(cache$files$key, keep$key), 257 | label = paste0( 258 | "[", paste(cache$files$mtime, cache$files$key, collapse = ", ", sep = ": "), "] == [", 259 | paste(keep$mtime, keep$key, collapse = " -- ", sep = ": "), "]" 260 | ) 261 | ) 262 | 263 | expect_error( 264 | cache$prune(max_age = "2 foos", now = max(cache$files$mtime)), 265 | class = "ValueError" 266 | ) 267 | }) 268 | 269 | 270 | 271 | test_that("$destroy works as expected", { 272 | td <- file.path(tempdir(), "cache-test") 273 | on.exit(unlink(td, recursive = TRUE)) 274 | 275 | # cache can be created 276 | cache <- Cache$new(td) 277 | 278 | # put elements into the cache 279 | key1 <- cache$push(iris) 280 | key2 <- cache$push(cars) 281 | expect_identical(cache$n, 2L) 282 | 283 | expect_error(cache$destroy(), class = "DirIsNotEmptyError") 284 | cache$purge()$destroy() 285 | expect_false(dir.exists(cache$dir)) 286 | expect_error(cache$push(iris), class = "DirDoesNotExistError") 287 | }) 288 | 289 | 290 | -------------------------------------------------------------------------------- /tests/testthat/test_copy_or_compress.R: -------------------------------------------------------------------------------- 1 | context("copy_or_compress") 2 | 3 | dr <- tempdir() 4 | td <- file.path(dr, "rotor") 5 | timestamp_tolerance <- 10 # seconds 6 | 7 | dir.create(td, recursive = TRUE) 8 | teardown({ 9 | unlink(td, recursive = TRUE) 10 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 11 | }) 12 | 13 | 14 | 15 | create_testfile <- function(){ 16 | tf <- file.path(td, "compresstest.log") 17 | saveRDS(iris, file = tf, compress = FALSE) 18 | fake_time <- as.POSIXct("1990-01-01 02:03:04") 19 | Sys.setFileTime(tf, fake_time) 20 | expect_true(equalish(file.info(tf)$mtime, fake_time, timestamp_tolerance), "cannot fake timestamp") 21 | tf 22 | } 23 | 24 | 25 | 26 | 27 | test_that("copy_or_compress works with default zip command", { 28 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 29 | 30 | tf <- file.path(td, "compresstest.log") 31 | on.exit(unlink(tf)) 32 | saveRDS(iris, file = tf, compress = FALSE) 33 | 34 | r <- copy_or_compress(tf, tf, compression = TRUE) 35 | on.exit(unlink(r), add = TRUE) 36 | expect_true(file.exists(r)) 37 | identical(unzip(r, list = TRUE)[["Name"]], "compresstest.log") 38 | }) 39 | 40 | 41 | 42 | 43 | test_that("copy_or_compress works with internal zip command", { 44 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 45 | 46 | tf <- file.path(td, "compresstest.log") 47 | on.exit(unlink(tf)) 48 | saveRDS(iris, file = tf, compress = FALSE) 49 | 50 | r <- copy_or_compress(tf, tf, compression = "utils::zip") 51 | on.exit(unlink(r), add = TRUE) 52 | expect_true(file.exists(r)) 53 | identical(unzip(r, list = TRUE)[["Name"]], "compresstest.log") 54 | }) 55 | 56 | 57 | 58 | 59 | test_that("copy_or_compress works with zip::zipr", { 60 | skip_if_not_installed("zip") 61 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 62 | 63 | tf <- file.path(td, "compresstest.log") 64 | on.exit(unlink(tf)) 65 | saveRDS(iris, file = tf, compress = FALSE) 66 | 67 | r <- copy_or_compress(tf, tf, compression = "zip::zipr") 68 | on.exit(unlink(r), add = TRUE) 69 | expect_true(file.exists(r)) 70 | expect_identical(zip::zip_list(r)[1, ]$filename, "compresstest.log") 71 | }) 72 | 73 | 74 | 75 | 76 | test_that("copy_or_compress preserves timestamp", { 77 | skip_if_not_installed("zip") 78 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 79 | 80 | tf <- create_testfile() 81 | on.exit(unlink(tf)) 82 | 83 | copy <- copy_or_compress(tf, paste0(tf, ".copy")) 84 | on.exit(unlink(copy), add = TRUE) 85 | expect_true(equalish(file.mtime(tf), file.mtime(copy), tolerance = timestamp_tolerance)) 86 | 87 | zip <- copy_or_compress(tf, tf, compression = "utils::zip") 88 | on.exit(unlink(zip), add = TRUE) 89 | expect_true(equalish(file.mtime(zip), file.mtime(tf), timestamp_tolerance)) 90 | unlink(zip) 91 | 92 | zip <- copy_or_compress(tf, tf, compression = "zip::zipr") 93 | expect_true(equalish(file.mtime(zip), file.mtime(tf), timestamp_tolerance)) 94 | }) 95 | 96 | 97 | -------------------------------------------------------------------------------- /tests/testthat/test_list_backups.R: -------------------------------------------------------------------------------- 1 | context("list_backup") 2 | 3 | dr <- tempdir() 4 | td <- file.path(dr, "rotor") 5 | dir.create(td, recursive = TRUE) 6 | 7 | teardown({ 8 | unlink(td, recursive = TRUE) 9 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 10 | }) 11 | 12 | 13 | 14 | test_that("n_backups and co work as expected", { 15 | tf <- file.path(td, "test.log") 16 | files <- file.path( 17 | td, 18 | c("test.2019-02-01--12-00-00.log", "test.2019-02-01--12-00-01.log") 19 | ) 20 | 21 | file.create(tf, files) 22 | 23 | expect_path_equal(newest_backup(tf), files[[2]]) 24 | expect_path_equal(oldest_backup(tf), files[[1]]) 25 | 26 | files2 <- file.path(td, c("test.1.log", "test.2.log")) 27 | file.create(files2) 28 | 29 | expect_error(newest_backup(tf)) 30 | expect_error(prune_backups(tf, 0)) 31 | expect_warning(expect_true(n_backups(tf) == 4)) 32 | file.remove(files) 33 | 34 | expect_path_equal(newest_backup(tf), files2[[1]]) 35 | expect_path_equal(oldest_backup(tf), files2[[2]]) 36 | prune_backups(tf, 0) 37 | expect_true(n_backups(tf) == 0) 38 | 39 | file.remove(tf) 40 | }) 41 | 42 | 43 | 44 | 45 | test_that("n_backups and co work as expected with dir", { 46 | tf <- file.path(td, "test.log") 47 | bu_dir <- file.path(td, "backups") 48 | dir.create(bu_dir) 49 | on.exit(unlink(c(bu_dir, tf), recursive = TRUE)) 50 | 51 | files <- file.path( 52 | bu_dir, 53 | c("test.2019-02-01--12-00-00.log", "test.2019-02-01--12-00-01.log") 54 | ) 55 | 56 | file.create(tf, files) 57 | 58 | expect_path_equal(newest_backup(tf, dir = bu_dir), files[[2]]) 59 | expect_path_equal(oldest_backup(tf, dir = bu_dir), files[[1]]) 60 | 61 | files2 <- file.path(bu_dir, c("test.1.log", "test.2.log")) 62 | file.create(files2) 63 | 64 | expect_error(newest_backup(tf, dir = bu_dir)) 65 | expect_error(prune_backups(tf, 0, dir = bu_dir)) 66 | expect_warning(expect_true(n_backups(tf, dir = bu_dir) == 4)) 67 | file.remove(files) 68 | 69 | expect_path_equal(newest_backup(tf, dir = bu_dir), files2[[1]]) 70 | expect_path_equal(oldest_backup(tf, dir = bu_dir), files2[[2]]) 71 | prune_backups(tf, 0, dir = bu_dir) 72 | expect_true(n_backups(tf) == 0) 73 | 74 | file.remove(tf) 75 | expect_length(list.files(bu_dir), 0) 76 | }) 77 | 78 | 79 | 80 | 81 | test_that("prune_backups dry run works with sepparate backup dir", { 82 | tf <- file.path(td, "test.log") 83 | bu_dir <- file.path(td, "backups") 84 | dir.create(bu_dir) 85 | on.exit(unlink(c(bu_dir, tf), recursive = TRUE)) 86 | 87 | files <- file.path( 88 | bu_dir, 89 | c("test.2019-02-01--12-00-00.log", "test.2019-02-01--12-00-01.log") 90 | ) 91 | file.create(tf, files) 92 | 93 | snap <- fileSnapshot(bu_dir) 94 | 95 | expect_message( 96 | prune_backups(tf, 0, dir = bu_dir, dry_run = TRUE), 97 | "removing" 98 | ) 99 | 100 | expect_snapshot_unchanged(snap) 101 | prune_backups(tf, 0, dir = bu_dir) 102 | file.remove(tf) 103 | expect_length(list.files(bu_dir), 0) 104 | }) 105 | -------------------------------------------------------------------------------- /tests/testthat/test_parsers.R: -------------------------------------------------------------------------------- 1 | context("parsers") 2 | 3 | 4 | 5 | 6 | test_that("parse_rotation_interval", { 7 | expect_identical(parse_rotation_interval(9)$unit, "day") 8 | expect_identical(parse_rotation_interval("1 week")$unit, "week") 9 | expect_identical(parse_rotation_interval("2 months")$unit, "month") 10 | expect_identical(parse_rotation_interval("3 quarters")$unit, "quarter") 11 | expect_identical(parse_rotation_interval("4 years")$unit, "year") 12 | 13 | 14 | expect_identical(parse_rotation_interval("-1 years")$unit, "year") 15 | expect_identical(parse_rotation_interval("-1 years")$value, -1L) 16 | expect_identical(parse_rotation_interval("-1 days")$value, -1L) 17 | expect_identical(parse_rotation_interval(-1)$value, -1L) 18 | expect_identical(parse_rotation_interval(-1)$unit, "day") 19 | 20 | expect_identical(parse_rotation_interval(Inf)$value, Inf) 21 | }) 22 | 23 | 24 | 25 | 26 | test_that("parse_info_unit works", { 27 | expect_identical(parse_info_unit("k"), 1024) 28 | expect_identical(parse_info_unit("k"), parse_info_unit("KiB")) 29 | expect_identical(parse_info_unit("m"), 1024 * 1024) 30 | expect_identical(parse_size(123), 123L) 31 | expect_error(parse_info_unit("r")) 32 | expect_identical(parse_size("1k"), 1024) 33 | expect_equal(parse_size("1.5g"), 1024L^3 * 1.5) 34 | 35 | expect_equal(parse_size("1.5 gIb"), parse_size("1.5g")) 36 | expect_equal(parse_size("1 gIb"), parse_size("1024mb")) 37 | }) 38 | 39 | 40 | 41 | 42 | test_that("parse_size throws warning when it encounters floats", { 43 | x <- parse_size(18) 44 | expect_warning({y <- parse_size(18.9)}) 45 | expect_identical(x, y) 46 | }) 47 | 48 | 49 | 50 | 51 | test_that("parse_datetime works as expected", { 52 | d <- as.Date("2019-12-01") 53 | expect_equal(parse_datetime(d), as.POSIXct(format(d))) 54 | 55 | expect_equal(parse_datetime("2018-12-01"), as.POSIXct("2018-12-01")) 56 | expect_equal(parse_datetime("20181201"), as.POSIXct("2018-12-01")) 57 | expect_equal(parse_datetime("2018-02"), as.POSIXct("2018-02-01")) 58 | expect_equal(parse_datetime("201802"), as.POSIXct("2018-02-01")) 59 | expect_equal(parse_datetime("2018"), as.POSIXct("2018-01-01")) 60 | 61 | expect_equal( 62 | parse_datetime(c("2018-12-02", "20181201", "2018")), 63 | as.POSIXct(c("2018-12-02", "2018-12-01", "2018-01-01")) 64 | ) 65 | 66 | d1 <- as.POSIXct("2019-04-12 17:49:19") 67 | d2 <- as.POSIXct("2019-04-12 17:49:00") 68 | d3 <- as.POSIXct("2019-04-12 17:00:00") 69 | 70 | expect_identical(parse_datetime(d1), d1) 71 | 72 | expect_equal(parse_datetime("2019-04-12--17-49-19"), d1) 73 | expect_equal(parse_datetime("2019-04-12--17-49"), d2) 74 | expect_equal(parse_datetime("2019-04-12----17"), d3) 75 | 76 | expect_equal(parse_datetime("2019-04-12T17-49-19"), d1) 77 | expect_equal(parse_datetime("2019-04-12T17-49"), d2) 78 | expect_equal(parse_datetime("2019-04-12T17"), d3) 79 | 80 | expect_equal(parse_datetime("2019-04-12T174919"), d1) 81 | expect_equal(parse_datetime("2019-04-12T1749"), d2) 82 | expect_equal(parse_datetime("2019-04-12T17"), d3) 83 | 84 | expect_equal(parse_datetime("20190412T174919"), d1) 85 | expect_equal(parse_datetime("20190412T1749"), d2) 86 | expect_equal(parse_datetime("20190412T17"), d3) 87 | 88 | expect_equal(parse_datetime("20190412174919"), d1) 89 | expect_equal(parse_datetime("201904121749"), d2) 90 | expect_equal(parse_datetime("2019041217"), d3) 91 | 92 | expect_equal( 93 | parse_datetime(c("2019-04-12T17-49-19", "20190412T1749", "2019041217")), 94 | as.POSIXct(c(d1, d2, d3)) 95 | ) 96 | }) 97 | 98 | 99 | 100 | 101 | test_that("parse_date works as expected", { 102 | expect_equal(parse_date("2018-12-01"), as.Date("2018-12-01")) 103 | expect_equal(parse_date("20181201"), as.Date("2018-12-01")) 104 | expect_equal(parse_date("2018-02"), as.Date("2018-02-01")) 105 | expect_equal(parse_date("201802"), as.Date("2018-02-01")) 106 | expect_equal(parse_date("2018"), as.Date("2018-01-01")) 107 | 108 | expect_equal( 109 | parse_date(c("2018-12-02", "20181201", "2018")), 110 | as.Date(c("2018-12-02", "2018-12-01", "2018-01-01")) 111 | ) 112 | 113 | d <- as.Date("2019-04-12") 114 | dt <- as.POSIXct("2019-04-12 23:59:01") 115 | expect_identical(parse_date(d), d) 116 | expect_identical(parse_date(dt), d) 117 | expect_identical(parse_date(dt), d) 118 | 119 | expect_equal(parse_date("2019-04-12"), d) 120 | expect_equal(parse_date("2019-04"), as.Date("2019-04-01")) 121 | expect_equal(parse_date("2019"), as.Date("2019-01-01")) 122 | 123 | expect_equal(parse_date("20190412"), d) 124 | expect_equal(parse_date("201904"), as.Date("2019-04-01")) 125 | expect_equal(parse_date("2019"), as.Date("2019-01-01")) 126 | }) 127 | -------------------------------------------------------------------------------- /tests/testthat/test_rotate.R: -------------------------------------------------------------------------------- 1 | context("rotate") 2 | 3 | dr <- tempdir() 4 | td <- file.path(dr, "rotor") 5 | dir.create(td, recursive = TRUE) 6 | 7 | teardown({ 8 | unlink(td, recursive = TRUE) 9 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 10 | }) 11 | 12 | 13 | 14 | 15 | 16 | test_that("backup/rotate happy path", { 17 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 18 | 19 | tf <- file.path(td, "test.log") 20 | saveRDS(iris, tf) 21 | tf_size <- file.size(tf) 22 | bq <- BackupQueue$new(tf) 23 | 24 | # no backup because dry run 25 | expect_message(backup(tf, dry_run = TRUE), "dry_run") 26 | expect_identical(bq$n, 0L) 27 | 28 | # not rotating because file is to small 29 | backup(tf, size = 1e6) 30 | expect_identical(bq$n, 0L) 31 | 32 | # backup 33 | backup(tf, size = 1) 34 | expect_identical(bq$n, 1L) 35 | 36 | # backup (zip) 37 | backup(tf, compression = TRUE) 38 | expect_identical(bq$n, 2L) 39 | expect_identical(tools::file_ext(bq$files$path[[1]]), "zip") 40 | 41 | # rotating 42 | rotate(tf, compression = FALSE) 43 | expect_identical(bq$n, 3L) 44 | expect_equal(file.size(tf), 0) 45 | expect_equal(file.size(bq$files$path[[1]]), tf_size) 46 | expect_equal(bq$files$sfx, format(1:3)) 47 | 48 | bq$prune(0) 49 | file.remove(tf) 50 | expect_length(list.files(td), 0) 51 | }) 52 | 53 | 54 | 55 | test_that("backup/rotate works to different directory", { 56 | tf <- file.path(td, "test.log") 57 | bu_dir <- file.path(td, "backups") 58 | dir.create(bu_dir) 59 | on.exit(unlink(c(bu_dir, tf))) 60 | 61 | file.create(tf) 62 | writeLines("foobar", tf) 63 | 64 | # dry run does nothing 65 | snap <- fileSnapshot(bu_dir) 66 | expect_message(backup(tf, dir = bu_dir, dry_run = TRUE)) 67 | expect_snapshot_unchanged(snap) 68 | 69 | # create backup in different dir 70 | backup(tf, dir = bu_dir) 71 | expect_identical( 72 | readLines(tf), 73 | readLines(file.path(dirname(tf), "backups", "test.1.log")) 74 | ) 75 | 76 | expect_identical(n_backups(tf, dir = bu_dir), 1L) 77 | prune_backups(tf, 0, dir = bu_dir) 78 | expect_identical(n_backups(tf, dir = bu_dir), 0L) 79 | expect_length(list.files(bu_dir), 0) 80 | }) 81 | 82 | 83 | 84 | 85 | test_that("backup/rotate works with size", { 86 | tf <- file.path(td, "test.log") 87 | on.exit(unlink(tf)) 88 | saveRDS(iris, tf) 89 | size_ori <- file.size(tf) 90 | 91 | # dont rotate if file size is to small 92 | rotate(tf, size = "5kb") 93 | expect_identical(n_backups(tf), 0L) 94 | expect_equal(file.size(tf), size_ori) 95 | 96 | # dry run does nothing 97 | expect_message(rotate(tf, size = "0.5kb", dry_run = TRUE)) 98 | expect_identical(n_backups(tf), 0L) 99 | expect_equal(file.size(tf), size_ori) 100 | 101 | # rotate if file size is big enough 102 | rotate(tf, size = "0.5kb") 103 | expect_identical(n_backups(tf), 1L) 104 | expect_equal(file.size(tf), 0) 105 | 106 | prune_backups(tf, 0) 107 | }) 108 | 109 | 110 | 111 | 112 | test_that("backup/rotate dry_run", { 113 | tf <- file.path(td, "test.rds") 114 | on.exit(unlink(tf)) 115 | snap <- utils::fileSnapshot(td) 116 | 117 | saveRDS(cars, tf) 118 | backup(tf) 119 | backup(tf) 120 | expect_message(backup(tf, dry_run = TRUE), "dry_run") 121 | expect_message(rotate(tf, dry_run = TRUE), "dry_run") 122 | 123 | expect_snapshot_unchanged(snap) 124 | }) 125 | 126 | 127 | 128 | 129 | test_that("BackupQueueIndex: $prune_identical works", { 130 | tf <- file.path(td, "test") 131 | 132 | saveRDS(iris, tf) 133 | iris_md5 <- tools::md5sum(tf) 134 | bq <- BackupQueueIndex$new(tf) 135 | on.exit({ 136 | bq$prune(0) 137 | unlink(tf) 138 | }) 139 | backup(tf) 140 | backup(tf) 141 | rotate(tf) 142 | 143 | saveRDS(cars, tf) 144 | cars_md5 <- tools::md5sum(tf) 145 | backup(tf) 146 | saveRDS(cars, tf) 147 | rotate(tf) 148 | 149 | saveRDS(iris, tf) 150 | 151 | prune_identical_backups(tf) 152 | 153 | expect_identical( 154 | unname(tools::md5sum(bq$files$path)), 155 | unname(c(cars_md5, iris_md5)) 156 | ) 157 | }) 158 | 159 | 160 | 161 | 162 | 163 | test_that("rotate works with funky filenames", { 164 | td2 <- file.path(td, "test") 165 | dir.create(td2) 166 | on.exit(unlink(td2, recursive = TRUE)) 167 | 168 | fn <- "...one long incredibly unbroken sentence ... xzy12+-.test.ext" 169 | 170 | tf <- file.path(td2, fn) 171 | saveRDS(iris, tf) 172 | expect_true(file.exists(tf)) 173 | 174 | rotate(tf) 175 | rotate(tf, verbose = TRUE, size = 0) 176 | 177 | expect_length(list_backups(tf), 2) 178 | expect_match(basename(list_backups(tf)),".*\\.[1,2]\\.ext$") 179 | prune_backups(tf, 0) 180 | expect_length(list_backups(tf), 0) 181 | }) 182 | 183 | 184 | 185 | 186 | test_that("rotate works with funky filenames 2", { 187 | td2 <- file.path(td, "test") 188 | dir.create(td2) 189 | on.exit(unlink(td2, recursive = TRUE)) 190 | 191 | tfs <- file.path(td2, c( 192 | "2021.zip", 193 | "2021.q1.zip", 194 | "2021.q1.test.zip", 195 | "2021.q1.test.1.zip" 196 | )) 197 | 198 | file.create(tfs) 199 | on.exit(unlink(td2, recursive = TRUE)) 200 | 201 | expect_length(list_backups(tfs[[1]]), 0L) 202 | expect_length(list_backups(tfs[[2]]), 0L) 203 | expect_length(list_backups(tfs[[3]]), 1L) 204 | }) 205 | -------------------------------------------------------------------------------- /tests/testthat/test_rotate_date.R: -------------------------------------------------------------------------------- 1 | context("rotate_date") 2 | 3 | 4 | dr <- tempdir() 5 | td <- file.path(dr, "rotor") 6 | dir.create(td, recursive = TRUE) 7 | 8 | teardown({ 9 | unlink(td, recursive = TRUE) 10 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 11 | }) 12 | 13 | 14 | 15 | test_that("backup_date warns if indexed backups exist", { 16 | tf <- file.path(td, "test.log") 17 | 18 | bus <- c( 19 | file.path(td, "test.1.log"), 20 | file.path(td, "test.2.log"), 21 | file.path(td, "test.2017.log"), 22 | file.path(td, "test.201701.log"), 23 | file.path(td, "test.20170201.log"), 24 | file.path(td, "test.2017-03.log"), 25 | file.path(td, "test.2017-04-01.log") 26 | ) 27 | file.create(c(bus, tf)) 28 | writeLines("test", tf) 29 | 30 | expect_warning( 31 | bu <- backup_date(tf), 32 | "test\\.1\\.log.*test\\.2\\.log" 33 | ) 34 | unlink(bus) 35 | prune_backups(tf, 0) 36 | unlink(tf) 37 | 38 | expect_dir_empty(td) 39 | }) 40 | 41 | 42 | 43 | test_that("backup/rotate_date works with size", { 44 | tf <- file.path(td, "test.log") 45 | expect_dir_empty(td) 46 | on.exit(unlink(tf)) 47 | saveRDS(iris, tf) 48 | size_ori <- file.size(tf) 49 | 50 | rotate_date(tf, size = "5kb") 51 | expect_identical(n_backups(tf), 0L) 52 | expect_equal(file.size(tf), size_ori) 53 | 54 | rotate_date(tf, size = "0.5kb", age = 0) 55 | expect_identical(n_backups(tf), 1L) 56 | expect_equal(file.size(tf), 0) 57 | 58 | prune_backups(tf, 0) 59 | unlink(tf) 60 | expect_dir_empty(td) 61 | }) 62 | 63 | 64 | 65 | 66 | test_that("backup/rotate_date fails if backup already exists for that period", { 67 | tf <- file.path(td, "test.log") 68 | on.exit(unlink(tf)) 69 | saveRDS(iris, tf) 70 | 71 | now <- Sys.Date() 72 | backup_date(tf, now = now, age = 0) 73 | expect_identical(n_backups(tf), 1L) 74 | 75 | expect_error(backup_date(tf, now = now, age = -1), "exists") 76 | prune_backups(tf, 0) 77 | unlink(tf) 78 | expect_dir_empty(td) 79 | }) 80 | 81 | 82 | 83 | 84 | test_that("backup_date examples from documentation", { 85 | #' When rotating/backing up `"1 months"` means "make a new backup if the last 86 | #' backup is from the preceeding month". E.g if the last backup of `myfile` 87 | #' is from `2019-02-01` then `backup_date(myfile, age = "1 month")` will only 88 | #' create a backup if the current date is at least `2019-03-01`. 89 | tf <- file.path(td, "test.log") 90 | file.create( 91 | tf, 92 | file.path(td, "test.2019-02-01.log") 93 | ) 94 | on.exit(unlink(tf)) 95 | writeLines("test", tf) 96 | 97 | backup_date(tf, age = "1 month", now = "2019-02-28") 98 | expect_identical(n_backups(tf), 1L) 99 | 100 | backup_date(tf, age = "1 month", now = "2019-03-01") 101 | expect_identical(n_backups(tf), 2L) 102 | 103 | #' When pruning/limiting backup queues, `"1 year"` means "keep at least most 104 | #' one year worth of backups". So if you call 105 | #' `backup_date(myfile, max_backups = "1 year")` on `2019-03-01`, it will create 106 | #' a backup and then remove all backups of `myfile` before `2019-01-01`. 107 | file.create(file.path(td, "test.2019-01-01.log")) 108 | file.create(file.path(td, "test.2018-12-31.log")) 109 | expect_identical(n_backups(tf), 4L) 110 | backup_date(tf, max_backups = "1 year", now = "2019-03-02") 111 | expect_identical(n_backups(tf), 4L) 112 | expect_match(newest_backup(tf), "2019-03-02") 113 | expect_match(oldest_backup(tf), "2019-01-01") 114 | 115 | prune_backups(tf, 0) 116 | unlink(tf) 117 | expect_dir_empty(td) 118 | }) 119 | 120 | 121 | 122 | 123 | test_that("backup_date works as expected for years", { 124 | tf <- file.path(td, "test.log") 125 | saveRDS(iris, tf) 126 | snap <- fileSnapshot(td) 127 | # no backup younger than 1 year exists, so rotate 128 | 129 | # dry run does nothing 130 | expect_message(bu <- backup_date(tf, age = -1, dry_run = TRUE), "copy") 131 | expect_snapshot_unchanged(snap) 132 | bu <- backup_date(tf, age = -1) 133 | expect_true(file.size(bu) > 1) 134 | 135 | bq <- BackupQueueDate$new(tf, cache_backups = FALSE) 136 | expect_true(bq$has_backups) 137 | bq$prune(0) 138 | 139 | # no backup because last backup is less than a year old 140 | file.create(file.path(td, "test.2019-12-31.log")) 141 | bu <- backup_date(tf, "1 year", now = "2019-01-01") 142 | bu <- backup_date(tf, "1 year", now = "2019-12-31") 143 | expect_identical(bq$n, 1L) 144 | bq$prune(0) 145 | 146 | # rotate because backup is from last year 147 | file.create(file.path(td, "test.2018-12-31.log")) 148 | bu <- backup_date(tf, "2 year", now = "2019-12-31") # dont rotate 149 | expect_identical(bq$n, 1L) 150 | bu <- backup_date(tf, "1 year", now = "2019-12-31") # rotate 151 | expect_true(length(bq$files$path) == 2) 152 | 153 | bq$prune(0) 154 | unlink(tf) 155 | expect_dir_empty(td) 156 | }) 157 | 158 | 159 | 160 | 161 | test_that("backup_date works as expected for quarters", { 162 | tf <- file.path(td, "test.log") 163 | on.exit(unlink(tf)) 164 | saveRDS(iris, tf) 165 | bq <- BackupQueueDate$new(tf, cache_backups = FALSE) 166 | 167 | # no backup younger than 1 quarter exists, so rotate 168 | bu <- backup_date(tf, age = 0) 169 | expect_true(file.size(bu) > 1) 170 | expect_identical(bq$n, 1L) 171 | bq$prune(0) 172 | 173 | # no backup because last backup is less than a quarter old 174 | file.create(file.path(td, "test.2019-06-21.log")) 175 | bu <- backup_date(tf, "1 quarter", now = "2019-04-01") 176 | expect_identical(bq$n, 1L) 177 | bq$prune(0) 178 | 179 | # no backup because last backup is less than 2 quarter old 180 | file.create(file.path(td, "test.2019-01-01.log")) 181 | bu <- backup_date(tf, "2 quarter", now = "2019-04-01") 182 | expect_identical(bq$n, 1L) 183 | 184 | # backup because last backup is more than 1 quarter old 185 | bu <- backup_date(tf, "1 quarter", now = "2019-04-01") 186 | expect_true(length(bq$files$path) == 2) 187 | 188 | bq$prune(0) 189 | }) 190 | 191 | 192 | 193 | 194 | test_that("backup_date works as expected for months", { 195 | tf <- file.path(td, "test.log") 196 | on.exit(unlink(tf)) 197 | saveRDS(iris, tf) 198 | bq <- BackupQueueDate$new(tf, cache_backups = FALSE) 199 | 200 | # no backup younger than 1 month exists, so rotate 201 | bu <- backup_date(tf, -1) 202 | expect_true(file.size(bu) > 1) 203 | expect_identical(bq$n, 1L) 204 | bq$prune(0) 205 | 206 | # no backup because last backup is less than a month old 207 | file.create(file.path(td, "test.2019-05-21.log")) 208 | bu <- backup_date(tf, "1 month", now = "2019-05-02") 209 | expect_identical(bq$n, 1L) 210 | bq$prune(0) 211 | 212 | # no backup because last backup is less than 2 month old 213 | file.create(file.path(td, "test.2019-04-21.log")) 214 | bu <- backup_date(tf, "2 month", now = "2019-05-02") 215 | expect_identical(bq$n, 1L) 216 | 217 | # backup because last backup is more than 1 month old 218 | bu <- backup_date(tf, "1 month", now = "2019-05-02") 219 | expect_true(length(bq$files$path) == 2) 220 | 221 | bq$prune(0) 222 | }) 223 | 224 | 225 | 226 | 227 | test_that("backup_date works as expected for weeks", { 228 | tf <- file.path(td, "test.log") 229 | on.exit(unlink(tf)) 230 | saveRDS(iris, tf) 231 | bq <- BackupQueueDate$new(tf, cache_backups = FALSE) 232 | 233 | # no backup younger than 1 week exists, so rotate 234 | bu <- backup_date(tf, -1) 235 | expect_true(file.size(bu) > 1) 236 | expect_identical(bq$n, 1L) 237 | bq$prune(0) 238 | 239 | 240 | # no backup because last backup is less than a week old 241 | file.create(file.path(td, "test.2019-01-28.log")) 242 | bu <- backup_date(tf, "1 week", now = "2019-01-30") 243 | expect_identical(bq$n, 1L) 244 | bq$prune(0) 245 | 246 | # no backup because last backup is less than 2 week old 247 | file.create(file.path(td, "test.2019-01-27.log")) 248 | bu <- backup_date(tf, "2 week", now = "2019-01-30") 249 | expect_identical(bq$n, 1L) 250 | 251 | # backup because last backup is more than 1 week old 252 | bu <- backup_date(tf, "1 week", now = "2019-01-30") 253 | expect_true(length(bq$files$path) == 2) 254 | 255 | bq$prune(0) 256 | }) 257 | 258 | 259 | 260 | 261 | test_that("backup_date works as expected for Inf", { 262 | tf <- file.path(td, "test.log") 263 | saveRDS(iris, tf) 264 | on.exit({ 265 | prune_backups(tf, 0) 266 | unlink(tf) 267 | }) 268 | 269 | # create initial backup 270 | bu <- backup_date(tf, Inf) 271 | expect_true(file.size(bu) > 0) 272 | expect_identical(n_backups(tf), 0L) 273 | prune_backups(tf, 0) 274 | 275 | # no backup because last backup is less than a week old 276 | backup_date(tf, age = "-99999 years", now = "2019-01-28") 277 | expect_identical(n_backups(tf), 1L) 278 | backup_date(tf, Inf, now = "2999-01-30") 279 | expect_identical(n_backups(tf), 1L) 280 | }) 281 | 282 | 283 | 284 | 285 | test_that("rotate_date works as expected", { 286 | tf <- file.path(td, "test.log") 287 | on.exit(unlink(tf)) 288 | saveRDS(iris, tf) 289 | checksum <- tools::md5sum(tf) 290 | 291 | rotate_date(tf, age = "-9999 years") 292 | expect_identical(unname(checksum), unname(tools::md5sum(newest_backup(tf)))) 293 | expect_equal(file.size(tf), 0) 294 | 295 | BackupQueueDate$new(tf)$prune(0) 296 | }) 297 | 298 | 299 | 300 | 301 | test_that("dry_run does not modify the file systen", { 302 | if (!is_zipcmd_available()) 303 | skip("Test requires a workings system zip command") 304 | 305 | expect_length(list.files(td), 0) 306 | tf <- file.path(td, "test.log") 307 | 308 | saveRDS(iris, tf) 309 | backup_date(tf, now = "2017-05-01") 310 | file.create(c( 311 | file.path(td, "test.2017.log"), 312 | file.path(td, "test.201701.log"), 313 | file.path(td, "test.20170201.log"), 314 | file.path(td, "test.2017-03.log"), 315 | file.path(td, "test.2017-04-01.log") 316 | )) 317 | 318 | 319 | snap <- utils::fileSnapshot(td, md5sum = TRUE) 320 | expect_silent({ 321 | expect_message(backup_date(tf, dry_run = TRUE, now = "2017-05-02"), "copying") 322 | expect_snapshot_unchanged(snap) 323 | expect_message(backup_date(tf, dry_run = TRUE, max_backups = 0), "dry_run") 324 | expect_message(backup_date(tf, dry_run = TRUE, max_backups = 0), "removing") 325 | expect_message(backup_date(tf, dry_run = TRUE, max_backups = 0), "2017-03") 326 | }) 327 | 328 | expect_snapshot_unchanged(snap) 329 | 330 | expect_message( 331 | backup_date(tf, dry_run = TRUE, max_backups = 0, compression = TRUE), 332 | "zip" 333 | ) 334 | expect_snapshot_unchanged(snap) 335 | 336 | BackupQueue$new(tf)$prune(0) 337 | unlink(tf) 338 | expect_length(list.files(td), 0) 339 | }) 340 | 341 | 342 | 343 | 344 | test_that("backup/rotate_time works to different directory", { 345 | tf <- file.path(td, "test.log") 346 | bu_dir <- file.path(td, "backups") 347 | dir.create(bu_dir) 348 | on.exit(unlink(c(tf, bu_dir), recursive = TRUE)) 349 | 350 | file.create(tf) 351 | writeLines("foobar", tf) 352 | 353 | backup_time(tf, dir = bu_dir, now = as.Date("2019-01-01"), age = "-99999 years") 354 | 355 | expect_identical( 356 | readLines(tf), 357 | readLines(file.path(dirname(tf), "backups", "test.2019-01-01--00-00-00.log")) 358 | ) 359 | 360 | expect_identical(n_backups(tf, dir = bu_dir), 1L) 361 | prune_backups(tf, 0, dir = bu_dir) 362 | expect_identical(n_backups(tf, dir = bu_dir), 0L) 363 | expect_length(list.files(bu_dir), 0) 364 | }) 365 | 366 | 367 | 368 | 369 | test_that("backup/rotate_time works with custom format", { 370 | tf <- file.path(td, "test.log") 371 | bu_dir <- file.path(td, "backups") 372 | dir.create(bu_dir) 373 | on.exit(unlink(c(tf, bu_dir), recursive = TRUE)) 374 | 375 | file.create(tf) 376 | writeLines("foobar", tf) 377 | 378 | backup_time(tf, dir = bu_dir, now = as.Date("2019-01-01"), format = "%Y-%m", age = "-99999 years") 379 | 380 | expect_identical( 381 | readLines(tf), 382 | readLines(file.path(dirname(tf), "backups", "test.2019-01.log")) 383 | ) 384 | 385 | expect_identical(n_backups(tf, dir = bu_dir), 1L) 386 | prune_backups(tf, 0, dir = bu_dir) 387 | expect_identical(n_backups(tf, dir = bu_dir), 0L) 388 | expect_length(list.files(bu_dir), 0) 389 | }) 390 | 391 | -------------------------------------------------------------------------------- /tests/testthat/test_rotate_rds.R: -------------------------------------------------------------------------------- 1 | context("rotate_rds") 2 | 3 | td <- file.path(tempdir(), "rotor") 4 | tf <- file.path(td, "iris.rds") 5 | 6 | teardown({ 7 | unlink(td, recursive = TRUE) 8 | }) 9 | 10 | 11 | 12 | test_that("rotate_rds works as expected", { 13 | dir.create(td, recursive = TRUE) 14 | on.exit(unlink(td, recursive = TRUE)) 15 | 16 | rotate_rds(iris, tf) 17 | rotate_rds(iris, tf) 18 | rotate_rds(iris, tf) 19 | 20 | expect_identical(n_backups(tf), 2L) 21 | }) 22 | 23 | 24 | 25 | test_that("rotate_rds_date works as expected", { 26 | dir.create(td, recursive = TRUE) 27 | on.exit(unlink(td, recursive = TRUE)) 28 | 29 | now <- Sys.Date() 30 | 31 | rotate_rds_date(iris, tf, now = now) 32 | rotate_rds_date(iris, tf, now = now) 33 | expect_identical(n_backups(tf), 1L) 34 | expect_error(rotate_rds_date(iris, tf, now = now)) 35 | rotate_rds_date(iris, tf, now = now + 1L) 36 | 37 | expect_identical(n_backups(tf), 2L) 38 | }) 39 | 40 | 41 | 42 | test_that("rotate_rds_time works as expected", { 43 | dir.create(td, recursive = TRUE) 44 | on.exit(unlink(td, recursive = TRUE)) 45 | 46 | now <- Sys.time() 47 | 48 | rotate_rds_time(iris, tf, now = now) 49 | rotate_rds_time(iris, tf, now = now) 50 | expect_error(rotate_rds_time(iris, tf, now = now)) 51 | rotate_rds_time(iris, tf, now = now + 1L) 52 | 53 | expect_identical(n_backups(tf), 2L) 54 | }) 55 | 56 | 57 | 58 | 59 | test_that("rotate_rds on_change_only", { 60 | dir.create(td, recursive = TRUE) 61 | on.exit(unlink(td, recursive = TRUE)) 62 | 63 | v <- LETTERS 64 | df <- iris 65 | dt <- data.table::as.data.table(iris) 66 | tf <- file.path(td, "testfile.rds") 67 | 68 | expect_identical(expect_silent(rotate_rds(v, tf, on_change_only = TRUE)), tf) 69 | expect_identical(expect_message(rotate_rds(v, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage"), tf) 70 | 71 | expect_silent(rotate_rds(df, tf, on_change_only = TRUE)) 72 | expect_message(rotate_rds(df, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 73 | prune_backups(tf, 0) 74 | 75 | expect_silent(rotate_rds(dt, tf, on_change_only = TRUE)) 76 | expect_message(rotate_rds(dt, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 77 | prune_backups(tf, 0) 78 | }) 79 | 80 | 81 | 82 | 83 | test_that("rotate_rds_time on_change_only", { 84 | dir.create(td, recursive = TRUE) 85 | on.exit(unlink(td, recursive = TRUE)) 86 | 87 | v <- LETTERS 88 | df <- iris 89 | dt <- data.table::as.data.table(iris) 90 | tf <- file.path(td, "testfile.rds") 91 | 92 | expect_identical(expect_silent(rotate_rds_time(v, tf, on_change_only = TRUE)), tf) 93 | expect_identical(expect_message(rotate_rds_time(v, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage"), tf) 94 | 95 | expect_silent(rotate_rds_time(df, tf, on_change_only = TRUE)) 96 | expect_message(rotate_rds_time(df, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 97 | prune_backups(tf, 0) 98 | 99 | expect_silent(rotate_rds_time(dt, tf, on_change_only = TRUE)) 100 | expect_message(rotate_rds_time(dt, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 101 | prune_backups(tf, 0) 102 | }) 103 | 104 | 105 | 106 | 107 | test_that("rotate_rds_date on_change_only", { 108 | dir.create(td, recursive = TRUE) 109 | on.exit(unlink(td, recursive = TRUE)) 110 | 111 | v <- LETTERS 112 | df <- iris 113 | dt <- data.table::as.data.table(iris) 114 | tf <- file.path(td, "testfile.rds") 115 | 116 | expect_identical(expect_silent(rotate_rds_date(v, tf, on_change_only = TRUE)), tf) 117 | expect_identical(expect_message(rotate_rds_date(v, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage"), tf) 118 | 119 | expect_silent(rotate_rds_date(df, tf, on_change_only = TRUE)) 120 | expect_message(rotate_rds_date(df, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 121 | prune_backups(tf, 0) 122 | 123 | expect_silent(rotate_rds_date(dt, tf, on_change_only = TRUE)) 124 | expect_message(rotate_rds_date(dt, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 125 | prune_backups(tf, 0) 126 | }) 127 | 128 | 129 | 130 | test_that("rotate_rds `on_change_only` works with arguments list", { 131 | dir.create(td, recursive = TRUE) 132 | on.exit(unlink(td, recursive = TRUE)) 133 | 134 | dt1 <- data.table::as.data.table(iris) 135 | dt2 <- dt1[rev(seq_len(nrow(dt1))), ] 136 | tf <- file.path(td, "testfile.rds") 137 | 138 | expect_silent(rotate_rds(dt1, tf, on_change_only = TRUE)) 139 | expect_message(rotate_rds(dt1, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 140 | expect_message(rotate_rds(dt2, tf, on_change_only = list(ignore.row.order = TRUE)), class = "ObjectHasNotChangedMessage") 141 | expect_message(rotate_rds(dt1, tf, on_change_only = TRUE), class = "ObjectHasNotChangedMessage") 142 | expect_silent(rotate_rds(dt2, tf, on_change_only = TRUE)) 143 | 144 | expect_identical(n_backups(tf), 1L) 145 | prune_backups(tf, 0) 146 | }) 147 | 148 | 149 | 150 | 151 | test_that("objects_are_equal ", { 152 | x <- data.table::data.table(a = 1:3) 153 | y <- data.table::data.table(a = 3:1) 154 | 155 | expect_false(objects_are_equal(x, y, extra_args = list())) 156 | expect_true(objects_are_equal(x, y, extra_args = list(ignore.row.order = TRUE))) 157 | }) 158 | -------------------------------------------------------------------------------- /tests/testthat/test_rotate_time.R: -------------------------------------------------------------------------------- 1 | context("rotate_time") 2 | 3 | dr <- tempdir() 4 | td <- file.path(dr, "rotor") 5 | dir.create(td, recursive = TRUE) 6 | 7 | teardown({ 8 | unlink(td, recursive = TRUE) 9 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 10 | }) 11 | 12 | 13 | 14 | 15 | test_that("backup_time common usecases", { 16 | tf <- file.path(td, "test.log") 17 | file.create( 18 | tf, 19 | file.path(td, "test.2019-02-01--12-00-00.log") 20 | ) 21 | on.exit(unlink(tf)) 22 | writeLines("test", tf) 23 | bq <- BackupQueueDateTime$new(tf, cache_backups = FALSE) 24 | 25 | backup_time(tf, age = "1 month", now = "2019-02-28--12-30-00") 26 | expect_identical(bq$n, 1L) 27 | 28 | backup_time(tf, age = "1 month", now = "2019-03-01--00-00-00") 29 | expect_identical(bq$n, 2L) 30 | 31 | file.create(file.path(td, "test.2019-01-01.log")) 32 | file.create(file.path(td, "test.2018-12-31.log")) 33 | expect_identical(bq$n, 4L) 34 | backup_time(tf, max_backups = "1 year", now = "2019-03-01--00-00-01") 35 | expect_identical(bq$n, 4L) 36 | expect_equal(bq$last_rotation, as.POSIXct("2019-03-01 00:00:01")) 37 | expect_identical( 38 | format(min(bq$files$timestamp)), 39 | "2019-01-01" 40 | ) 41 | 42 | BackupQueue$new(tf)$prune(0) 43 | }) 44 | 45 | 46 | 47 | 48 | test_that("backup_time works with timestamps", { 49 | tf <- file.path(td, "test.log") 50 | file.create( 51 | tf, 52 | file.path(td, "test.2019-02-01--12-00-00.log") 53 | ) 54 | writeLines("test", tf) 55 | on.exit(unlink(tf)) 56 | 57 | bq <- BackupQueueDateTime$new(tf) 58 | expect_identical(bq$n, 1L) 59 | 60 | backup_time(tf, age = as.POSIXct("2019-02-01 11:59:59")) 61 | expect_identical(bq$n, 1L) 62 | 63 | backup_time(tf, age = as.POSIXct("2019-02-01 12:00:00")) 64 | expect_identical(bq$n, 1L) 65 | 66 | now <- as.POSIXct("2020-01-01 11:59:59") 67 | 68 | tres <- backup_time(tf, age = as.POSIXct("2019-02-01 12:00:01"), now = now) 69 | expect_match( 70 | newest_backup(tres), 71 | "2020-01-01" 72 | ) 73 | expect_identical(bq$n, 2L) 74 | 75 | expect_equal(min(bq$files$timestamp), as.POSIXct("2019-02-01 12:00:00")) 76 | expect_equal(max(bq$files$timestamp), now) 77 | 78 | backup_time(tf, max_backups = 0) 79 | }) 80 | 81 | 82 | 83 | 84 | test_that("backup/rotate date works to different directory", { 85 | tf <- file.path(td, "test.log") 86 | bu_dir <- file.path(td, "backups") 87 | dir.create(bu_dir) 88 | on.exit(unlink(c(tf, bu_dir), recursive = TRUE)) 89 | 90 | file.create(tf) 91 | writeLines("foobar", tf) 92 | 93 | backup_time(tf, dir = bu_dir, now = as.POSIXct("2019-01-01 12:12:12"), verbose = TRUE, age = "-99999 years") 94 | 95 | expect_identical( 96 | readLines(tf), 97 | readLines(file.path(dirname(tf), "backups", "test.2019-01-01--12-12-12.log")) 98 | ) 99 | 100 | expect_identical(n_backups(tf, dir = bu_dir), 1L) 101 | prune_backups(tf, 0, dir = bu_dir) 102 | expect_identical(n_backups(tf, dir = bu_dir), 0L) 103 | expect_length(list.files(bu_dir), 0) 104 | }) 105 | 106 | 107 | 108 | 109 | test_that("backup/rotate_date works with size", { 110 | tf <- file.path(td, "test.log") 111 | on.exit(unlink(tf)) 112 | saveRDS(iris, tf) 113 | size_ori <- file.size(tf) 114 | 115 | rotate_time(tf, size = "5kb") 116 | expect_identical(n_backups(tf), 0L) 117 | expect_equal(file.size(tf), size_ori) 118 | 119 | rotate_time(tf, size = "0.5kb") 120 | expect_identical(n_backups(tf), 1L) 121 | expect_equal(file.size(tf), 0) 122 | 123 | prune_backups(tf, 0) 124 | }) 125 | 126 | 127 | 128 | 129 | test_that("backup/rotate_time fails if backup already exists for that period", { 130 | tf <- file.path(td, "test.log") 131 | on.exit(unlink(tf)) 132 | saveRDS(iris, tf) 133 | 134 | now <- Sys.time() 135 | backup_time(tf, now = now) 136 | expect_error(backup_time(tf, now = now), "exists") 137 | expect_error(rotate_time(tf, now = now, dry_run = TRUE), "exists") 138 | 139 | prune_backups(tf, 0) 140 | }) 141 | -------------------------------------------------------------------------------- /tests/testthat/test_utils-fs.R: -------------------------------------------------------------------------------- 1 | context("utils-fs") 2 | 3 | 4 | dr <- tempdir() 5 | td <- file.path(dr, "rotor") 6 | dir.create(td, recursive = TRUE) 7 | 8 | teardown({ 9 | unlink(td, recursive = TRUE) 10 | if (!length(list.files(dr))) unlink(dr, recursive = TRUE) 11 | }) 12 | 13 | 14 | 15 | 16 | test_that("utils-fs works as expected", { 17 | 18 | expect_message( 19 | msg_file_create("foo", "bar", dry_run = FALSE, verbose = TRUE), 20 | "(\\+.*){2}" 21 | ) 22 | 23 | expect_message( 24 | msg_file_remove("foo", "bar", dry_run = FALSE, verbose = TRUE), 25 | "(\\-.*){2}" 26 | ) 27 | 28 | expect_message( 29 | msg_file_rename(c("foo", "bar"), c("f00", "fizz/bar"), dry_run = FALSE, verbose = TRUE), 30 | "(\\~.*){2}" 31 | ) 32 | 33 | expect_message( 34 | msg_file_copy(c("fizz/foo", "bar"), c("fizz/f00", "fizz/bar"), dry_run = FALSE, verbose = TRUE), 35 | "(\\+.*){2}" 36 | ) 37 | }) 38 | 39 | 40 | 41 | test_that("utils-fs can create/remove files in dry_run memory", { 42 | tf <- file.path(td, "test.log") 43 | file.create(tf) 44 | snap <- fileSnapshot(td) 45 | DRY_RUN$activate() 46 | 47 | on.exit({ 48 | file.remove(tf) 49 | DRY_RUN$deactivate() 50 | }) 51 | 52 | 53 | # create fake file 54 | expect_true(file_create(file.path(td, "test2.log"))) 55 | expect_true(file_exists(file.path(td, "test2.log"))) 56 | expect_snapshot_unchanged(snap) 57 | 58 | # delete real file only in memory 59 | expect_true(file_remove(file.path(td, "test.log"))) 60 | expect_false(file_exists(file.path(td, "test.log"))) 61 | expect_true(file.exists(file.path(td, "test.log"))) 62 | expect_snapshot_unchanged(snap) 63 | 64 | # delete fake file from memory 65 | expect_true(file_remove(file.path(td, "test2.log"))) 66 | expect_false(file_exists(file.path(td, "test2.log"))) 67 | expect_snapshot_unchanged(snap) 68 | 69 | # list files 70 | expect_identical(list_files(td), character()) 71 | 72 | new_real <- file.path(td, "foo.txt") 73 | new_fake <- file.path(td, "bar.txt") 74 | on.exit(file.remove(new_real), add = TRUE) 75 | 76 | file.create(new_real) 77 | file_create(new_fake) 78 | expect_snapshot_unchanged(snap) 79 | 80 | expect_path_equal(list_files(td, full.names = TRUE), c(new_real, new_fake)) 81 | expect_path_equal(list.files(td, full.names = TRUE), c(new_real, tf)) 82 | }) 83 | -------------------------------------------------------------------------------- /tests/testthat/test_utils-predicates.R: -------------------------------------------------------------------------------- 1 | context("utils-predicates") 2 | 3 | 4 | 5 | 6 | test_that("is_zipcmd_available detects zipcommand", { 7 | # can only return true on platforms with a zip command 8 | skip_if_not(is_zipcmd_available(), "system zip-command is available") 9 | expect_true(is_zipcmd_available()) 10 | }) 11 | 12 | 13 | 14 | 15 | test_that("is_zipcmd_available() detects missing zipcommand", { 16 | expect_false(is_zipcmd_available("sdjkghsaghaskjghsagj")) 17 | }) 18 | 19 | 20 | 21 | 22 | test_that("utils-fs can create/remove files in dry_run memory", { 23 | td <- file.path(tempdir(), "rotor") 24 | tf1 <- file.path(td, "foo") 25 | tf2 <- file.path(td, "bar") 26 | dir.create(tf1, recursive = TRUE) 27 | file.create(tf2) 28 | 29 | on.exit(unlink(c(tf2, tf1, td), recursive = TRUE)) 30 | 31 | expect_true(is_dir(tf1)) 32 | expect_false(is_dir(tf2)) 33 | }) 34 | 35 | 36 | 37 | test_that("is_pure_BackupQueue", { 38 | td <- file.path(tempdir(), "rotor") 39 | dir.create(td, recursive = TRUE) 40 | on.exit(unlink(td, recursive = TRUE)) 41 | tf <- file.path(td, "test.log") 42 | file.create(tf) 43 | 44 | # Empty Queue 45 | expect_true(is_pure_BackupQueue(tf)) 46 | expect_true(is_pure_BackupQueueDateTime(tf)) 47 | expect_true(is_pure_BackupQueueIndex(tf)) 48 | 49 | # With a Date Backup 50 | tf_date <- file.path(td, "test.2017.log") 51 | file.create(tf_date) 52 | expect_true(is_pure_BackupQueue(tf)) 53 | expect_true(is_pure_BackupQueueDateTime(tf)) 54 | expect_false(is_pure_BackupQueueIndex(tf)) 55 | 56 | 57 | # With mixed backups 58 | tf_idx <- file.path(td, "test.1.log") 59 | file.create(tf_idx) 60 | expect_false(is_pure_BackupQueue(tf)) 61 | expect_false(is_pure_BackupQueueDateTime(tf)) 62 | expect_false(is_pure_BackupQueueIndex(tf)) 63 | 64 | expect_error(assert_pure_BackupQueue(tf), "not possible") 65 | expect_warning(assert_pure_BackupQueue(tf, warn_only = TRUE)) 66 | 67 | # With indexed backups 68 | file.remove(tf_date) 69 | expect_true(is_pure_BackupQueue(tf)) 70 | expect_false(is_pure_BackupQueueDateTime(tf)) 71 | expect_true(is_pure_BackupQueueIndex(tf)) 72 | 73 | unlink(tf_idx) 74 | }) 75 | 76 | 77 | 78 | 79 | test_that("is_parsable_date/time works", { 80 | 81 | expect_true(is_parsable_datetime(as.Date("2018-12-01"))) 82 | expect_true(is_parsable_datetime(as.POSIXct("2018-12-01 12:01:01"))) 83 | 84 | expect_true(is_parsable_datetime("2018-12-01")) 85 | expect_true(is_parsable_datetime("20181201")) 86 | expect_true(is_parsable_datetime("2018-02")) 87 | expect_true(is_parsable_datetime("201802")) 88 | expect_true(is_parsable_datetime("2018")) 89 | 90 | expect_true(is_parsable_datetime(20181231)) 91 | #expect_false(is_parsable_datetime(20181232)) 92 | expect_false(is_parsable_datetime("1 week")) 93 | expect_false(is_parsable_datetime("2 years")) 94 | 95 | expect_true(is_parsable_datetime("2019-12-12--13-12-11")) 96 | expect_true(is_parsable_datetime("2019-12-12--13-12-")) 97 | expect_true(is_parsable_datetime("2019-12-12--13--")) 98 | expect_true(is_parsable_datetime("2019-12-12----")) 99 | expect_true(is_parsable_datetime("2019-12-----")) 100 | expect_true(is_parsable_datetime("2019------")) 101 | expect_false(is_parsable_datetime("------")) 102 | 103 | 104 | expect_true(is_parsable_datetime("2019-12-12T13-12-11")) 105 | expect_true(is_parsable_datetime("2019-12-12T13-12-")) 106 | expect_true(is_parsable_datetime("2019-12-12T13T")) 107 | expect_true(is_parsable_datetime("2019-12-12TT")) 108 | expect_true(is_parsable_datetime("2019-12TT-")) 109 | expect_true(is_parsable_datetime("2019TTT")) 110 | expect_false(is_parsable_datetime("TTT")) 111 | 112 | expect_true(is_parsable_datetime("2019-12-12 13-12-11")) 113 | expect_true(is_parsable_datetime("2019-12-12 13-12-")) 114 | expect_true(is_parsable_datetime("2019-12-12 13 ")) 115 | expect_true(is_parsable_datetime("2019-12-12 ")) 116 | expect_true(is_parsable_datetime("2019-12 -")) 117 | expect_true(is_parsable_datetime("2019 ")) 118 | expect_false(is_parsable_datetime(" ")) 119 | 120 | expect_false(is_parsable_date("2019-12-12--13-12-11")) 121 | expect_false(is_parsable_date("2019-12-12--13-12-")) 122 | expect_false(is_parsable_date("2019-12-12--13--")) 123 | expect_true(is_parsable_date("2019-12-12----")) 124 | expect_true(is_parsable_date("2019-12-----")) 125 | expect_true(is_parsable_date("2019------")) 126 | expect_false(is_parsable_date("------")) 127 | }) 128 | 129 | 130 | 131 | 132 | 133 | test_that("is_backup_older_than_interval works as expected", { 134 | now <- as.POSIXct("2019-12-11 00:12:13") 135 | 136 | expect_true(is_backup_older_than_interval(as.Date("2019-12-11"), "0 days", now)) 137 | expect_true(is_backup_older_than_interval(as.Date("2019-12-11"), "-1 days", now)) 138 | expect_true(is_backup_older_than_interval(as.Date("2019-12-11"), 0, now)) 139 | expect_true(is_backup_older_than_interval(as.Date("2019-12-11"), -1, now)) 140 | 141 | 142 | now <- "2019-12-11--00-12" 143 | 144 | expect_false(is_backup_older_than_interval(as.Date("2019-01-01"), "1 year", now)) 145 | expect_true(is_backup_older_than_interval(as.Date("2018-12-12"), "1 year", now)) 146 | expect_true(is_backup_older_than_interval(as.Date("2018-12-12"), "0 year", now)) 147 | 148 | expect_false(is_backup_older_than_interval(as.Date("2999-12-12"), Inf, now)) 149 | }) 150 | 151 | 152 | 153 | 154 | 155 | test_that("is_backup_older_than_interval works with weeks", { 156 | # week 157 | expect_false( 158 | is_backup_older_than_interval(interval = "1 week", as.Date("2019-04-01"), as.Date("2019-04-07")) # 2019-W14 159 | ) 160 | expect_true( 161 | is_backup_older_than_interval(interval = "1 week", as.Date("2019-04-01"), as.Date("2019-04-08")) # 2019-W14 162 | ) 163 | expect_false( 164 | is_backup_older_than_interval(interval = "6 week", as.Date("2019-04-01"), as.Date("2019-05-06")) # 2019-W19 165 | ) 166 | expect_true( 167 | is_backup_older_than_interval(interval = "5 weeks", as.Date("2019-04-01"), as.Date("2019-05-06")) # 2019-W19 168 | ) 169 | 170 | # month 171 | expect_false( 172 | is_backup_older_than_interval(interval = "1 month", as.Date("2019-04-01"), as.Date("2019-04-30")) # 2019-W14 173 | ) 174 | expect_true( 175 | is_backup_older_than_interval(interval = "1 month", as.Date("2019-04-01"), as.Date("2019-05-01")) # 2019-W14 176 | ) 177 | expect_false( 178 | is_backup_older_than_interval(interval = "6 month", as.Date("2019-04-01"), as.Date("2019-09-01")) # 2019-W19 179 | ) 180 | expect_true( 181 | is_backup_older_than_interval(interval = "5 months", as.Date("2019-04-01"), as.Date("2019-09-06")) # 2019-W19 182 | ) 183 | }) 184 | 185 | 186 | 187 | test_that("is_backup_older_than_datetime works as expected", { 188 | now <- as.POSIXct("2019-12-11 00:12:13") 189 | 190 | expect_true(is_backup_older_than_datetime(as.Date("2019-12-11"), now)) 191 | expect_false(is_backup_older_than_datetime(as.Date("2019-12-11"), as.Date(now))) 192 | expect_false(is_backup_older_than_datetime(as.Date("2019-12-12"), now)) 193 | }) 194 | 195 | -------------------------------------------------------------------------------- /tests/testthat/test_utils.R: -------------------------------------------------------------------------------- 1 | context("utils") 2 | 3 | 4 | test_that("utils works as expected", { 5 | expect_identical(fmt_bytes(0), "0 B") 6 | expect_identical(fmt_bytes(1024), "1 KiB") 7 | expect_identical(fmt_bytes(2^20), "1 MiB") 8 | expect_identical(fmt_bytes(2^30), "1 GiB") 9 | expect_identical(fmt_bytes(2^40), "1 TiB") 10 | expect_identical(fmt_bytes(2^50), "1024 TiB") 11 | }) 12 | 13 | 14 | 15 | 16 | test_that("path_tidy works as expected", { 17 | expect_identical( 18 | is_windows_path(c( 19 | "d:", 20 | "C:\\Program Files", 21 | "c:\\Program Files", 22 | "c", 23 | "/home/foobar", 24 | "/") 25 | ), 26 | c(TRUE, TRUE, TRUE, FALSE, FALSE, FALSE) 27 | ) 28 | 29 | 30 | expect_identical( 31 | path_tidy(c( 32 | "c:\\Program Files", 33 | "~/rpkgs", 34 | "~/rpkgs/", 35 | "//foo/bar/", 36 | "//foo///bar/", 37 | "c:", 38 | "/" 39 | )), 40 | c( 41 | "C:/Program Files", 42 | "~/rpkgs", 43 | "~/rpkgs", 44 | "//foo/bar", 45 | "//foo/bar", 46 | "C:/", 47 | "/" 48 | ) 49 | ) 50 | 51 | }) 52 | --------------------------------------------------------------------------------