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
|
#' Load all non-child objects in a directory
#'
#' \emph{WARNING: this function is deprecated, use \code{\link{listObjects}} and loop over entries with \code{\link{readObject}} instead.}
#' As the title suggests, this function loads all non-child objects in a staging directory.
#' All loading is performed using \code{\link{altLoadObject}} to respect any application-specific overrides.
#' Children are used to assemble their parent objects and are not reported here.
#'
#' @param dir String containing a path to a staging directory.
#' @param redirect.action String specifying how redirects should be handled:
#' \itemize{
#' \item \code{"to"} will report an object at the redirection destination, not the redirection source.
#' \item \code{"from"} will report an object at the redirection source(s), not the destination.
#' \item \code{"both"} will report an object at both the redirection source(s) and destination.
#' }
#'
#' @return
#' A named list is returned containing all (non-child) R objects in \code{dir}.
#'
#' @author Aaron Lun
#' @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)
#'
#' all.meta <- loadDirectory(tmp)
#' str(all.meta)
#'
#' @export
loadDirectory <- function(dir, redirect.action = c("from", "to", "both")) {
all.meta <- listDirectory(dir, ignore.children=TRUE)
collected <- list()
redirects <- list()
for (m in all.meta) {
if (startsWith(m[["$schema"]], "redirection/")) {
redirects[[m$path]] <- m$redirection$targets[[1]]$location
} else if (!isTRUE(m$is_child)) {
collected[[m$path]] <- altLoadObject(m, dir)
}
}
redirect.action <- match.arg(redirect.action)
if (redirect.action == "to") {
return(collected)
}
host <- names(redirects)
targets <- unlist(redirects, use.names=FALSE)
m <- match(targets, names(collected))
keep <- !is.na(m)
m <- m[keep]
host <- host[keep]
if (length(m) == 0) {
return(collected)
}
copies <- collected[m]
names(copies) <- host
if (redirect.action == "from") {
collected <- collected[-m]
}
return(c(collected, copies))
}
|
