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
|
#' Remove a non-child object from the staging directory
#'
#' \emph{WARNING: this function is deprecated, as directories of non-child objects can just be deleted with regular methods (e.g., \code{\link{file.rename}}) in the latest version of \pkg{alabaster}.}
#' Pretty much as it says in the title.
#' This only works with non-child objects as children are referenced by their parents and cannot be safely removed in this manner.
#'
#' @param dir String containing the path to the staging directory.
#' @param path String containing the path to a non-child object inside \code{dir}, as used in \code{\link{acquireMetadata}}.
#' This can also be a redirection to such an object.
#'
#' @author Aaron Lun
#'
#' @return
#' The object represented by \code{path} is removed, along with any redirections to it.
#' A \code{NULL} is invisibly returned.
#'
#' @details
#' This function will search around \code{path} for JSON files containing redirections to \code{path}, and remove them.
#' More specifically, if \code{path} is a subdirectory, it will search in the same directory containing \code{path};
#' otherwise, it will search in the directory containing \code{dirname(path)}.
#' Redirections in other locations will not be removed automatically - these will be caught by \code{\link{checkValidDirectory}} and should be manually removed.
#'
#' @examples
#' tmp <- tempfile()
#' dir.create(tmp)
#'
#' library(S4Vectors)
#' df <- DataFrame(A=1:10, B=LETTERS[1:10])
#' meta <- stageObject(df, tmp, path="whee")
#' writeMetadata(meta, tmp)
#'
#' ll <- list(A=1, B=LETTERS, C=DataFrame(X=1:5))
#' meta <- stageObject(ll, tmp, path="stuff")
#' writeMetadata(meta, tmp)
#'
#' redirect <- createRedirection(tmp, "whoop", "whee/simple.csv.gz")
#' writeMetadata(redirect, tmp)
#'
#' list.files(tmp, recursive=TRUE)
#' removeObject(tmp, "whoop")
#' list.files(tmp, recursive=TRUE)
#'
#' @export
removeObject <- function(dir, path) {
meta <- acquireMetadata(dir, path)
if (isTRUE(meta$is_child)) {
stop("cannot remove a child object without removing the parent")
}
refpath <- meta$path
unlink(file.path(dir, dirname(refpath)), recursive=TRUE)
# Searching for redirections.
searchpath <- file.path(dir, dirname(dirname(refpath)))
potential <- list.files(searchpath, pattern="\\.json$")
for (x in potential) {
redpath <- file.path(searchpath, x)
meta <- fromJSON(redpath, simplifyVector=FALSE)
if (dirname(meta[["$schema"]]) == "redirection") {
survivors <- list()
for (x in meta[["redirection"]][["targets"]]) {
if (x$type != "local" || x$location != refpath) {
survivors <- c(survivors, list(x))
}
}
if (length(survivors)) {
meta[["redirection"]][["targets"]] <- survivors
writeMetadata(meta, dir)
} else {
unlink(redpath)
}
}
}
invisible(NULL)
}
|
