Indicate if extracted metadata is local or not

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 = "[email protected]"),
              person("Robert", "Ashton", role = "aut"),

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]]

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"))))
+})