-
Notifications
You must be signed in to change notification settings - Fork 6
/
navigation.R
190 lines (168 loc) · 4.22 KB
/
navigation.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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
#' Change/show current working directory
#'
#' Changes iRODS the current working directory (collection). The functions
#' mimic behavior of unix `cd` and `pwd`.
#'
#' @param dir Change the current directory to DIR. The default DIR is the value
#' of the HOME shell variable.
#'
#' @return Visibly or invisibly returns the path.
#' @export
#'
#' @examples
#' if(interactive()) {
#' # connect project to server
#' create_irods("http://localhost/irods-rest/0.9.3", "/tempZone/home")
#'
#' # authenticate
#' iauth()
#'
#' # default dir
#' icd(".")
#' ipwd()
#'
#'
#' # relative paths work as well
#' icd("/tempZone/home")
#' ipwd()
#'
#' # go back on level lower
#' icd("..")
#' ipwd()
#'
#' # absolute paths work as well
#' icd("/tempZone/home/rods")
#' ipwd()
#' }
icd <- function(dir) {
# get current dir
if (dir == ".") {
current_dir <- local(current_dir, envir = .rirods)
}
# get level lower
if (dir == "..") {
current_dir <- local(current_dir, envir = .rirods)
current_dir <- sub(paste0("/", basename(current_dir)), "", current_dir)
if (current_dir == character(1))
current_dir <- "/"
}
# get requested dir
if (!dir %in% c(".", "..")) {
if(!grepl("^\\.{1,2}/", dir)) {
if (grepl("^\\/", dir)) {
# absolute path
current_dir <- dir
} else {
# relative path
current_dir <- paste0(local(current_dir, envir = .rirods), "/", dir)
}
} else {
if(grepl("^\\.{2}/", dir)) {
# movement relative path
base_dir <- icd("..")
current_dir <- paste0(
base_dir,
ifelse(base_dir == "/", "", "/"), sub("\\.\\./", "", dir)
)
} else if(grepl("^\\.{1}/", dir)) {
# no movement relative path
base_dir <- icd(".")
current_dir <- paste0(
base_dir,
ifelse(base_dir == "/", "", "/"), sub("\\./", "", dir)
)
}
}
# check if irods collection exists
if (!is_collection(current_dir))
stop("This is not a directory (collection).", call. = FALSE)
current_dir
}
# store internally
.rirods$current_dir <- current_dir
# return location
invisible(current_dir)
}
#' @rdname icd
#'
#' @export
ipwd <- function() .rirods$current_dir
#' Listing iRODS data objects and collections
#'
#' Recursive listing of a collection, or stat, metadata, and access control
#' information for a given data object.
#'
#' @param logical_path Directory to be listed.
#' @param stat Boolean flag to indicate stat information is desired.
#' @param permissions Boolean flag to indicate access control information is
#' desired.
#' @param metadata Boolean flag to indicate metadata is desired.
#' @param offset Number of records to skip for pagination.
#' @param limit Number of records desired per page.
#' @param message In case the collection is empty a message saying so is
#' returned.
#' @param verbose Show information about the http request and response.
#'
#' @return tibble with logical paths
#' @export
#'
#' @examples
#' if(interactive()) {
#' # authenticate
#' iauth()
#'
#' # list home directory
#' ils()
#' }
ils <- function(
logical_path = ".",
stat = FALSE,
permissions = FALSE,
metadata = FALSE,
offset = 0,
limit = 100,
message = TRUE,
verbose = FALSE
) {
# logical path
if (logical_path == ".") {
lpath <- .rirods$current_dir
} else {
lpath <- logical_path
}
# flags to curl call
args <- list(
`logical-path` = lpath,
stat = as.integer(stat),
permissions = as.integer(permissions),
metadata = as.integer(metadata),
offset = offset,
limit = limit
)
# http call
out <- irods_rest_call("list", "GET", args, verbose)
# parse
out <- httr2::resp_body_json(
out,
check_type = FALSE,
simplifyVector = TRUE
)$`_embedded` |>
as.data.frame()
# metadata reordering
if (isTRUE(metadata)) {
try(out <- metadata_reorder(out), silent = TRUE)
}
# output
if (nrow(out) == 0) {
if (isTRUE(message))
message("This collection does not contain any objects or collections.")
invisible(out)
} else {
out
}
}
# reorder metadata if it exists
metadata_reorder <- function(x) {
x$metadata <- Map(function(x) {x <- x[ ,c("attribute", "value", "units")]; x}, x$metadata)
x
}