diff --git a/DESCRIPTION b/DESCRIPTION index b42ffab2..fe24b08b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: orderly2 Title: Orderly Next Generation -Version: 1.99.48 +Version: 1.99.49 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"), email = "rich.fitzjohn@gmail.com"), person("Robert", "Ashton", role = "aut"), diff --git a/R/outpack_tools.R b/R/outpack_tools.R index 4f56c17d..f6424fdc 100644 --- a/R/outpack_tools.R +++ b/R/outpack_tools.R @@ -102,7 +102,11 @@ ##' are more complex, these will be list columns. ##' ##' You must not provide `id`; it is always returned and always first -##' as a character vector column. +##' as a character vector column. If your extraction could possibly +##' return data from locations (i.e., you have `allow_remote = TRUE` +##' or have given a value for `location`) then we add a logical column +##' `local` which indicates if the packet is local to your archive, +##' meaning that you have all the files from it locally. ##' ##' You can rename the columns by providing a name to entries within ##' `extract`, for example: @@ -222,6 +226,12 @@ orderly_metadata_extract <- function(expr = NULL, name = NULL, location = NULL, envir <- environment() ret <- data_frame(id = ids) + if (isTRUE(allow_remote) || length(location) > 0) { + loc <- root$index$location(location) + loc <- loc[loc$packet %in% ids, ] + ret$local <- ids %in% root$index$unpacked() + ret$location <- I(unname(split(loc$location, loc$packet)[ids])) + } for (i in seq_len(nrow(extract))) { from_i <- extract$from[[i]] is_i <- extract$is[[i]] diff --git a/man/orderly_metadata_extract.Rd b/man/orderly_metadata_extract.Rd index 0d7dbed1..a9c43c61 100644 --- a/man/orderly_metadata_extract.Rd +++ b/man/orderly_metadata_extract.Rd @@ -170,7 +170,11 @@ will be a character vector, but because \code{parameters} and \code{files} are more complex, these will be list columns. You must not provide \code{id}; it is always returned and always first -as a character vector column. +as a character vector column. If your extraction could possibly +return data from locations (i.e., you have \code{allow_remote = TRUE} +or have given a value for \code{location}) then we add a logical column +\code{local} which indicates if the packet is local to your archive, +meaning that you have all the files from it locally. You can rename the columns by providing a name to entries within \code{extract}, for example: diff --git a/tests/testthat/test-outpack-tools.R b/tests/testthat/test-outpack-tools.R index d5756638..28c14d71 100644 --- a/tests/testthat/test-outpack-tools.R +++ b/tests/testthat/test-outpack-tools.R @@ -347,3 +347,43 @@ test_that("can extract plugin metadata", { expect_equal(d[["custom_example.random"]][[1]], meta[[1]]$custom[["example.random"]]) }) + + +test_that("can differentiate remote metadata", { + root <- create_temporary_root() + upstream <- create_temporary_root() + orderly_location_add_path("upstream", path = upstream$path, root = root) + + ids1 <- create_random_packet_chain(root, 5) + ids2 <- create_random_packet_chain(upstream, 3) + + d1 <- orderly_metadata_extract(root = root) + expect_equal(names(d1), c("id", "name", "parameters")) + expect_equal(nrow(d1), 5) + + d2 <- orderly_metadata_extract(root = root, allow_remote = TRUE) + expect_equal(names(d2), c("id", "local", "location", "name", "parameters")) + expect_equal(nrow(d2), 5) + expect_equal(d2$local, rep(TRUE, 5)) + expect_equal(d2$location, I(rep(list("local"), 5))) + + d3 <- orderly_metadata_extract(root = root, location = "upstream") + expect_equal(names(d3), c("id", "local", "location", "name", "parameters")) + expect_equal(nrow(d3), 0) + + d4 <- orderly_metadata_extract(root = root, allow_remote = TRUE, + pull_metadata = TRUE) + expect_equal(names(d4), c("id", "local", "location", "name", "parameters")) + expect_equal(nrow(d4), 8) + expect_equal(d4$local, rep(c(TRUE, FALSE), c(5, 3))) + expect_equal(d4$location, I(rep(list("local", "upstream"), c(5, 3)))) + + suppressMessages(orderly_location_pull_packet(ids2[[2]], root = root)) + + d5 <- orderly_metadata_extract(root = root, allow_remote = TRUE) + expect_equal(d5[names(d1)], d4[names(d1)]) + expect_equal(d5$local, c(rep(TRUE, 5), FALSE, TRUE, FALSE)) + expect_equal(d5$location, + I(c(rep(list("local"), 5), + list("upstream", c("local", "upstream"), "upstream")))) +})