implement BackupQueue$prune_identical()

Author: Stefan Fleck

NEWS.md

@@ -11,6 +11,7 @@
    - `$backup_dir` -> `dir()`
    - `$backups` -> `$files`
    - `$file` -> `$origin`
+* `BackupQueue$prune_identical()` removes identical backups for a BackupQueue
 
 
 # rotor 0.2.4

R/BackupQueue.R

@@ -310,6 +310,36 @@ BackupQueueIndex <- R6::R6Class(
     },
 
 
+    prune_identical = function(
+    ){
+      dd <- self$files
+      dd$md5 <- tools::md5sum(self$files$path)
+
+      dd <- dd[nrow(dd):1L, ]
+      sel <- duplicated(dd$md5)
+
+      remove <- dd[sel,  ]
+      keep   <- dd[!sel, ]
+
+      unlink(remove$path)
+
+      keep$path_new <- paste(
+        file.path(dirname(keep$path), keep$name),
+        pad_left(nrow(keep):1, pad = "0"),
+        keep$ext,
+        sep = "."
+      )
+      keep$path_new <- gsub("\\.$", "", keep$path_new)
+
+      # path_new will always have identical or lower indices than the old path.
+      # if we sort be sfx we can prevent race conditions in file.rename
+      # (i.e. where files would be overwriten because)
+      keep <- keep[order(keep$sfx), ]
+      file.rename(keep$path, keep$path_new)
+      self
+    },
+
+
     #' @description Should a file of `size` be rotated? See `size` argument of [`rotate()`]
     #' @return `TRUE` or `FALSE`
     should_rotate = function(size, verbose = FALSE){

tests/testthat/test_BackupQueue.R

@@ -488,6 +488,39 @@ test_that("BackupQueueIndex: $should_rotate(verbose = TRUE) displays helpful mes
 
 
 
+
+test_that("BackupQueueIndex: $prune_identical works", {
+  tf <- file.path(td, "test")
+
+  saveRDS(iris, tf)
+  iris_md5 <- tools::md5sum(tf)
+  bq <- BackupQueueIndex$new(tf)
+  on.exit({
+    bq$prune(0)
+    unlink(tf)
+  })
+  backup(tf)
+  backup(tf)
+  rotate(tf)
+
+  saveRDS(cars, tf)
+  cars_md5 <- tools::md5sum(tf)
+  backup(tf)
+  saveRDS(cars, tf)
+  rotate(tf)
+
+  saveRDS(iris, tf)
+
+  bq$prune_identical()
+
+  expect_identical(
+    unname(tools::md5sum(bq$files$path)),
+    unname(c(cars_md5, iris_md5))
+  )
+})
+
+
+
 # BackupQueueDateTime -----------------------------------------------------
 context("BackupQueueDateTime")