Added wrapper for vfs_copy_dir() function

I noticed this function was missing when writing up a tutorial on
VFS, so this is my attempt at wrapping it.

Author: nickvigilante

NAMESPACE

@@ -298,6 +298,7 @@ export(tiledb_subarray_to_query)
 export(tiledb_version)
 export(tiledb_vfs)
 export(tiledb_vfs_close)
+export(tiledb_vfs_copy_dir)
 export(tiledb_vfs_copy_file)
 export(tiledb_vfs_create_bucket)
 export(tiledb_vfs_create_dir)

R/RcppExports.R

@@ -953,6 +953,10 @@ libtiledb_vfs_copy_file <- function(vfs, old_uri, new_uri) {
     .Call(`_tiledb_libtiledb_vfs_copy_file`, vfs, old_uri, new_uri)
 }
 
+libtiledb_vfs_copy_dir <- function(vfs, old_uri, new_uri) {
+    .Call(`_tiledb_libtiledb_vfs_copy_dir`, vfs, old_uri, new_uri)
+}
+
 libtiledb_vfs_fh_free <- function(fhxp) {
     invisible(.Call(`_tiledb_libtiledb_vfs_fh_free`, fhxp))
 }

R/VFS.R

@@ -505,7 +505,7 @@ tiledb_vfs_serialize <- function(obj, uri, vfs = tiledb_get_vfs()) {
 #' @param file Character variable with a local file path
 #' @param uri Character variable with a URI describing a file path
 #' @param vfs A TileDB VFS object; default is to use a cached value.
-#' @return The uri value of the removed file
+#' @return The uri value of the copied file
 #' @export
 tiledb_vfs_copy_file <- function(file, uri, vfs = tiledb_get_vfs()) {
   stopifnot(
@@ -517,6 +517,24 @@ tiledb_vfs_copy_file <- function(file, uri, vfs = tiledb_get_vfs()) {
   libtiledb_vfs_copy_file(vfs@ptr, file, uri)
 }
 
+#' Copy a directory recursively to VFS
+#'
+#' @param dir Character variable with a local directory path
+#' @param uri Character variable with a URI describing a directory path
+#' @param vfs A TileDB VFS object; default is to use a cached value.
+#' @return The uri value of the copied directory
+#' @export
+tiledb_vfs_copy_dir <- function(dir, uri, vfs = tiledb_get_vfs()) {
+  stopifnot(
+    "Argument 'vfs' must be a tiledb_vfs object" = is(vfs, "tiledb_vfs"),
+    "Argument 'uri' must be character" = is.character(uri),
+    "Argument 'dir' must be character and point to a directory" =
+      is.character(uri) && dir.exists(dir),
+    "Directory with 'uri' already exists" = !dir.exists(uri)
+  )
+  libtiledb_vfs_copy_dir(vfs@ptr, dir, uri)
+}
+
 #' Recursively list objects from given URI
 #'
 #' This functionality is currently limited to S3 URIs.

inst/tinytest/test_vfs.R

@@ -11,38 +11,94 @@ expect_true(is(vfs, "tiledb_vfs"))
 ## create/remove/is/is_empty/empty bucket hard to test without credentials
 
 #test_that("tiledb_vfs create / test / remove directory", {
+
+# Create/copy/move/remove directory
 vfs <- tiledb_vfs()
-uri <- tempfile()
-
-expect_equal(tiledb_vfs_create_dir(uri), uri)
-## check directly
-expect_true(dir.exists(uri))
-## check via VFS
-expect_true(tiledb_vfs_is_dir(uri))
-
-newuri <- tempfile()
-expect_equal(tiledb_vfs_move_dir(uri, newuri), newuri)
-expect_equal(tiledb_vfs_remove_dir(newuri), newuri)
-expect_false(dir.exists(newuri))
+base_path <- tempdir()
+dir_uri <- file.path(base_path, "dir_uri")
+
+## Create directory
+expect_equal(tiledb_vfs_create_dir(dir_uri), dir_uri)
+### check directly
+expect_true(dir.exists(dir_uri))
+### check via VFS
+expect_true(tiledb_vfs_is_dir(dir_uri))
+
+## Check dir size
+expect_equal(tiledb_vfs_dir_size(dir_uri), 0)
+
+## Create a file in dir_uri to make sure move_dir and copy_dir work
+file_name <- "test.txt"
+file_uri <- file.path(dir_uri, file_name)
+expect_equal(tiledb_vfs_touch(file_uri), file_uri)
+
+## Copy directory
+copy_dir_uri <- file.path(base_path, "copy_dir_uri")
+expect_equal(tiledb_vfs_copy_dir(dir_uri, copy_dir_uri), copy_dir_uri)
+
+### Check both directories exist
+expect_true(dir.exists(dir_uri))
+expect_true(dir.exists(copy_dir_uri))
+
+### Check both files exist
+copy_file_uri <- file.path(copy_dir_uri, file_name)
+expect_true(file.exists(file_uri))
+expect_true(file.exists(copy_file_uri))
+
+## Move directory
+move_dir_uri <- file.path(base_path, "move_dir_uri")
+expect_equal(tiledb_vfs_move_dir(dir_uri, move_dir_uri), move_dir_uri)
+
+### Check only new directory exists
+expect_false(dir.exists(dir_uri))
+expect_true(dir.exists(copy_dir_uri))
+
+### Check only new file exists
+move_file_uri <- file.path(move_dir_uri, file_name)
+expect_false(file.exists(file_uri))
+expect_true(file.exists(move_file_uri))
+
+## Remove directory
+expect_equal(tiledb_vfs_remove_dir(move_dir_uri), move_dir_uri)
+
+### Check the moved file and directory no longer exist
+expect_false(dir.exists(move_dir_uri))
+expect_false(file.exists(move_file_uri))
+
 #})
 
+# Create/copy/move/remove file
+
 #test_that("tiledb_vfs create / test / remove file", {
 vfs <- tiledb_vfs()
-uri <- tempfile()
+file_uri <- tempfile()
+
+## Touch file
+expect_equal(tiledb_vfs_touch(file_uri), file_uri)
+expect_true(file.exists(file_uri))
+expect_true(tiledb_vfs_is_file(file_uri))
 
-expect_equal(tiledb_vfs_touch(uri), uri)
-expect_true(tiledb_vfs_is_file(uri))
+### Check file exists via VFS
+expect_true(tiledb_vfs_is_file(file_uri))
 
-## check via VFS
-expect_true(tiledb_vfs_is_file(uri))
+### check file size via VFS
+expect_equal(tiledb_vfs_file_size(file_uri), 0)
 
-## check via VFS
-expect_equal(tiledb_vfs_file_size(uri), 0)
+## Copy file
+copy_file_uri <- tempfile()
+expect_equal(tiledb_vfs_copy_file(file_uri, copy_file_uri), copy_file_uri)
+expect_true(file.exists(file_uri))
+expect_true(file.exists(copy_file_uri))
 
-newuri <- tempfile()
-expect_equal(tiledb_vfs_move_file(uri, newuri), newuri)
-expect_equal(tiledb_vfs_remove_file(newuri), newuri)
-expect_false(file.exists(newuri))
+## Move file
+move_file_uri <- tempfile()
+expect_equal(tiledb_vfs_move_file(file_uri, move_file_uri), move_file_uri)
+expect_false(file.exists(file_uri))
+expect_true(file.exists(move_file_uri))
+
+## Remove file
+expect_equal(tiledb_vfs_remove_file(move_file_uri), move_file_uri)
+expect_false(file.exists(move_file_uri))
 
 #})
 
@@ -62,6 +118,9 @@ if (requireNamespace("palmerpenguins", quietly=TRUE)) {
     uriser <- tempfile()
     expect_equal(tiledb_vfs_serialize(pp, uriser), uriser)
 
+    ## Check file has contents
+    expect_false(tiledb_vfs_file_size(uriser) == 0)
+
     expect_equal(pp, tiledb_vfs_unserialize(uriser))
 }
 

src/RcppExports.cpp

@@ -2851,6 +2851,19 @@ BEGIN_RCPP
     return rcpp_result_gen;
 END_RCPP
 }
+// libtiledb_vfs_copy_dir
+std::string libtiledb_vfs_copy_dir(XPtr<tiledb::VFS> vfs, std::string old_uri, std::string new_uri);
+RcppExport SEXP _tiledb_libtiledb_vfs_copy_dir(SEXP vfsSEXP, SEXP old_uriSEXP, SEXP new_uriSEXP) {
+BEGIN_RCPP
+    Rcpp::RObject rcpp_result_gen;
+    Rcpp::RNGScope rcpp_rngScope_gen;
+    Rcpp::traits::input_parameter< XPtr<tiledb::VFS> >::type vfs(vfsSEXP);
+    Rcpp::traits::input_parameter< std::string >::type old_uri(old_uriSEXP);
+    Rcpp::traits::input_parameter< std::string >::type new_uri(new_uriSEXP);
+    rcpp_result_gen = Rcpp::wrap(libtiledb_vfs_copy_dir(vfs, old_uri, new_uri));
+    return rcpp_result_gen;
+END_RCPP
+}
 // libtiledb_vfs_fh_free
 void libtiledb_vfs_fh_free(XPtr<vfs_fh_t> fhxp);
 RcppExport SEXP _tiledb_libtiledb_vfs_fh_free(SEXP fhxpSEXP) {
@@ -3976,6 +3989,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_tiledb_libtiledb_vfs_dir_size", (DL_FUNC) &_tiledb_libtiledb_vfs_dir_size, 2},
     {"_tiledb_libtiledb_vfs_ls", (DL_FUNC) &_tiledb_libtiledb_vfs_ls, 2},
     {"_tiledb_libtiledb_vfs_copy_file", (DL_FUNC) &_tiledb_libtiledb_vfs_copy_file, 3},
+    {"_tiledb_libtiledb_vfs_copy_dir", (DL_FUNC) &_tiledb_libtiledb_vfs_copy_dir, 3},
     {"_tiledb_libtiledb_vfs_fh_free", (DL_FUNC) &_tiledb_libtiledb_vfs_fh_free, 1},
     {"_tiledb_libtiledb_vfs_ls_recursive", (DL_FUNC) &_tiledb_libtiledb_vfs_ls_recursive, 3},
     {"_tiledb_libtiledb_stats_enable", (DL_FUNC) &_tiledb_libtiledb_stats_enable, 0},

src/libtiledb.cpp

@@ -4846,6 +4846,14 @@ std::string libtiledb_vfs_copy_file(XPtr<tiledb::VFS> vfs, std::string old_uri,
   return new_uri;
 }
 
+// [[Rcpp::export]]
+std::string libtiledb_vfs_copy_dir(XPtr<tiledb::VFS> vfs, std::string old_uri,
+  std::string new_uri) {
+check_xptr_tag<tiledb::VFS>(vfs);
+vfs->copy_dir(old_uri, new_uri);
+return new_uri;
+}
+
 // [[Rcpp::export]]
 void libtiledb_vfs_fh_free(XPtr<vfs_fh_t> fhxp) {
   check_xptr_tag<vfs_fh_t>(fhxp);