Skip to content

Commit

Permalink
Track snapshot use and remove unused snapshots #209
Browse files Browse the repository at this point in the history
  • Loading branch information
andrie committed Mar 16, 2017
1 parent 809dc73 commit 8cdc1f8
Show file tree
Hide file tree
Showing 11 changed files with 129 additions and 12 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
export(checkpoint)
export(checkpointArchives)
export(checkpointRemove)
export(getAccessDate)
export(getValidSnapshots)
export(mranUrl)
export(setSnapshot)
Expand Down
37 changes: 37 additions & 0 deletions R/access_date.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,37 @@
# Write a small file into the snapshot that contains the last date this snapshot was accessed by checkpoint()
writeAccessDate <- function(snapshotDate, checkpointLocation = "~/"){
today <- strftime(Sys.Date(), "%Y-%m-%d", tz = FALSE)
if(missing(snapshotDate) || is.null(snapshotDate)){
snapshotDate <- today
}
cpdir <- checkpointPath(snapshotDate,
checkpointLocation = checkpointLocation,
type = "snapshot")
lastaccessFile <- file.path(cpdir, ".lastaccessed")
writeLines(today, con = lastaccessFile)
}


#' Returns the date the snapshot was last accessed.
#'
#' The [checkpoint()] function stores a marker in the snapshot folder every time the function gets called. This marker contains the system date, thus indicating the the last time the snapshot was accessed.
#'
#' @return Named character with last access date
#' @export
#' @family checkpoint functions
#' @seealso [checkpointRemove()]
getAccessDate <- function(checkpointLocation = "~/"){
cp <- checkpointPath(NULL,
checkpointLocation = checkpointLocation,
type = "root"
)
z <- dir(cp, pattern = ".{4}-.{2}-.{2}",
include.dirs = TRUE,
full.names = TRUE
)
sapply(z, function(x){
laf <- file.path(x, ".lastaccessed")
if(file.exists(laf)) readLines(laf) else NA
})
}

4 changes: 4 additions & 0 deletions R/checkpoint.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,6 +32,10 @@
#' * `snapshotDate`
#' * `pkg`
#' * `bytes`
#'
#' @section Last accessed date:
#'
#' The [checkpoint()] function stores a marker in the snapshot folder every time the function gets called. This marker contains the system date, thus indicating the the last time the snapshot was accessed. See also [getAccessDate()]. To remove snapshots that have not been used since a given date, use [checkpointRemove()]
#'
#' @param snapshotDate Date of snapshot to use in `YYYY-MM-DD` format,e.g. `"2014-09-17"`. Specify a date on or after `"2014-09-17"`. MRAN takes one snapshot per day.
#'
Expand Down
47 changes: 40 additions & 7 deletions R/checkpoint_remove.R
Original file line number Diff line number Diff line change
Expand Up @@ -16,21 +16,54 @@ checkpointArchives <- function(checkpointLocation = "~/"){

#' Remove checkpoint archive from disk.
#'
#' This function enables you to delete a snapshot archive folder from disk, thus releasing storage space.
#'
#' @inheritParams checkpoint
#' @param allSinceSnapshot If `TRUE`, removes all snapshot archives since the `snapshotDate`
#' @param allUntilSnapshot If `TRUE`, removes all snapshot archives before the `snapshotDate`
#' @param notUsedSince If `TRUE`, removes all snapshot archives that have not been accessed since the `snapshotDate`. See [getAccessDate()]
#' @export
#' @family checkpoint functions
#' @seealso [getAccessDate()]
#' @example inst/examples/example_remove.R
checkpointRemove <- function(snapshotDate, checkpointLocation = "~/"){
z <- list.files(path = paste0(normalizePath(checkpointLocation), ".checkpoint"),
pattern = paste0(snapshotDate, "$"),
full.names = TRUE)
to_delete <- normalizePath(z, winslash = "/")
if(length(to_delete) == 0) {
warning("archive not found")
checkpointRemove <- function(snapshotDate, checkpointLocation = "~/",
allSinceSnapshot = FALSE,
allUntilSnapshot = FALSE,
notUsedSince = FALSE,
days){
if(!missing(snapshotDate) && !is.null(snapshotDate)){
to_delete <- checkpointPath(snapshotDate, checkpointLocation,
type = "snapshot")
}
if(allSinceSnapshot){
archives <- checkpointArchives(checkpointLocation = checkpointLocation)
archiveDates <- basename(archives)
to_delete <- checkpointPath(archiveDates[archiveDates >= snapshotDate],
checkpointLocation, type = "snapshot")

}
if(allUntilSnapshot){
archives <- checkpointArchives(checkpointLocation = checkpointLocation)
archiveDates <- basename(archives)
to_delete <- checkpointPath(archiveDates[archiveDates <= snapshotDate],
checkpointLocation, type = "snapshot")

}
if(notUsedSince){
archiveDates <- getAccessDate(checkpointLocation = checkpointLocation)
archiveDates <- archiveDates[!is.na(archiveDates)]
archiveDates <- archiveDates[archiveDates >= snapshotDate]
to_delete <- checkpointPath(basename(archiveDates),
checkpointLocation, type = "snapshot")

}
if(length(to_delete) ==0 || !dir.exists(to_delete)) {
message("no archives removed")
invisible(NULL)
} else {
res <- unlink(to_delete, recursive = TRUE)
if(res == 0) message("successfully removed archive")
invisible(res)
}
}

Expand Down
7 changes: 7 additions & 0 deletions man/checkpoint.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/checkpointArchives.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

16 changes: 13 additions & 3 deletions man/checkpointRemove.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

22 changes: 22 additions & 0 deletions man/getAccessDate.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

3 changes: 2 additions & 1 deletion man/getValidSnapshots.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/mranUrl.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions man/setSnapshot.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

0 comments on commit 8cdc1f8

Please sign in to comment.