-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathlist_backups.R
138 lines (115 loc) · 3.07 KB
/
list_backups.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
#' Discover existing backups
#'
#' These function return information on the backups of a file (if any exist)
#'
#' @param file `character` scalar: Path to a file.
#' @inheritSection rotate Intervals
#' @inheritParams rotate
#' @export
#' @seealso [rotate()]
#' @examples
#' # setup example files
#' tf <- tempfile("test", fileext = ".rds")
#' saveRDS(cars, tf)
#' backup(tf)
#' backup(tf)
#'
#' backup_info(tf)
#' list_backups(tf)
#' n_backups(tf)
#' newest_backup(tf)
#' oldest_backup(tf)
#'
#' # cleanup
#' prune_backups(tf, 0)
#' n_backups(tf)
#' file.remove(tf)
#' @export
#' @return `backup_info()` returns a `data.frame` similar to the output of
#' [file.info()]
backup_info <- function(
file,
dir = dirname(file)
){
if (is_pure_BackupQueueIndex(file, dir = dir))
BackupQueueIndex$new(file, dir = dir)$files
else if (is_pure_BackupQueueDateTime(file, dir = dir))
BackupQueueDateTime$new(file, dir = dir)$files
else
BackupQueue$new(file, dir = dir)$files
}
#' @export
#' @return `list_backups()` returns the paths to all backups of `file`
#' @rdname backup_info
list_backups <- function(
file,
dir = dirname(file)
){
BackupQueue$new(file, dir = dir)$files$path
}
#' @rdname backup_info
#' @export
#' @return `n_backups()` returns the number of backups of `file` as an `integer`
#' scalar
n_backups <- function(
file,
dir = dirname(file)
){
if (!is_pure_BackupQueue(file, dir = dir)){
warning(
"Found index as well as timestamped backups for '", file, "'. ",
"This is fine, but some rotor functions might not work as expected",
"on such files.",
call. = FALSE
)
}
BackupQueue$new(file, dir = dir)$n
}
#' @return `newest_backup()` and `oldest_backup()` return the paths to the
#' newest or oldest backup of `file` (or an empty `character` vector if none exist)
#' @export
#' @rdname backup_info
newest_backup <- function(
file,
dir = dirname(file)
){
bq <- BackupQueue$new(file, dir = dir)
if (!bq$has_backups){
return(character())
}
assert(
is_pure_BackupQueueIndex(file, dir = dir) ||
is_pure_BackupQueueDateTime(file, dir = dir),
"Can only determine newest backup for files that only have either indexed ",
"or timestamped backups, but '", file, "' has both:\n",
paste("~ ", bq$files$path, collapse = "\n")
)
bq <- BackupQueueDateTime$new(file, dir = dir)
if (!bq$has_backups){
bq <- BackupQueueIndex$new(file, dir = dir)
}
first(bq$files$path)
}
#' @export
#' @rdname backup_info
oldest_backup <- function(
file,
dir = dirname(file)
){
bq <- BackupQueue$new(file, dir = dir)
if (!bq$has_backups){
return(character())
}
assert(
is_pure_BackupQueueIndex(file, dir = dir) ||
is_pure_BackupQueueDateTime(file, dir = dir),
"Can only determine newest backup for files that only have either indexed ",
"or timestamped backups, but '", file, "' has both:\n",
paste("~ ", bq$files$path, collapse = "\n")
)
bq <- BackupQueueDateTime$new(file, dir = dir)
if (!bq$has_backups){
bq <- BackupQueueIndex$new(file, dir = dir)
}
last(bq$files$path)
}